%{
 open Lo
%}

%token <Num.num> NUMERIQUE

%token PARG PARD FLECHE CROIX O TYPEREEL TYPEBOOL TYPENAT
%token LAMBDA FUN DEUX_POINTS POINT FLECHE_FUN VIRGULE FST SND
%token FIX PROB ECHANT DE DANS S SI ALORS SINON
%token SOIT REC ET EGALE   DEPROB ESI   EGALE_ASSIGNE
%token POURCENT  DEF_VARIABLE    VARIANT INVARIANT

%token EOF

%token <bool> BOOL
%token <string> VARIABLE
%token <string> SPEC
%token <string> OPERATEUR

%token <string> CHAINE

%token <(string * int)> VAR_ABSTR
%token <(string * int)> VAR_PROP

%left POINTVIRGULE

%start programme_clavier
%start programme_fichier
%type <Lo.instruction> programme_clavier
%type <Lo.instruction list> programme_fichier
%type <Lo.instruction> instruction
%type <Lo.ty option -> Lo.expr> expr
%type <Lo.ty option -> Lo.terme> terme
%type <Lo.ty option -> Lo.terme> terme_atomique
%type <(Lo.variable * Lo.ty) list> variables_muettes
%type <(Lo.ty * (Lo.variable * Lo.ty) list)> suite_variables_muettes
%type <Lo.ty option -> ((Lo.variable * Lo.ty) * Lo.terme)> terme_fix
%type <Lo.ty option -> Lo.terme> terme_non_applicable
%type <Lo.ty option -> Lo.terme> terme_application
%type <Lo.ty option -> ((string * Lo.ty) * Lo.terme) list> affectations
%type <Lo.ty option -> ((string * Lo.ty) * Lo.terme)> affectation
%type <Lo.ty> ty
%type <Lo.ty> ty_atomique

%%

programme_clavier:
| instruction POINT { $1 }

programme_fichier:
| EOF { [] }
| instruction POINT programme_fichier { $1 :: $3 }

instruction:
// | expr { Instr_expr ($1 None) }
| SOIT affectations { Instr_affectations ($2 None) }
| SOIT REC terme_fix { Instr_affectations [$3 None] }


| DEF_VARIABLE VARIABLE DEUX_POINTS ty { Instr_variable ($2, $4) }

expr:
| terme { fun t -> Expr_terme ($1 t) }
| S { fun _ -> Expr_s }
| ECHANT VARIABLE DE terme DANS expr {
    fun t ->
      let v = $2 and m = $4 t in
      let e' = $6 t in Expr_sample ((v, m), e')
  } 
| DEPROB terme {
    fun t ->
      let v = "x" in
      let m = $2 t in
	Expr_sample ((v, m), Expr_terme (Terme_variable v)) 
  }

| ESI terme ALORS expr SINON expr {
    fun t ->
      let v = "x" in
      let b = $2 t in
      let et = $4 t in
      let ef = $6 t in
	Expr_sample (
	  (
	    v, Terme_si (
	      b, (
		Terme_valeur (Valeur_prob et),
		Terme_valeur (Valeur_prob ef)
	      )
	    )
	  ),
	  Expr_terme (Terme_variable v)
	)
  }

terme:
| terme_application { $1 }
| terme_non_applicable { $1 }

terme_non_applicable:
 | FUN VARIABLE DEUX_POINTS ty FLECHE_FUN terme
   { 	
     fun t0 ->
       let v = $2 and t = $4 and m = $6 t0 in
	 Terme_valeur (Valeur_lambda ((v, t), m)) 
   }

 | FUN variables_muettes FLECHE_FUN terme 
     {
       fun t0 ->
	 let m = $4 t0 in
	   List.fold_right
	     (fun v k -> Terme_valeur (Valeur_lambda (v, k)))
	     $2
	     m
     }

| SI terme ALORS terme SINON terme 
    {
      fun t ->
	let b = $2 t and vt = $4 t and vf = $6 t in
	  Terme_si (b, (vt, vf))
    }

| FIX terme_fix
    {
      fun t -> snd ($2 t)
    }


| PROB expr { fun t -> Terme_valeur (Valeur_prob ($2 t)) }
| FST terme { fun t -> Terme_fst ($2 t) }
| SND terme { fun t -> Terme_snd ($2 t) }


| SOIT affectations DANS terme  { 
    fun t ->
      affectations ($4 t) ($2 t)
 }

 | SOIT REC terme_fix DANS terme {
     fun t ->
       affectations ($5 t) [$3 t]
   }

