%{
(*Header*)
(*******************************************************)
(*                                                     *)
(*                    The FunToy language              *)
(*                       Camlyacc file                 *)
(*                                                     *)
(*                     Jean-Yves Moyen                 *)
(*                        Mars 2001                    *)
(*                                                     *)
(*******************************************************)

open Langage

let (functions : (string,funi) Hashtbl.t)  = Hashtbl.create 17
and (variables : (string,vari) Hashtbl.t)  = Hashtbl.create 17
and (constructors : (string,coni) Hashtbl.t) = Hashtbl.create 17

let rev_table ini fin=
  Hashtbl.iter (fun s i -> Hashtbl.add fin i s) ini

let (funnamet : (funi,string) Hashtbl.t) = Hashtbl.create 17
and (connamet : (coni,string) Hashtbl.t) = Hashtbl.create 17

let func=ref (-1)
and vari=ref (-1)
and cons=ref (-1)

let clear()=
  Hashtbl.clear variables;
  vari:= -1

    
let clearall()=
  Hashtbl.clear functions;
  Hashtbl.clear variables;
  Hashtbl.clear constructors; 
  Hashtbl.clear funnamet;
  Hashtbl.clear connamet;
  func:=(-1);
  vari:=(-1);
  cons:=(-1)

let get_numf f=
  try Hashtbl.find functions f
  with 
      Not_found->(incr func;Hashtbl.add functions f !func;!func)
	
let get_numc c=
  try Hashtbl.find constructors c
  with
      Not_found ->(incr cons;Hashtbl.add constructors c !cons;!cons)

let get_numv v=
  try Hashtbl.find variables v
  with
      Not_found -> (incr vari;Hashtbl.add variables v !vari;!vari)

%}
/*delaration*/

/*Programs and terms*/
%token LPAR RPAR
%token TO     /*definition*/
%token COMMA

/*Quasi-interpretations*/
%token PLUS MINUS TIMES POWER MAX
%token <int> INT
%token RINTER LINTER EQUAL TRUE FALSE

/*Strings*/
%token <string> IDENT

/*Other*/
/*Here we could add some primitives types and functions */
%token EOF


%left PLUS MINUS
%left TIMES
%left POWER

%start prog
%type <Langage.prog> prog

%start term
%type <Langage.term> term

%start clearall
%type <unit> clearall

%start polyl
%type <Langage.polynome list> polyl

%start interdef
%type <Langage.funcon*(Langage.polynome*Langage.varp list)> interdef

%type <Langage.equation list> fundefs
%type <Langage.equation> fundef
%type <int> varl
%type <Langage.vari list> varlp
%type <Langage.vari> var
%type <Langage.term list> terml
%type <Langage.pattern> pattern
%type <Langage.pattern list> patternl
%type <(Langage.polynome*Langage.varp list) Interp.t> interdefs
%type <Langage.polynome> poly

%%
/*rules*/

prog:      /*Langage.prog*/
   fundefs interdefs EOF        
     { rev_table functions funnamet ;
       rev_table constructors connamet ;
       {rules = $1 ; 
	interp = $2 ;
        funname = funnamet ;
	conname = connamet }}
 | fundefs EOF   
     { rev_table functions funnamet ;
       rev_table constructors connamet ;
       { rules = $1 ; 
	 interp = Interp.empty ; 
        funname = funnamet ;
	conname = connamet }}

;  

fundefs: /*Langage.equation list*/
       fundef fundefs {$1::$2}
     | fundef         {[$1]}
;
fundef:  /*Langage.equation*/
      IDENT LPAR patternl RPAR TO term
  {clear();
   {lfun = { idf = get_numf $1 ;
	     arf = List.length $3
	   } ;
    lpat = $3 ;
    rside = $6
   }
  }

;

varl:    /*int*/
    var COMMA varl { $3+1 }
  | var            { 1 }
;

varlp:   /*Langage.vari list*/
    var COMMA varlp {$1::$3}
  | var             {[$1]}
