%{
use strict;
use Math::Symbolic::MaximaSimple qw(:all);
use utf8;
use List::Util qw{shuffle first};
use Parse::DSLUtils qw(:all);
### not yet :  use Exercise::Gen::Sem qw(:all);
use Data::Dumper;

my  %config=(style => 1);
our $yyst = 3;
#our $vindex = 0;
###GRAM:state
our %sem=();
%main::VAR=();
our %FUN=( "import"    => { f=>sub{lines(@_)    }},
           "importcom" => { f=>sub{lines($_[0],"-|")}},
           "filelines" => { f=>sub{lines(@_)    }},
           "filecols"  => { f=>sub{collines2(@_)}},
           "importcol" => { f=>sub{collines(@_)->[0]}}, 
           "importcols" =>{ f=>sub{collines2(@_)}},
           "sectionlines"=>{ 
               f=> sub{my @L = map {s/^#(\w+)#?$/$1/; $_ } @_; 
                     collinesstr({fs=>"\x{01}"},$sem{tab}{$L[0]}{v})->[0]}},
           "sectioncols" =>{ f=>sub{collinesstr($sem{tab}{$_[0]}{v})}},
           "valuecols"  => { f=>sub{collinesstr($sem{ts}{$_[0]}{v1})}},
           "valuelines" => { 
               f=> sub{my @L = map {s/^#(\w+)#?$/$1/; $_ } @_; 
                     my $vv = $sem{ts}{$L[0]}{v1};
                     collinesstr({fs=>"\x{01}"},$vv)->[0]}},
           ##"multiplechoice" => {f=>sub{_multiplechoice(@_)} },
           "truefalse" => {
               f=> sub{ my @L = map {s/^#(\w+)#?$/$1/; $_ } @_;
                      _scoretruefalse($sem{ts}{$L[0]}{v1},$sem{ts}{$L[1]}{v1});}},
           "scoretruefalse" => {
               f=> sub{ my @L = map {s/^#(\w+)#?$/$1/; $_ } @_;
                      my $v1 = $sem{ts}{$L[0]}{v1};
                      my $v2 = $sem{ts}{$L[1]}{v1};
                      _scoretruefalse($v1,$v2);}},
);

my @ord=();
my $next=0;

#our %A=(ac=>{},li=>{},img=>{},atli=>{});
#our %meta=(inline=>{},ignore=>{},rename=>{});
#our @dic=();
#our %func=();          
###GRAM
%}

%token ID IDs LB V EOF VF_FUNCTION ATVAL
%token LET BLOCKID TEXBLOCK PERL TAB VERIFY

%%

Mex : bloco Mex
    | LB  Mex
    | VF_FUNCTION Mex {$sem{verify_fun} = $_[1];} ##TODO: fazer eval disto para verificar syntax
    | PERL EOF {myperleval($_[1]); return "OK";}  ##TODO: fazer eval disto para verificar syntax
    | EOF      {                   return "OK";}
    ;

bloco : LET let         { $sem{order}=[@ord]; verify_dup(@ord) ; }
    | VERIFY  verf
    | BLOCKID TEXBLOCK  { $sem{texblocks}{$_[1]}= {v=>$_[2],type=>"tex"};}
    | BLOCKID           { $sem{texblocks}{$_[1]}= {v=> ""  ,type=>"tex"};}
    | TAB     TEXBLOCK  { $sem{tab}{$_[1]}      = {v=>$_[2],type=>"tab"};}
    | FORMAT  pairs     { $sem{format} = mkaformater($_[2]) ; }
    ;

pairs: pairs PAIR { [@{$_[1]},$_[2]]}
    |  PAIR       { [$_[1]] }
    ;

let : let letline LB     
    | let LB            
    | let error   LB     { $yyst=0; $_[0]->YYErrok; }
    |
    ;

   ##verfff : verfff VF_T_F LB   { push(@{$sem{verify}}, {id=>$_[2]{id}, type=>$_[2]{type}, func=>$_[2]{func}});}
   ##    | verfff VF_T LB     { push(@{$sem{verify}}, {id=>$_[2]{id}, type=>$_[2]{type}});}
   ##   | verfff VF LB	    { push(@{$sem{verify}}, {id=>$_[2]});}
   ##   | verfff VF_TEST LB  { push(@{$sem{verify}}, {id=>$_[2]{id}, opt=>$_[2]{opt}});}
   ##   #| verfff VF_DIRECT LB  { push(@{$sem{verify}}, {id=>$_[2]{v}, opt=>$_[2]{opt}}) print "found direct $_[2]{v}\n";}
   ##  | verfff LB
   ##  |
   ##  ;

verf : verf vvalue vatribs LB   { push(@{$sem{verify}},{id=>$_[2],%{$_[3]}});}
     | verf  LB   
     | 
     ; 

vvalue : extblock  { $_[1]; }
     | V           { $_[1]; }
     | ID          { "#$_[1]"; }
     | IDs         { "#$_[1]{id}"."[$_[1]{n}]"; }
     ;

vatribs: vatribs ATVAL  { +{%{$_[1]},  $_[2]{id} , $_[2]{v}} }
     |                  { +{}                }
     ;

letline : lhs  '=' rhs   { push(@ord,$_[1]{id}); 
                           ts($_[1]{id}, type => $_[1]{type}); 
                           ts($_[1]{id}, v    => $_[3]); 
                           ts($_[1]{id}, card => $_[1]{n}); }  ## { if $_[1]{n} > 1;}

        | lhs '~' lhss '=' rhs  { 
              _err_die("Invalid (different) dimensions '$_[1]{id}'\n") if ($_[1]{n} != $_[3]{n});
              equi($_[1]{id},l    => [$_[1]{id},@{$_[3]{l}}]);
              equi($_[1]{id},card => $_[1]{n}) if $_[1]{n} != 1;
              equi($_[1]{id},v    => $_[5]) ;  
              push(@ord,@{$sem{equi}{$_[1]{id}}{l}}) ; }

        | lhs '~' lhss   { 
              _err_die("Invalid (different) dimensions '$_[1]{id}'\n") if ($_[1]{n} != $_[3]{n});
              equi($_[1]{id},l    => [$_[1]{id},@{$_[3]{l}}]);
              equi($_[1]{id},card => $_[1]{n}) if $_[1]{n} != 1; }

        | extblock     { $next++; 
                         push(@ord,"__$next"); 
                         $sem{ts}{"__$next"} = $_[1]; }
        ;

lhs : ID ID   { ts($_[2],type => $_[1]); { id => $_[2]    , type=> $_[1], n => 1        }}
    | ID IDs  { ts($_[2],type => $_[1]); { id => $_[2]{id}, type=> $_[1], n => $_[2]{n} }}
    |    IDs  { { id => $_[1]{id}, type=> 's'  , n => $_[1]{n} }}
    |    ID   { { id => $_[1]    , type=> 's'  , n => 1        }}
    ;

rhs : V 
    | extblock           { $next++; 
                           push(@ord,"__$next"); 
                           $sem{ts}{"__$next"} = $_[1]; 
                           ["THE", "__$next"] }
    ;

lhss  : lhss '~' lhs { _err_die("Invalid (different) dimentions '$_[3]{n}'\n") if ($_[1]{n} != $_[3]{n});
                       { n => $_[3]{n}, l => [@{$_[1]{l}},$_[3]{id}]} }
      | lhs          { { n => $_[1]{n}, l => [$_[1]{id}]} }
      ;

%%

sub ts{my ($id,$at,$v)=@_; $sem{ts}{$id}{$at}  = $v; }
sub equi{my ($id,$at,$v)=@_; $sem{equi}{$id}{$at}  = $v; }

sub set_v{$main::VAR{$_[0]}=$_[1]; }
sub get_v{$main::VAR{$_[0]}}

sub verify_dup{
 my @l = @_;
 my %aux =();
 for(@l){ 
   if($aux{$_}){ _err_die("Error duplicated def of $_ \n");} 
   $aux{$_}++ ;
 }
}

sub mkaformater{ my $r='sub{my $t=shift;' ; 
  my $pairs=shift;
  # print STDERR Dumper($pairs);

  for(@$pairs){ 
     my $rhs = $_->{rhs};
     my $lhs = $_->{lhs};
     my $op  = $_->{op} || "";
     $rhs =~ s!\\!\\\\!g;
     if($lhs =~ /^\w.*\w$/){ $r .= sprintf('$t =~ s!\b%s\b!%s!g%s; ',$lhs,$rhs,$op);}   
        else               { $r .= sprintf('$t =~ s!%s!%s!g%s; ',$lhs,$rhs,$op);}
  }

  $r .= 'return $t; } ';
  # print STDERR $r;

  my $form= eval $r;
  if($@){ die("Invalid format rule ($@)\n".Dumper($_[0])); }
  if(not ref($form) eq "CODE"){ die("couldnot build a formater($r)\n"); }
  return $form;
}

sub add_fun{  
  my($id,$f,$type)=@_;
  $FUN{$id}={f=>$f,type=>$type}
}

sub verify_equiv_cardinality{ ## and unify equi{name}{card} with ts{name}{card}
  my $a = shift;
  my @le = @{$sem{equi}{$a}{l}};
  for (@{$sem{equi}{$a}{l}}){  
     _err("'$_' has no values definition...") 
          unless (defined $sem{ts}{$_}{v} or defined $sem{equi}{$a}{v});
     $sem{ts}{$_}{equi}=$a;
     my $card1 = $sem{equi}{$a}{card};
     my $card2 = $sem{ts}{$_}{card};
     $sem{ts}{$_}{card}  = $card2 = $card1 if($card1 and not $card2);
     $sem{equi}{$a}{card}= $card1 = $card2 if($card2 and not $card1);
     _err_die("Inconcistent sizes for $a: $card1 $card2") 
          unless( $card1 == $card2)
  }
}

sub calc_sem_equiv_group{ #calc rv for equiv and move it to equiv group
  my $a = shift;
  my @le = @{$sem{equi}{$a}{l}};
  my $llen = scalar @le;
  my ($k,@a)=@{$sem{equi}{$a}{v}};
  my $l;
  if($k eq "FUN") { $l = evalfunc($a[0],__bl_csv($a[1]));}
  if($k eq "CBB") {    ### {$l = myperleval($a->[0]); }
         my $f = myperleval($a[0]); 
         if(ref($f) eq "CODE"){ $l= $f->() }
         else                 { $l= $f}    }
  if($k eq "LAMBDA") { ### {$l = myperleval($a->[0]); }
         my $f = myperleval($a[0]); 
         if(ref($f) eq "CODE"){ $l= $f->() }
         else                 { $l= $f}    }
  if($k eq "BB" ) { die("Erro20\n"); }
  if($k eq "EXP") { die("Erro21 $k @a\n");    } ## em obras
  if($k eq "THE") { 
         $l = $sem{ts}{$a[0]}{rv}; 
         $l = $sem{ts}{$a[0]}{v1} if ref($l) eq "CODE";} ## em obras...

  die("Invalid list expression '{".Dumper($k,$l,$sem{ts}{$a[0]})."}'\n") unless ref($l) eq "ARRAY";
  die("Invalid list (len too short) '{".Dumper($l)."}'\n") if $llen > @$l;
  $sem{equi}{$a}{choicedom} = scalar @{$l->[0]};

  for( 0 ..($llen -1)){ 
         $sem{ts}{$le[$_]}{rv} = $l->[$_]  ;
  }
}

sub semjj{   ## calculate "real-values" for equiv{name} with {v}
  for my $simb (@{$sem{order}}){ 
    if( $sem{equi}{$simb}){
      verify_equiv_cardinality($simb);
      if($sem{equi}{$simb}{v}){  ## if equiv group has = val...
        calc_sem_equiv_group($simb);
      }
    }
    calc_sem_of_a_let_elem($simb);
    calc_sem_choices($simb);  ## calculate random choices
    calc_sem_v1($simb);  ## Calculate v1
  }

  for (keys %{$sem{texblocks}}){
     my $v=$sem{texblocks}{$_}{v};
     $sem{texblocks}{$_}{v1} = rep($v,$_);
     if($sem{format}){
        $sem{texblocks}{$_}{v1} = $sem{format}->($sem{texblocks}{$_}{v1});
     }
  }

  for(@{$sem{verify}}){
    my $id = $_->{id};
    $_->{v1} = rep($id, "verify");
#     while($_->{opt} =~ s/(\w+)\s*=\s*(\w+)//){
#        $_->{$1} = $2;
#     }
  }
}

sub _old_sem2{   ## calculate "real-values" for equiv{name} with {v}
  for (keys %{$sem{equi}}){
    verify_equiv_cardinality($_);
    if($sem{equi}{$_}{v}){  ## if equiv group has = val...
      calc_sem_equiv_group($_);
    }
  }
}

sub calc_sem_of_a_let_elem{ ## calc ts{elem}{rv}  and $ts{elem}{choicedom}
  my $a = shift;
  my $aux = $sem{ts}{$a};
  my $t = $sem{ts}{$a}{type};
  return unless defined($aux->{v});
  return unless ref($aux->{v}) eq "ARRAY";

  my ($k,@a)=@{$aux->{v}};
  my $l;
  if($k eq "FUN") { $l = evalfunc($a[0],__bl_csv($a[1]));}
  if($k eq "CBB") { 
     if   ($t eq "maxima")   { $l = mymaxeval($a[0]); }
     elsif($t eq "domaxima") { $l = mymaxeval($a[0]); }
     elsif($t eq "perl")     { $l = myperleval($a[0]); }
     elsif($t eq "doperl")   { $l = myperleval($a[0]); }
     else                    { 
         my $f = myperleval($a[0]); 
         if(ref($f) eq "CODE"){ $l= $f->() }
         else                 { $l= $f}    }
   ###  else                    { $l = myperleval($a[0]); } 
  }
  if($k eq "LAMBDA") {
     if   ($t eq "maxima")   { $l = mymaxeval($a[0]); }
     elsif($t eq "domaxima") { $l = mymaxeval($a[0]); }
     elsif($t eq "perl")     { $l = myperleval($a[0]); }
     elsif($t eq "doperl")   { $l = myperleval($a[0]); }
     else                    { 
         my $f = myperleval($a[0]);
         if(ref($f) eq "CODE"){ $l= $f->() }
         else                 { $l= $f}    }
  }
  if($k eq "BB" ) { $l = $a[0]; }
  if($k eq "EXP") { $l = $a[0]; }
  if($k eq "THE") { $l = $sem{ts}{$a[0]}{rv}; }
  $aux->{rv} //= $l;
  if(ref($l) eq "ARRAY"){
    my $len = scalar(@$l);
    if($aux->{equi}){
      $sem{equi}{$aux->{equi}}{choicedom} //= $len;
      _err_die("size of $a not eq to its equiv.: $len $sem{equi}{$aux->{equi}}{choicedom}") 
          unless $len == $sem{equi}{$aux->{equi}}{choicedom} ;
    }
    $aux->{choicedom} //= $len;
  }
}

sub _old_sem3{
###  for (keys %{$sem{ts}}){ .. }
  for (@{$sem{order}}){ 
    calc_sem_of_a_let_elem($_);
  }
}
sub calc_sem_choices{  ## of a key calculates choice indexes {choice} and efective values {fv}
  my $a = shift;
  ### random select equiv groups
  if($sem{equi}{$a}) {
    my $aux=$sem{equi}{$a};
    my $qt = $aux->{choicedom} ;
    print "Debug: no choicedom! ",Dumper($aux),"\n" unless $aux->{choicedom};
    if($aux->{card} > 1){ $aux->{choice} = _choicenaux($aux->{card}, $qt); }
    else            { $aux->{choice} = _choiceaux($qt);}
    print "Fail to choice: $a:_choicenaus($aux->{card}?, $qt)",Dumper($aux)  
         unless defined($aux->{choice});
  }

  my $aux=$sem{ts}{$a};
  unless (defined($sem{ts}{$a}{rv})){ die ("'$a' has no real value??\n"); }
    
  if($aux->{equi}){
     my $auxe=$sem{equi}{$aux->{equi}};   ##
     if(defined $auxe->{choice}){
         $aux->{choice} = $auxe->{choice};
         my $ch=$aux->{choice};
         if(ref($ch)){ $aux->{fv}=[];
            for(@$ch){ push(@{$aux->{fv}},$aux->{rv}[$_]); } }
         else    { $aux->{fv} = $aux->{rv}[$ch]; } } 
     else{ 
          _err_die("equi $a should have a choice!!". Dumper($auxe)); }
  }
  else{ _vchoice($aux); } 
}

sub _old_sem4{  ## calculates choice indexes {choice} and efective values {fv}
  for my $a(keys %{$sem{equi}}){  ## random select equiv 
    my $aux=$sem{equi}{$a};
    my $qt = $aux->{choicedom} ;
    print "Debug: no choicedom! ",Dumper($aux),"\n" unless $aux->{choicedom};
    if($aux->{card} >1 ){ $aux->{choice} = _choicenaux($aux->{card}, $qt); }
    else                { $aux->{choice} = _choiceaux($qt);}
    print "Fail to choice: $a:_choicenaus($aux->{card}?, $qt)",Dumper($aux)  
         unless defined($aux->{choice});
  }

  for my $a(keys %{$sem{ts}}){
    my $aux=$sem{ts}{$a};
    unless (defined($sem{ts}{$a}{rv})){ die ("'$a' has no real value????\n"); }
    
    if($aux->{equi}){
       my $auxe=$sem{equi}{$aux->{equi}};   ##
       if(defined $auxe->{choice}){
         $aux->{choice} = $auxe->{choice};
         my $ch=$aux->{choice};
         if(ref($ch)){ $aux->{fv}=[];
            for(@$ch){ push(@{$aux->{fv}},$aux->{rv}[$_]); } }
         else    { $aux->{fv} = $aux->{rv}[$ch]; } } 
       else{ 
         _err_die("equi $a should have a choice!!". Dumper($auxe)); }
    }
    else{ _vchoice($aux); } 
    
  }
}

sub calc_sem_v1{  ## calculates replaced fv {v1} for ts{elem} and texblocks{elem}
 my $a = shift;
 my $v=$sem{ts}{$a}{fv};
 if(ref($v) eq "CODE"){ $v = $v->(); }
 if(ref($v) eq "ARRAY"){
     for( 0.. @$v-1 ){
           $sem{ts}{$a}{v1}[$_] = rep($v->[$_],$a);
     }
 }
 else {
     $sem{ts}{$a}{v1} = rep($v,$a);
 }
}

sub _old_sem5{  ## calculates replaced fv {v1} for ts{elem} and texblocks{elem}
  for my $a(@{$sem{order}}){ 
     my $v=$sem{ts}{$a}{fv};
     if(ref($v) eq "CODE"){ $v = $v->(); }
     if(ref($v) eq "ARRAY"){
        for( 0.. @$v-1 ){
           $sem{ts}{$a}{v1}[$_] = rep($v->[$_],$a);
        }
     }
     else {
        $sem{ts}{$a}{v1} = rep($v,$a);
     }
  }

  for my $a (keys %{$sem{texblocks}}){
     my $v=$sem{texblocks}{$a}{v};
     $sem{texblocks}{$a}{v1} = rep($v,$a);
     if($sem{format}){
        $sem{texblocks}{$a}{v1} = $sem{format}->($sem{texblocks}{$a}{v1});
     }
   }
}

sub _old_sem6{               ## values for block verify  ##DEP
  for(@{$sem{verify}}){
    my $id = $_->{id};
    $_->{v1} = rep($id, "verify");
     while($_->{opt} =~ s/(\w+)\s*=\s*(\w+)//){
        $_->{$1} = $2;
     }
  }
}

sub calcnewchoice{ Exercise::Gen::Let::semjj(); }

sub _old_calcnewchoice{  ##DEP
  Exercise::Gen::Let::sem4();
  Exercise::Gen::Let::sem5();
  Exercise::Gen::Let::sem6();
}

sub calcsem{ Exercise::Gen::Let::semjj(); }

sub _old_calcsem{  ##DEP
  Exercise::Gen::Let::sem2();
  Exercise::Gen::Let::sem3();
  Exercise::Gen::Let::sem4();
  Exercise::Gen::Let::sem5();
  Exercise::Gen::Let::sem6();
}

sub _t{ defined($sem{ts}{$_[0]}) 
           ? ($sem{ts}{$_[0]}{type} // "s1") 
      : $_[0] eq "verify" 
          ? "s1"
          : "tex" 
}

sub rep{
  my ($v,$a) = @_;
  my $c;
  while( 
         $v =~ s/\#(\w+)\[         \]/ repval3($1," ",$a)/xe  or
         $v =~ s/\#(\w+)\[sep=(.+?)\]/ repval3($1,$2,$a) /xe  or
         $v =~ s/\#(\w+)\[(\d+)\]    / repval2($1,$2,$a) /xe  or
  ##       $v =~ s/\#(\w+)\#           /sem{ts}{$1}{v1}/x     or
         $v =~ s/\#(\w+)             /     repval1($1,$a)    /xe )    {
     $c++; 
     if ($c > 100 ){ die("recursive exhaution ($v)\n") }
  }
  simp($v, _t($a),"s");
}

sub repval1{
  my ($id,$name)=@_;
  die("Undefined #$id in section '$name'\n") 
                  unless defined $sem{ts}{$id}{fv};
  die("Perhaps #$id+[number]? in section '$name'\n".Dumper($sem{ts}{$id})) 
                  if ref $sem{ts}{$id}{fv} eq "ARRAY";
  my $v = $sem{ts}{$id}{v1} // $sem{ts}{$id}{fv};
  simp($v,_t($id),_t($name));
}

sub repval2{
  my ($id,$ind,$name)=@_;
  die("Undefined #$id in section '$name'\n") 
                  unless defined $sem{ts}{$id}{fv};
  die("Perhaps #$id? (and not #$id+[number] in section '$name'\n") 
                  unless ref $sem{ts}{$id}{fv};
  return( _cont_prot($sem{ts}{$id}{v1}[$ind],_t($name))) 
           if defined $sem{ts}{$id}{v1}[$ind];
  my $v = $sem{ts}{$id}{fv}[$ind];
  simp($v, _t($id),_t($name));
}

sub repval3{
  my ($id,$sep,$name)=@_;
  die("Undefined #$id in section '$name'\n") 
                  unless defined $sem{ts}{$id}{fv};
  die("Perhaps #$id? (and not #$id+[number] in section '$name'\n") 
                  unless ref $sem{ts}{$id}{fv};

  if(ref($sem{ts}{$id}{v1}) eq "ARRAY") {
     my @l = @{ $sem{ts}{$id}{v1} };
     return( join($sep, map { _cont_prot($_ ,_t($name))} @l) ) ;
  }
  else {
     my @l = @{ $sem{ts}{$id}{fv} };
     return( join($sep, map { simp( $_, _t($id), _t($name))} @l)) ;
  }
}

sub simp{ ## value, type of value, exterior context
  my ($v,$type,$ctxt)=@_;
  my $r;
  if(  $type =~ m{^c?n}
    or $type =~ m{^offfperl}){ 
    my $r1="";
    if($v =~ /#/){ $r1= $v}
    else {
         my $aux = eval($v);
         # print STDERR "DEBUG: simp  eval de $v\n";
         if($@){ warn("Error: $@ in '$v'\n"); 
                 $r1 = $v;}
         else  { $r1 = $aux; }}
   
    if   ($ctxt =~ m{^c?[nf]} ){ $r="($r1)" }
    elsif($ctxt =~ m{^tex} )   { $r=  $r1 }
    else                       { $r=  $r1 }
  }
 
  elsif($type =~ m{^s}  
     or $type =~ m{^tex}
     or $type =~ m{^(perl|maxima)} 
     or $type =~ m{^do(perl|maxima)} ){ $r= $v; }

  elsif($type =~ m{^c?f}
     or $type =~ m{^maxima}){ 
    if   ($ctxt =~ m{^c?[nf]} ){ $r= "($v)" }
    elsif($ctxt =~ m{^tex} )   { my $aaa= maxima_tex2($v);
                                  if(ref($aaa)){ $r= $v } 
                                  else         { $r= $aaa}
                                }
    else                        { my $aaa= maxima($v);
                                  if(ref($aaa)){ $r= $v } 
                                  else         { $r= $aaa}
                                }
  }
  else { print STDERR "type unknown $type\n";
         $r = $v;}

   $r;
}

sub _cont_prot{ my ($v,$t)=@_;
 if($t =~ /^c?[nf]/){ return "($v)";}
 else               { return   $v  ;}
}

### CHOICES:
# _vchoice    calculates a->{fv} and a->{choice} from a symbol a->{card,rv}
# _choice     choose a (value,index) from a list
# _choicen    choose a (value^n,index^n) from (n,list)
# _shuffle    shuffle (value^n,index^n) from a list
# _choiceaux
# _choicenaux

sub _vchoice{    ##  calculates {fv} and {choice} of a symbol
   my $aux=shift;
   if($aux->{card} > 1){
          ($aux->{fv},$aux->{choice})= _choicen($aux->{card},@{$aux->{rv}}); }

   elsif(ref($aux->{rv}) eq "ARRAY"){
          ($aux->{fv},$aux->{choice})= _choice(@{$aux->{rv}});}

   else { $aux->{fv}=$aux->{rv} }
}

sub _choiceaux{ my $n = shift;      ## choose a index from a list 0..n-1 ;
  warn("choice in an empty list\n") unless ($n);
  return (undef) unless $n;
  my $i = int(rand($n)); 
  $i;
}

sub _choicenaux{ my ( $n,$m) =@_;  ## choose a (index^n) from a list 0..m-1 
  warn("choice in an empty list\n") unless ($m);
  return (undef) unless $m;
  warn("choice $n values in a list of len $m\n") unless ($n <= $m);
  return (undef) unless $n <= $m;
  my @is = (shuffle( 0 .. $m-1))[0..$n-1];
  \@is;
}

sub _choice{ my @a=@_;        ## choose a (value,index) from a list
  warn("choice in an empty list\n") unless (@a);
  return (undef) unless @a;
  my $i = int(rand(scalar @a)); 
  ($a[$i], $i)
}

sub _choicen{ my ( $n,@a)=@_; ## choose a (value^n,index^n) from a list
  my $is = _choicenaux($n,scalar @a);
  ([@a[@$is]],$is);
}

sub _shuffle{ my (@a)=@_; ## shuffle (value^n,index^n) from a list
  my($a,$b)=_choicen(scalar @a,@a);
  ($a,$b);
}

sub _unmap{my ($l1)= @_ ;  ## good for pairs shuffling (v^n -> (v^n * int^n))
  my ($l11,$lindex)=_shuffle(@$l1);
  for(0..@$l1-1){ $lindex->[$_]++;}
  return [$l11,$lindex] 
}

##EVALS
# evalfunc
# myperleval
# mymaxeval

sub evalfunc{ my ($f,$ar)=@_;
  if(defined $FUN{$f}){ return $FUN{$f}{f}->(@$ar);}
  else                { return "$f(".join(",",@$ar).")";}
}

sub myperleval{
  my ($b)=@_;
  # print STDERR "DEBUG: perleval de $b\n";
  if($b =~ m{#\w+}){ 
     return (lambda => sub{my $v=$b;
                           $v =~ s/#(\w+)#/\$sem{ts}{$1}{v1}/g;   ### DANGER
    ##                           $v =~ s/#(\w+)#/thevalue($1)/ge; ### DANGER
                           $v =~ s/#(\w+)\[/\$sem{ts}{$1}{v1}[/g;
                           $v =~ s/#(\w+)/\$sem{ts}{$1}{v1}/g;
                           return myperleval($v)}); }

  my $v=eval("$b") // $b;
  _err(" in eval($b): $@ in Perl calculation") if $@;
  if(ref($v) eq "ARRAY"){ return (vals => $v ) }
  else                  { return (exp  => $v ) }
}

sub mymaxeval{
  my ($b)=@_;
  # print STDERR "DEBUG: maximaeval de $b\n";
  if($b =~ m{#\w+}){ 
     return (lambda => sub{my $v=$b;
##                           $v =~ s/#(\w+)(?!\[)/thevalue($1)/ge;
                           $v =~ s/#(\w+)\[(.*?)\]/thevalue($1,$2)/ge;
                           $v =~ s/#(\w+)/thevalue($1)/ge;
                           return mymaxeval($v)}); }

  my $v=maxima("$b");
  _err(" in eval($b): $@ in Maxima calculation") if $@;
  if(ref($v) eq "ARRAY"){ return (vals => $v ) }  ## FIXME: strange...
  else                  { return (exp  => $v ) }
}
  
sub myeval{ my $exp=shift;   ### FIXME: Not used
  my $v=eval("$exp") // $exp;
  _err(" in eval($exp): $@ in Perl calculation") if $@;
  $v
}

##predifined FUN

sub _scoretruefalse{my ($v,$f)= @_ ;
  my $v1=[];
  my $v2=[];
  my @lv =(ref($v)?(@$v):$v);
  my @lf =(ref($f)?(@$f):$f);
  
  for(@lv){ push(@$v1,1); push( @$v2,$_)}
  for(@lf){ push(@$v1,0); push( @$v2,$_)}
  return [$v1,$v2] 
}

sub thevalue{my ($a,$b)=@_;       ## value (v1) of a symbol (ts ou texblock)
  # print STDERR "thevalue $a,$b\n";
  return($sem{ts}{$a}{v1}[$b])        
     if defined($b) && $sem{ts}{$a} && ref($sem{ts}{$a}{v1}) eq "ARRAY";
  return($sem{texblocks}{$a}{v1}[$b]) 
     if defined($b) && $sem{texblocks}{$a} && ref($sem{texblocks}{$a}{v1}) eq "ARRAY";
  return($sem{ts}{$a}{v1})        
     if $sem{ts}{$a};
  return($sem{texblocks}{$a}{v1}) 
     if $sem{texblocks}{$a};
  die("undefined value for #a\n ...may be a rong order?\n");
} 

sub collines2{ my ($f)=@_;
  my @L=();
  for(1..20){ push(@L,[]) };
  my $b = "<:utf8";
  open(F,$b,$f) or _err_die("cant find $f\n");
  while(<F>){chomp;
    s/[ \t\r]+\n/\n/g;
    next unless /\S/;
    my @field = split(/\s*:\s*/,$_,-1);
    for(0..@field-1){ push(@{$L[$_]},$field[$_]); }
  }
  close F;
  \@L;
}

sub collinesstr{ 
  my %opt =(rs=>qr{\n},fs => qr{\s*:\s*});
  if(ref($_[0]) eq "HASH") {%opt = (%opt , %{shift(@_)}) } ;

  my ($s)=@_;
  my @L=();
  for(1..20){ push(@L,[]) };
  $s =~  s/[ \t\r]+\n/\n/g;
  for(split($opt{rs},$s,-1)){
    next unless /\S/;
    my @field = split($opt{fs},$_,-1);
    for(0..@field-1){ push(@{$L[$_]},$field[$_]); }
  }
  \@L;
}

sub collines{ my ($f,@n)=@_;
  my @L=();
  for(@n){ push(@L,[]) };
  my $b = "<:utf8";
  open(F,$b,$f) or _err_die("cant find $f\n");
  while(<F>){chomp;
    s/[ \t\r]+\n/\n/g;
    next unless /\S/;
    my @field = split(/\s*:\s*/,$_,-1);
    my $complete = 1;
    for(0..@n-1){ my $n=$n[$_]-1;
       $complete = 0 unless ($field[$n]=~ /\S/);
    }
    next unless $complete;
    for(0..@n-1){ my $n=$n[$_]-1;
       push(@{$L[$_]},$field[$n]);
    }
  }
  close F;
  \@L;
}

sub lines{ my ($a,$b)=@_;
  my $l=[];
  $b ||= "<:utf8";
  _err_die("cant find lines (undefined file)\n") unless defined $a;
  open(F,$b,$a) or _err_die("cant find $a\n");
  while(<F>){chomp; s/[ \t\r]+\n/\n/g; push(@$l,$_) if /\S/}
  close F;
  $l;
}

sub _err    { print STDERR "Error: $_[0]\n";$_[0]; }
sub _err_die{ print STDERR "Error: $_[0]\n";die(); }

our ($debug,$lexdebug);

my $yylineno = 0;
my $n;

our $yyFile ;

%dislex Let.dislex

###---------------------------------------------------------------------

### COMMON

sub lexdebug  { yylexdebug(\&lex,$_[0]); }
sub parseFile { @ord=(); %sem=();yyinitfromfile($_[0]); parsecom(); }
sub parseStr  { @ord=(); %sem=();yyinitfromstr($_[0]) ; parsecom(); }

sub parsecom {
  my $p = new Exercise::Gen::Let();
  $yyFile = _ppincludes($yyFile);       ## from DSLUtils
  $p->YYParse( yylex   => \&lex,
               yyerror => \&_yyerror);  ## from DSLUtils
}
###COMMON:input-slurp

sub _B_yygetmore{  ## for compilers line mode, stdin <>
  local $/; $/="\n";
  $yylineno++;
  $yyFile = <>  || "__EOF__";
}

sub _C_yygetmore{  ## for compilers paragraph mode, stdin <>
  local $/; $/='';
  $yylineno++;
  $yyFile = <>  || "__EOF__";
}

###SEM:functions

sub slurptab{
  my %opt =(fs=>"::", comm=>1 , Dom => "Dom:" );
  if(ref($_[0]) eq "HASH") {%opt = (%opt , %{shift(@_)}) } ;
  my @r;
  my @extra=();
  open(F1,"<:utf8",$_[0]) or warn("###cant open $_[0]\n");;
  my $aa;
  while($aa=<F1>){ chomp($aa);
      $aa=~ s/#.*//  if $opt{comm};
      if($aa=~ s/^\+\+\s*(?:\w+\s*=\s*)?(.*)//) { 
            my $aux = $1;
            if($aux =~ /\S/){ @extra = split(/\s*$opt{fs}\s*/,$aux)}
            else            { @extra = ();}}
      next unless $aa=~ /\S/;
      push(@r,[split(/\s*$opt{fs}\s*/,$aa),@extra])}
  close F1;
  print "#", Dumper(\@r) if $lexdebug;
  \@r;
}

1;

__END__

## 
* texblocks
    id
       v
       type
* ts                           (Symbol table?)
    id
      v    (atom| [(FUN|CBB|BB|EXP),args}])
      type
      card?
      rv   (calculado a partir de v ou de equi(v)) atom | atom*  (sem3)
      choice     (int or int*)                                   (sem4:rand)
      fv         (v or v*)                                       (sem5:repl)
* order
    id*
* equi
    id:
      l: sym*
      v
* verify
    id
    v1
    type
    func
     
sym = s1: at_id * type
    | s2: at_id * card * type
    | s3: