Merge remote-tracking branch 'origin/master'

This commit is contained in:
Mysaa 2022-05-10 15:00:38 +02:00
commit 98a9e6964f
Signed by: Mysaa
GPG Key ID: 7054D5D6A90F084F

44
main.ml
View File

@ -7,13 +7,13 @@ let fail () =
(* Parsage des arguments*) (* Parsage des arguments*)
let filename = ref "" in let filename = ref "" in
let reduce = ref false in let reduce_option = ref false in
let alpha = ref false in let alpha_option = ref false in
let typecheck_option = ref false in let typecheck_option = ref false in
Arg.parse Arg.parse
[("-reduce", Arg.Set reduce, "Show the step-by-step reduction of a lambda-term"); [("-reduce", Arg.Set reduce_option, "Show the step-by-step reduction of a lambda-term");
("-alpha", Arg.Set alpha, "Check is two lambda-terms separated by '&' are alpha-convertible"); ("-alpha", Arg.Set alpha_option, "Check is two lambda-terms separated by '&' are alpha-convertible");
("-typecheck", Arg.Set typecheck_option, "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) (fun s -> filename := s)
"The available options are:"; "The available options are:";
@ -65,6 +65,15 @@ while !subgoals <> [] do
let (ty, hyps) = List.hd !subgoals in let (ty, hyps) = List.hd !subgoals in
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
let find_hyp (var: var_lambda) : ty option =
let rec explore = function
| [] -> None
| (var_hyp, hyp) :: hyps when var_hyp = var -> Some hyp
| _ :: hyps -> explore hyps
in
explore hyps
in
if is_interactive then ( if is_interactive then (
(* Nettoyage du terminal *) (* Nettoyage du terminal *)
let _ = Sys.command("clear -x") in let _ = Sys.command("clear -x") in
@ -75,6 +84,9 @@ while !subgoals <> [] do
(* Affichage des sous-buts *) (* Affichage des sous-buts *)
Printf.printf "================\n"; Printf.printf "================\n";
Printf.printf "%s\n" (string_of_ty ty); Printf.printf "%s\n" (string_of_ty ty);
List.iter (fun (ty, _) ->
Printf.printf "%s\n" (string_of_ty ty)
) !subgoals;
(* Lecture d'une tactique *) (* Lecture d'une tactique *)
Printf.printf "What do you want to do?\n" Printf.printf "What do you want to do?\n"
@ -120,27 +132,21 @@ while !subgoals <> [] do
explore hyps explore hyps
) )
| Apply var -> ( | Apply var -> (
let rec explore = function match find_hyp var with
| (var_hyp, TImpl (t1, t2)) :: _ when var_hyp = var && t2 = ty -> ( | Some (TImpl (t1, t2)) when t2 = ty -> (
subgoals := (t1, hyps) :: !subgoals; subgoals := (t1, hyps) :: !subgoals;
fill_holes := function fill_holes := function
| hole :: holes -> f ((LApp (LVar var_hyp, hole)) :: holes) | hole :: holes -> f ((LApp (LVar var, hole)) :: holes)
| [] -> fail () | [] -> fail ()
) )
| [] -> failwith ("Hypothesis " ^ var ^ " not found or unusable") | None -> failwith ("Hypothesis " ^ var ^ " not found")
| _ :: hyps -> explore hyps | _ -> failwith ("Hypothesis " ^ var ^ " unusable")
in
explore hyps;
) )
| Elim var -> ( | Elim var -> (
let rec explore = function match find_hyp var with
| (var_hyp, ty_hyp) :: _ when var_hyp = var && ty_hyp = TFalse -> ( | Some TFalse -> fill_holes := fun holes -> f ((LExf (LVar var, ty)) :: holes)
fill_holes := fun holes -> f ((LExf (LVar var, ty)) :: holes) | None -> failwith ("Hypothesis " ^ var ^ " not found")
) | _ -> failwith ("Hypothesis " ^ var ^ " unusable")
| [] -> failwith ("Hypothesis " ^ var ^ " not found or unusable")
| _ :: hyps -> explore hyps
in
explore hyps;
) )
| Cut tint -> ( | Cut tint -> (
subgoals := (TImpl(tint, ty), hyps)::(tint, hyps)::!subgoals; subgoals := (TImpl(tint, ty), hyps)::(tint, hyps)::!subgoals;