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

59
main.ml
View File

@ -215,7 +215,7 @@ while !subgoals <> [] do
| h :: hs -> f (LFun (var, ty1, h) :: hs)
| _ -> 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 (t :: ts) -> (
@ -228,7 +228,7 @@ while !subgoals <> [] do
subgoals := List.tl !subgoals;
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
in
explore hyps
@ -242,8 +242,14 @@ while !subgoals <> [] do
| hole :: holes -> f ((LApp (LVar var, hole)) :: holes)
| [] -> 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 no implication."))
| None -> raise (TacticException (
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 -> (
match find_hyp var with
@ -253,20 +259,26 @@ while !subgoals <> [] do
)
| Some TAnd(tl,tr) -> (
subgoals := List.tl !subgoals;
subgoals := (TImpl(tl,TImpl(tr,ty)),hyps)::!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)
| h::r -> f ((LApp (LApp (h, LFst (LVar var)), LSnd (LVar var))) :: r)
| _ -> raise TrouException
)
| Some TOr(tl,tr) -> (
subgoals := List.tl !subgoals;
subgoals := (TImpl(tl,ty),hyps)::(TImpl(tr,ty),hyps)::!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)
| 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, nor a /\\ or a \\/"))
| 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 *)
| Cut tint -> (
@ -286,7 +298,7 @@ while !subgoals <> [] do
| h1 :: h2 :: hs -> f (LCouple(h1,h2) :: hs)
| _ -> 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 -> (
match ty with
@ -297,7 +309,7 @@ while !subgoals <> [] do
| hl :: hs -> f (LIg(hl,tr) :: hs)
| _ -> 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 -> (
match ty with
@ -308,11 +320,20 @@ while !subgoals <> [] do
| hr :: hs -> f (LId(hr,tl) :: hs)
| _ -> 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 -> (
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 (
subgoals := List.tl !subgoals;
fill_holes := fun holes -> f (l::holes)
@ -329,10 +350,16 @@ while !subgoals <> [] do
with
| TacticException(t,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 ->
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 ->
Printf.printf "\027[31mPieuvre Failed Unexpectedly !\027[0m\n";
raise e