Ajout du typecheck des preuves finales.

main.ml

@@ -9,12 +9,12 @@ let filename = ref "" in
 
 let reduce = ref false in
 let alpha = ref false in
-let typecheck = ref false in
+let typecheck_option = ref false in
 
 Arg.parse
     [("-reduce", Arg.Set reduce, "Show the step-by-step reduction of a lambda-term");
      ("-alpha", Arg.Set alpha, "Check is two lambda-terms separated by '&' are alpha-convertible");
-     ("-typecheck", Arg.Set typecheck, "Check if a lambda term has a given type")]
+     ("-typecheck", Arg.Set typecheck_option, "Check if a lambda term has a given type")]
     (fun s -> filename := s)
     "The available options are:";
 
@@ -121,4 +121,17 @@ while !subgoals <> [] do
         )
 done;
 
-Printf.printf "Final proof :\n%s\n" (string_of_lam (!fill_holes []));;
+let finalLam = !fill_holes [] in
+    if (typecheck [] finalLam ty)
+    then 
+        Printf.printf "Final proof :\n%s\n" (string_of_lam finalLam)
+    else
+    (
+        Printf.printf "Invalid proof constructed !\n";
+        Printf.printf "%s can't be typed with %s.\n" (string_of_lam finalLam) (string_of_ty ty);
+        Printf.printf "The whole development team of pieuvre is sorry for the damage eventually done by this error.\n"
+    )
+;;
+    
+
+

pieuvre.ml

@@ -1,6 +1,7 @@
 open Structs
 open Str
 
+
 exception TODOException;;
 exception IllegalVarNameException of var
 
@@ -115,23 +116,31 @@ let rec reduce (l:lam) : unit =
     | None -> ()
 ;;
 
-(* Vérifie que le λ-terme l sous l'environnement env a bien le type t *)
-let rec typecheck (env: gam) (l: lam) (t: ty) : bool =
-    match (l,t) with
-    | (LFun(x,t,l'),TImpl(tx,ty)) -> typecheck ((x,tx)::env) l' ty
-    | (LFun(_,_,_),_) -> false (* Une fonction est forcément une ... fonction *)
-    | (LApp(lf,lx),t) ->
-        let t' = raise TODOException in
-        (typecheck env lf (TImpl(t',t))) && (typecheck env lx t')
-    | (LVar(x),t) ->
+(* Calcule le type du λ-terme l sous l'environnement env. 7
+Renvoie None si la formule n'est pas typable ou si la formule n'est pas close (sous d'environnement)*)
+let rec computeType (env: gam) (l: lam) : ty option =
+    match l with
+    | LFun(x,tx,l') -> Option.bind (computeType ((x,tx)::env) l') (fun ty -> Some (TImpl(tx,ty)))
+    | LApp(lf,lx) ->
+        let tx = computeType env lx in
+        let tf = computeType env lf in
+        begin
+            match tf with
+            | Some TImpl(tx',ty') -> if Some tx'=tx then Some ty' else None
+            | _ -> None (* Si none, l'argument n'est pas typable, si Some _, on ne peut typer l'application *)
+        end
+    | LVar(x) ->
         begin
         match env with
-        | (y,t')::env' -> if x=y then t=t'
-            else typecheck env' l t
-        | [] -> raise TODOException
+        | (y,ty)::env' -> if x=y then Some ty
+            else computeType env' l
+        | [] -> None
         end
-    | (LExf(l',t'),t) ->
-        if t=t'
-        then typecheck env l' t
-        else false (* Le ex falso a le mauvais type *)
+    | LExf(l',t) ->
+        if (computeType env l')=Some t
+        then Some t
+        else None (* Le ex falso a le mauvais type *)
 ;;
+
+(* Vérifie que le λ-terme l sous l'environnement env a bien le type t *)
+let typecheck (env: gam) (l: lam) (t: ty) : bool = (computeType env l = Some t);