From 17907e16909749999834232eb61dae9c891fc7f2 Mon Sep 17 00:00:00 2001 From: Adrien Vannson Date: Mon, 9 May 2022 00:15:52 +0200 Subject: [PATCH] Construction du lambda-terme --- main.ml | 63 ++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 44 insertions(+), 19 deletions(-) diff --git a/main.ml b/main.ml index 4d15231..47f0861 100644 --- a/main.ml +++ b/main.ml @@ -1,6 +1,9 @@ open Structs;; open Pieuvre;; +let fail () = + failwith "Unknown error";; + (* Parsage des arguments*) let filename = ref "" in @@ -52,37 +55,59 @@ let ty = ) in -while true do +let subgoals: (ty * (var_lambda * ty) list) list ref = ref [(ty, [])] in + +(* On donne en paramètre une liste contenant un lambda-terme par trou (ie subgoal), + * et elle renvoie le lambda-terme complet (en remplaçant les trous) *) +let fill_holes = ref (fun holes -> List.hd holes) in + +while !subgoals <> [] do + let (ty, hyp) = List.hd !subgoals in + subgoals := List.tl !subgoals; + if is_interactive then ( (* Nettoyage du terminal *) let _ = Sys.command("clear -x") in (* Affichage des hypothèses *) + Printf.printf "There are %d hypothesis\n" (List.length hyp); (* Affichage des sous-buts *) Printf.printf "================\n"; Printf.printf "%s\n" (string_of_ty ty); (* Lecture d'une tactique *) - Printf.printf "What do you want to do?\n"; + Printf.printf "What do you want to do?\n" + ); - let tactic = - let rec read_tactic () = - try - let lexbuf = Lexing.from_string (readline ()) in - Parser.main_tactic Lexer.token_tactic lexbuf - with e -> ( - Printf.printf "Can't parse tactic\n"; - if is_interactive then - read_tactic () - else - raise e - ) - in - read_tactic () + let tactic = + let rec read_tactic () = + try + let lexbuf = Lexing.from_string (readline ()) in + Parser.main_tactic Lexer.token_tactic lexbuf + with e -> ( + Printf.printf "Can't parse tactic\n"; + if is_interactive then + read_tactic () + else + raise e + ) in - () - ) + read_tactic () + in + + match tactic with + | Intro var -> ( + match ty with + | TImpl (ty1, ty2) -> ( + subgoals := (ty2, (var, ty1) :: hyp) :: !subgoals; + let f = !fill_holes in + fill_holes := fun holes -> match holes with + | h :: hs -> f (LFun (var, ty1, h) :: hs) + | _ -> fail () + ) + | _ -> failwith "Can't intro" + ) done; -();; +Printf.printf "Final proof :\n%s" (string_of_lam (!fill_holes []));;