terme_fix:
 | VARIABLE PARG VARIABLE DEUX_POINTS ty PARD VARIANT CHAINE DEUX_POINTS ty EGALE_ASSIGNE terme {
     fun t -> (
       ($1, Type_fleche ($5, $10)),
       Terme_fix_det {
	 tfd_point_fixe = $1;
	 tfd_param = $3;
	 tfd_ty_param = $5;
	 tfd_ordre_variant = $8;
	 tfd_ty_corps = $10;
	 tfd_corps = $12 t;
       }
     )
   }

 | VARIABLE PROB CHAINE VARIANT CHAINE DEUX_POINTS ty EGALE_ASSIGNE expr {
     fun t -> (
       ($1, Type_o $7),
       Terme_fix_prob {
	 tfp_point_fixe = $1;
	 tfp_ens_variant = $3;
	 tfp_ordre_variant = $5;
	 tfp_ty_corps = $7;
	 tfp_corps = $9 t;
       }
     )
   }

variables_muettes :
 | PARG suite_variables_muettes {
    snd $2
   }

suite_variables_muettes :
 | VARIABLE suite_variables_muettes {
     let (ty, l) = $2 in (ty, ($1, ty)::l)
     
   }
 | VARIABLE DEUX_POINTS ty PARD {
     ($3, [$1, $3])
   }

 | VARIABLE DEUX_POINTS ty PARD variables_muettes {
     ($3, ($1, $3)::$5)
   }

affectations:
| affectation { fun t -> [ $1 t ] }
| affectation ET affectations {fun t -> $1 t :: $3 t }

affectation:
| VARIABLE DEUX_POINTS ty EGALE_ASSIGNE terme {
    fun t -> (($1, $3), $5 t)
  }
| VARIABLE variables_muettes DEUX_POINTS ty EGALE_ASSIGNE terme {
    fun t ->
      let ty = List.fold_right 
	(fun (_, t2) t0 -> Type_fleche (t2, t0))
	$2
	$4
      in
	(
	  ($1, ty), 
	  List.fold_right
	    (fun v k -> Terme_valeur (Valeur_lambda (v, k)))
	    $2
	    ($6 t)
	)
  }
   
terme_application:
| terme_atomique { $1 }
| terme_application terme_atomique { fun t -> Terme_application ($1 t, $2 t) }

terme_atomique:
| VARIABLE { fun _ -> Terme_variable  $1  }
| BOOL { fun _ -> Terme_valeur (Valeur_bool $1 ) }
| SPEC { fun _ -> Terme_valeur (Valeur_spec (spec_of_string $1 )) }
| PARG terme PARD { $2 }
| PARG terme VIRGULE terme PARD { fun t -> Terme_couple ($2 t, $4 t) }
| PARG terme EGALE terme PARD { fun t -> Terme_egale ($2 t, $4 t) }

| PARG terme OPERATEUR terme PARD {
    function
      | None -> raise (Exception_scope_impossible None)
      | Some t as u ->
	  let sp = spec2_of_string $3 t in
	    Terme_application (
	      Terme_application (
		Terme_valeur (Valeur_spec sp),
		$2 u
	      ),
	      $4 u
	    )
  }


| PARG terme CROIX terme PARD {
    function
      | None -> raise (Exception_scope_impossible None)
      | Some t as u ->
	  let sp = spec2_of_string "*" t in
	    Terme_application (
	      Terme_application (
		Terme_valeur (Valeur_spec sp),
		$2 u
	      ),
	      $4 u
	    )
  }
    
| PARG terme POURCENT ty_tres_atomique PARD { 
    fun _ ->
     let t = $4 in
	$2 (Some t)
  }



| NUMERIQUE {
    function
      | Some Type_reel -> Terme_valeur (Valeur_reelle $1)
      | Some Type_nat -> Terme_valeur (Valeur_nat $1)
      | t -> raise (Exception_scope_impossible t)
  }

ty:
| ty_atomique { $1 }
| ty_atomique FLECHE ty { Type_fleche ($1, $3) }

ty_atomique:
| ty_tres_atomique { $1 }
| ty_tres_atomique CROIX ty_tres_atomique { Type_couple ($1, $3) }

ty_tres_atomique:
| PARG ty PARD { $2 }
| TYPEREEL { Type_reel }
| TYPEBOOL { Type_bool }
| TYPENAT { Type_nat }
| O ty_tres_atomique { Type_o $2 }