;
var:     /*Langage.vari*/
    IDENT {
      try if Langage.syntX $1 
      then get_numv $1 
      else raise Parsing.Parse_error
      with _->failwith "blup"}
;

term:    /*Langage.term*/
    IDENT {if Langage.syntC $1
	   then 
	     Con ({ idc = get_numc $1 ;
		    arc = 0 },[])
	   else 
	     if Langage.syntX $1
	     then Var (get_numv $1)
	     else raise Parsing.Parse_error}
  | IDENT LPAR RPAR
         { if Langage.syntC $1
	   then 
	     Con({ idc = get_numc $1 ;
		   arc = 0},[])
	   else 
	     raise Parsing.Parse_error (*syntax error*)}
  | IDENT LPAR terml RPAR  
         { if Langage.syntC $1
	   then 
	     Con({ idc = get_numc $1 ;
		   arc = List.length $3 },$3)
	   else 
	     if Langage.syntF $1
	     then
	       Fun ( { idf = get_numf $1 ;
		       arf = List.length $3 },$3)
	     else raise Parsing.Parse_error (*syntax error*)}	   
;            

terml:    /*Langage.term list*/
     term COMMA terml { $1::$3 }
   | term       { [$1] }
;

pattern:    /*Langage.pattern*/
    IDENT {if Langage.syntC $1
	   then 
	     PatCon ({ idc = get_numc $1 ;
		    arc = 0 },[])
	   else 
	     if Langage.syntX $1
	     then PatVar (get_numv $1)
	     else raise Parsing.Parse_error}
  | IDENT LPAR RPAR
         { if Langage.syntC $1
	   then 
	     PatCon({ idc = get_numc $1 ;
		   arc = 0},[])
	   else 
	     raise Parsing.Parse_error (*syntax error*)}
  | IDENT LPAR patternl RPAR  
         { if Langage.syntC $1
	   then 
	     PatCon({ idc = get_numc $1 ;
		   arc = List.length $3 },$3)
	   else 
	     raise Parsing.Parse_error (*syntax error*)}	   
;            

patternl:    /*Langage.pattern list*/
    pattern COMMA patternl { $1::$3 }
  | pattern       { [$1] }
;

clearall: /*unit*/
    IDENT  {clearall()}  
  | EOF    {clearall()}
;
        
interdefs:  /*(polynome*varp list) Interp.t*/
     interdef interdefs {Interp.add (fst $1) (snd $1) $2}
   | interdef           {Interp.add (fst $1) (snd $1) Interp.empty}

interdef:   /*funcon*(polynome*varp list)*/
    LINTER IDENT RINTER EQUAL INT
     { if syntC $2
       then C(get_numc $2),((Int $5),[])
       else failwith "blop"(*raise Parsing.Parse_error*)
     }
  | LINTER IDENT RINTER LPAR RPAR EQUAL INT
     { if syntC $2
       then C(get_numc $2),((Int $7),[])
       else failwith "muf"(*raise Parsing.Parse_error*)
     }
  | LINTER IDENT RINTER LPAR varlp RPAR EQUAL poly
     { clear();
       if syntF $2
       then F(get_numf $2),($8,$5)
       else  
	 if syntC $2
	 then C(get_numc $2),($8,$5)
	 else failwith "blip"(*raise Parsing.Parse_error*)
     }

polyl:    /*polynome list*/
    poly polyl  {$1::$2}
  | poly        {[$1]}
  | EOF         {[]}

polyll:  /*polynome list*/
    poly COMMA polyll {$1::$3}
  | poly {[$1]}
  | EOF  {[]}

poly:     /*polynome*/
     var {VarP $1}
   | INT {Int $1}
   | LPAR poly RPAR {$2}
   | MAX LPAR polyll RPAR 
       {List.fold_right (fun p q->Max(p,q)) (List.tl $3) (List.hd $3)}
   | poly PLUS poly {Sum($1,$3)}
   | poly MINUS poly {Dif($1,$3)}
   | poly TIMES poly {Prod($1,$3)}
   | poly POWER INT {Power($1,$3)}
   | TRUE {True}
   | FALSE {False}

%%
(*trailer*)


