Merge remote-tracking branch 'origin/master'
This commit is contained in:
commit
98a9e6964f
44
main.ml
44
main.ml
@ -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;
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user