Mysaa/pieuvre
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Style

Browse Source
This commit is contained in:
Adrien Vannson 2022-05-19 21:50:57 +02:00
parent 819ce2d6de
commit 2d6028e010
No known key found for this signature in database
GPG Key ID: FE2E66FD978C1A55
1 changed files with 85 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

143
main.ml
View File

@ -206,113 +206,134 @@ while !subgoals <> [] do
let f = !fill_holes in let f = !fill_holes in
match tactic with match tactic with
| Intro var -> ( | Intro var -> (
match ty with match ty with
| TImpl (ty1, ty2) -> ( | TImpl (ty1, ty2) -> (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
subgoals := (ty2, (var, ty1) :: hyps) :: !subgoals; subgoals := (ty2, (var, ty1) :: hyps) :: !subgoals;
fill_holes := fun holes -> match holes with fill_holes := fun holes -> match holes with
| h :: hs -> f (LFun (var, ty1, h) :: hs) | h :: hs -> f (LFun (var, ty1, h) :: hs)
| _ -> raise TrouException | _ -> raise TrouException
) )
| _ -> raise (TacticException(tactic, "Cannot intro when the goal is no implication.")) | _ -> raise (TacticException(tactic, "Cannot intro when the goal is not an implication."))
) )
| Intros [] -> () | Intros [] -> ()
| Intros (t :: ts) -> ( | Intros (t :: ts) -> (
applyTactic (Intro t); applyTactic (Intro t);
applyTactic (Intros ts) applyTactic (Intros ts)
) )
| Assumption -> ( | Assumption -> (
let rec explore = function let rec explore = function
| (var, hyp) :: _ when hyp = ty -> ( | (var, hyp) :: _ when hyp = ty -> (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
fill_holes := fun holes -> f ((LVar var) :: holes) fill_holes := fun holes -> f ((LVar var) :: holes)
) )
| [] -> raise (TacticException(tactic,"Cannot find a tactic that equals the goal.")) | [] -> raise (TacticException (tactic, "Cannot find such an assumption."))
| _ :: hyps -> explore hyps | _ :: hyps -> explore hyps
in in
explore hyps explore hyps
) )
| Apply var -> ( | Apply var -> (
match find_hyp var with match find_hyp var with
| Some (TImpl (t1, t2)) when t2 = ty -> ( | Some (TImpl (t1, t2)) when t2 = ty -> (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
subgoals := (t1, hyps) :: !subgoals; subgoals := (t1, hyps) :: !subgoals;
fill_holes := function fill_holes := function
| hole :: holes -> f ((LApp (LVar var, hole)) :: holes) | hole :: holes -> f ((LApp (LVar var, hole)) :: holes)
| [] -> raise TrouException | [] -> raise TrouException
) )
| None -> raise (TacticException(tactic,"Cannot apply hypotesis "^var^" as it does not exist.")) | None -> raise (TacticException (
| _ -> raise (TacticException(tactic,"Cannot apply hypotesis "^var^" as it is no implication.")) tactic,
"Cannot apply hypotesis " ^ var ^ " as it does not exist."
))
| _ -> raise (TacticException (
tactic,
"Cannot apply hypotesis " ^ var ^ " as it is not an implication."
))
) )
| Elim var -> ( | Elim var -> (
match find_hyp var with match find_hyp var with
| Some TFalse -> ( | Some TFalse -> (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
fill_holes := fun holes -> f ((LExf (LVar var, ty)) :: holes) fill_holes := fun holes -> f ((LExf (LVar var, ty)) :: holes)
)
| Some TAnd(tl,tr) -> (
subgoals := List.tl !subgoals;
subgoals := (TImpl(tl,TImpl(tr,ty)),hyps)::!subgoals;
fill_holes := fun holes -> match holes with
| h::r -> f ((LApp(LApp(h,LFst(LVar(var))),LSnd(LVar(var))))::r)
| _ -> raise TrouException
) )
| Some TOr(tl,tr) -> ( | Some TAnd(tl,tr) -> (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
subgoals := (TImpl(tl,ty),hyps)::(TImpl(tr,ty),hyps)::!subgoals; subgoals := (TImpl (tl, TImpl (tr, ty)), hyps) :: !subgoals;
fill_holes := fun holes -> match holes with fill_holes := fun holes -> match holes with
| hl::hr::r -> f (LCase(LVar(var),hl,hr)::r) | h::r -> f ((LApp (LApp (h, LFst (LVar var)), LSnd (LVar var))) :: r)
| _ -> raise TrouException | _ -> raise TrouException
) )
| None -> raise (TacticException(tactic,"Cannot apply hypotesis "^var^" as it does not exist.")) | Some TOr(tl,tr) -> (
| _ -> raise (TacticException(tactic,"Cannot apply hypotesis "^var^" as it is neither an implication, nor a /\\ or a \\/")) subgoals := List.tl !subgoals;
subgoals := (TImpl (tl, ty), hyps) :: (TImpl (tr, ty), hyps) :: !subgoals;
fill_holes := fun holes -> match holes with
| hl::hr::r -> f (LCase (LVar var, hl, hr) :: r)
| _ -> raise TrouException
)
| None -> raise (TacticException (
tactic,
"Cannot apply hypotesis " ^ var ^ " as it does not exist."
))
| _ -> raise (TacticException (
tactic,
"Cannot apply hypotesis " ^ var ^ " as it is neither an implication, a /\\ nor a \\/"
))
) )
(* Pour montrer A, on montre B -> A et B *) (* Pour montrer A, on montre B -> A et B *)
| Cut tint -> ( | Cut tint -> (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
subgoals := (TImpl (tint, ty), hyps) :: (tint, hyps) :: !subgoals; subgoals := (TImpl (tint, ty), hyps) :: (tint, hyps) :: !subgoals;
fill_holes := function fill_holes := function
| pf :: px :: s -> f ((LApp (pf, px)) :: s) | pf :: px :: s -> f ((LApp (pf, px)) :: s)
| _ -> raise TrouException | _ -> raise TrouException
) )
| Split -> ( | Split -> (
match ty with match ty with
| TAnd(t1,t2) -> ( | TAnd(t1,t2) -> (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
subgoals := (t1, hyps) :: (t2, hyps) :: !subgoals; subgoals := (t1, hyps) :: (t2, hyps) :: !subgoals;
fill_holes := fun holes -> match holes with fill_holes := fun holes -> match holes with
| h1 :: h2 :: hs -> f (LCouple(h1,h2) :: hs) | h1 :: h2 :: hs -> f (LCouple(h1,h2) :: hs)
| _ -> raise TrouException | _ -> raise TrouException
) )
| _ -> raise (TacticException(tactic,"Cannot split as the goal is no /\\ clause")) | _ -> raise (TacticException (tactic, "Cannot split as the goal is not a /\\"))
) )
| Left -> ( | Left -> (
match ty with match ty with
| TOr(tl,tr) -> ( | TOr(tl,tr) -> (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
subgoals := (tl, hyps) :: !subgoals; subgoals := (tl, hyps) :: !subgoals;
fill_holes := fun holes -> match holes with fill_holes := fun holes -> match holes with
| hl :: hs -> f (LIg(hl,tr) :: hs) | hl :: hs -> f (LIg(hl,tr) :: hs)
| _ -> raise TrouException | _ -> raise TrouException
) )
| _ -> raise (TacticException(tactic,"Cannot prove left as the goal is no \\/ clause")) | _ -> raise (TacticException (tactic, "Cannot apply left as the goal is not a \\/"))
) )
| Right -> ( | Right -> (
match ty with match ty with
| TOr(tl,tr) -> ( | TOr(tl,tr) -> (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
subgoals := (tr, hyps) :: !subgoals; subgoals := (tr, hyps) :: !subgoals;
fill_holes := fun holes -> match holes with fill_holes := fun holes -> match holes with
| hr :: hs -> f (LId(hr,tl) :: hs) | hr :: hs -> f (LId(hr,tl) :: hs)
| _ -> raise TrouException | _ -> raise TrouException
) )
| _ -> raise (TacticException(tactic,"Cannot prove right as the goal is no \\/ clause")) | _ -> raise (TacticException (tactic, "Cannot apply right as the goal is not a \\/"))
) )
| Exact l -> ( | Exact l -> (
if not (typecheck hyps l ty) then if not (typecheck hyps l ty) then
raise (TacticException(tactic,"λ-term "^(string_of_lam l)^" cannot be typed with "^(string_of_ty ty)^" as its type is "^(match (computeType [] l) with None -> "None" | Some t -> string_of_ty t))) let ty_str = match computeType [] l with
| None -> "None"
| Some t -> string_of_ty t
in
raise (TacticException (
tactic,
"λ-term " ^ (string_of_lam l) ^
" can't be typed with " ^ (string_of_ty ty) ^
" as its type is " ^ ty_str
))
else ( else (
subgoals := List.tl !subgoals; subgoals := List.tl !subgoals;
fill_holes := fun holes -> f (l::holes) fill_holes := fun holes -> f (l::holes)
@ -329,10 +350,16 @@ while !subgoals <> [] do
with with
| TacticException(t,s) -> | TacticException(t,s) ->
Printf.printf "\027[31mCannot apply the tactic: %s\027[0m\n" s; Printf.printf "\027[31mCannot apply the tactic: %s\027[0m\n" s;
if(is_interactive) then applyUntilWorking () else raise (TacticException(t,s)) if is_interactive then
applyUntilWorking ()
else
raise (TacticException (t,s))
| TacticParseException -> | TacticParseException ->
Printf.printf "\027[31mCannot parse the tactic, please refer to pieuvre documentation.\027[0m\n"; Printf.printf "\027[31mCannot parse the tactic, please refer to pieuvre documentation.\027[0m\n";
if(is_interactive) then applyUntilWorking () else raise TacticParseException if is_interactive then
applyUntilWorking ()
else
raise TacticParseException
| e -> | e ->
Printf.printf "\027[31mPieuvre Failed Unexpectedly !\027[0m\n"; Printf.printf "\027[31mPieuvre Failed Unexpectedly !\027[0m\n";
raise e raise e