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

Merge branch 'master' of gitlab.aliens-lyon.fr:savrillo/pieuvre

Browse Source
This commit is contained in:
Adrien Vannson 2022-05-17 11:43:50 +02:00
commit 7b69264e3f
No known key found for this signature in database
GPG Key ID: FE2E66FD978C1A55
4 changed files with 130 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

233
main.ml
View File

@ -1,8 +1,14 @@
open Structs;; open Structs;;
open Pieuvre;; open Pieuvre;;
open Tactic;;
let fail () =
failwith "Unknown error";; (* Lorsqu'une tactique ne peut se lancer. Contient la tactique ainsi qu'un message contenant l'erreur.*)
exception TacticException of tactic*string;;
(* Lorsqu'une tactique est mal écrite*)
exception TacticParseException;;
(* Exception renvoyée lorsque la fonction de trou est appelée sur une liste trop grande. *)
(* Ne devrait jamais être lancée *)
exception TrouException;;
(* Parsage des arguments*) (* Parsage des arguments*)
let filename = ref "" in let filename = ref "" in
@ -154,112 +160,125 @@ while !subgoals <> [] do
Printf.printf "What do you want to do?\n" Printf.printf "What do you want to do?\n"
); );
let tactic = let rec read_tactic () =
let rec read_tactic () = try
try let lexbuf = Lexing.from_string (readline ()) in
let lexbuf = Lexing.from_string (readline ()) in Parser.main_tactic Lexer.token lexbuf
Parser.main_tactic Lexer.token lexbuf with e -> raise TacticParseException
with e -> (
Printf.printf "Can't parse tactic\n";
if is_interactive then
read_tactic ()
else
raise e
)
in
read_tactic ()
in in
let applyTactic tactic =
begin
let f = !fill_holes in
match tactic with
| Intro var -> (
match ty with
| TImpl (ty1, ty2) -> (
subgoals := (ty2, (var, ty1) :: hyps) :: !subgoals;
fill_holes := fun holes -> match holes with
| h :: hs -> f (LFun (var, ty1, h) :: hs)
| _ -> raise TrouException
)
| _ -> raise (TacticException(tactic,"Cannot intro when the goal is no implication."))
)
| Assumption -> (
let rec explore = function
| (var, hyp) :: _ when hyp = ty -> (
fill_holes := fun holes -> f ((LVar var) :: holes)
)
| [] -> raise (TacticException(tactic,"Cannot find a tactic that equals the goal."))
| _ :: hyps -> explore hyps
in
explore hyps
)
| Apply var -> (
match find_hyp var with
| Some (TImpl (t1, t2)) when t2 = ty -> (
subgoals := (t1, hyps) :: !subgoals;
fill_holes := function
| 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."))
)
| Elim var -> (
match find_hyp var with
| Some TFalse -> fill_holes := fun holes -> f ((LExf (LVar var, ty)) :: holes)
| Some TAnd(tl,tr) -> (
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) -> (
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, nor a /\\ or a \\/"))
)
(* Pour montrer A, on montre B -> A et B *)
| Cut tint -> (
subgoals := (TImpl (tint, ty), hyps) :: (tint, hyps) :: !subgoals;
fill_holes := function
| pf :: px :: s -> f ((LApp (pf, px)) :: s)
| _ -> raise TrouException
)
let f = !fill_holes in | Split -> (
match ty with
match tactic with | TAnd(t1,t2) -> (
| Intro var -> ( subgoals := (t1, hyps) :: (t2, hyps) :: !subgoals;
match ty with fill_holes := fun holes -> match holes with
| TImpl (ty1, ty2) -> ( | h1 :: h2 :: hs -> f (LCouple(h1,h2) :: hs)
subgoals := (ty2, (var, ty1) :: hyps) :: !subgoals; | _ -> raise TrouException
fill_holes := fun holes -> match holes with )
| h :: hs -> f (LFun (var, ty1, h) :: hs) | _ -> raise (TacticException(tactic,"Cannot split as the goal is no /\\ clause"))
| _ -> fail () )
) | Left -> (
| _ -> failwith "Can't intro" match ty with
) | TOr(tl,tr) -> (
| Assumption -> ( subgoals := (tl, hyps) :: !subgoals;
let rec explore = function fill_holes := fun holes -> match holes with
| (var, hyp) :: _ when hyp = ty -> ( | hl :: hs -> f (LIg(hl,tr) :: hs)
fill_holes := fun holes -> f ((LVar var) :: holes) | _ -> raise TrouException
) )
| [] -> failwith "No such hypothesis" | _ -> raise (TacticException(tactic,"Cannot prove left as the goal is no \\/ clause"))
| _ :: hyps -> explore hyps )
in | Right -> (
explore hyps match ty with
) | TOr(tl,tr) -> (
| Apply var -> ( subgoals := (tr, hyps) :: !subgoals;
match find_hyp var with fill_holes := fun holes -> match holes with
| Some (TImpl (t1, t2)) when t2 = ty -> ( | hr :: hs -> f (LId(hr,tl) :: hs)
subgoals := (t1, hyps) :: !subgoals; | _ -> raise TrouException
fill_holes := function )
| hole :: holes -> f ((LApp (LVar var, hole)) :: holes) | _ -> raise (TacticException(tactic,"Cannot prove right as the goal is no \\/ clause"))
| [] -> fail () )
) end
| None -> failwith ("Hypothesis " ^ var ^ " not found") in
| _ -> failwith ("Hypothesis " ^ var ^ " unusable")
) let rec applyUntilWorking () =
| Elim var -> ( try
match find_hyp var with (
| Some TFalse -> fill_holes := fun holes -> f ((LExf (LVar var, ty)) :: holes) let readTactic = read_tactic () in
| Some TAnd(tl,tr) -> ( applyTactic readTactic
subgoals := (TImpl(tl,TImpl(tr,ty)),hyps)::!subgoals; )
fill_holes := fun holes -> match holes with with
| h::r -> f ((LApp(LApp(h,LFst(LVar(var))),LSnd(LVar(var))))::r) | TacticException(t,s) ->
| _ -> fail () Printf.printf "\027[31mCannot apply the tactic: %s\027[0m\n" s;
) if(is_interactive) then applyUntilWorking () else raise (TacticException(t,s))
| Some TOr(tl,tr) -> ( | TacticParseException ->
subgoals := (TImpl(tl,ty),hyps)::(TImpl(tr,ty),hyps)::!subgoals; Printf.printf "\027[31mCannot parse the tactic, please refer to pieuvre documentation.\027[0m\n";
fill_holes := fun holes -> match holes with if(is_interactive) then applyUntilWorking () else raise TacticParseException
| hl::hr::r -> f (LCase(LVar(var),hl,hr)::r) | e ->
| _ -> fail () Printf.printf "\027[31mPieuvre Failed Unexpectedly !\027[0m\n";
) raise e
| None -> failwith ("Hypothesis " ^ var ^ " not found") in
| _ -> failwith ("Hypothesis " ^ var ^ " unusable") applyUntilWorking ()
)
(* Pour montrer A, on montre B -> A et B *)
| Cut tint -> (
subgoals := (TImpl (tint, ty), hyps) :: (tint, hyps) :: !subgoals;
fill_holes := function
| pf :: px :: s -> f ((LApp (pf, px)) :: s)
| _ -> fail ()
)
| Split ovar -> (
match ty with
| TAnd(t1,t2) -> (
subgoals := (t1, hyps) :: (t2, hyps) :: !subgoals;
fill_holes := fun holes -> match holes with
| h1 :: h2 :: hs -> f (LCouple(h1,h2) :: hs)
| _ -> fail ()
)
| _ -> failwith "Target not a and clause"
)
| Left -> (
match ty with
| TOr(tl,tr) -> (
subgoals := (tl, hyps) :: !subgoals;
fill_holes := fun holes -> match holes with
| hl :: hs -> f (LIg(hl,tr) :: hs)
| _ -> fail ()
)
| _ -> failwith "Target not a or clause"
)
| Right -> (
match ty with
| TOr(tl,tr) -> (
subgoals := (tr, hyps) :: !subgoals;
fill_holes := fun holes -> match holes with
| hr :: hs -> f (LId(hr,tl) :: hs)
| _ -> fail ()
)
| _ -> failwith "Target not a or clause"
)
done; done;
let finalLam = !fill_holes [] in let finalLam = !fill_holes [] in

3
parser.mly
View File

@ -70,8 +70,7 @@ tactic:
| APPLY VAR_NAME DOT { Apply $2 } | APPLY VAR_NAME DOT { Apply $2 }
| ELIM VAR_NAME DOT { Elim $2 } | ELIM VAR_NAME DOT { Elim $2 }
| CUT ty DOT { Cut $2 } | CUT ty DOT { Cut $2 }
| SPLIT DOT { Split None } | SPLIT DOT { Split }
| SPLIT VAR_NAME DOT { Split (Some $2) }
| LEFT DOT { Left } | LEFT DOT { Left }
| RIGHT DOT { Right } | RIGHT DOT { Right }

4
pieuvre.ml
View File

@ -174,8 +174,8 @@ let rec betastep (l: lam) : lam option = match l with
| (LCouple(lg,ld),None) -> Some ld | (LCouple(lg,ld),None) -> Some ld
| (_,None) -> None | (_,None) -> None
end end
| LIg(ll,t) -> Option.bind (betastep ll) (fun l' -> Some (LIg(ll,t))) | LIg(ll,t) -> Option.bind (betastep ll) (fun l' -> Some (LIg(l',t)))
| LId(ll,t) -> Option.bind (betastep ll) (fun l' -> Some (LId(ll,t))) | LId(ll,t) -> Option.bind (betastep ll) (fun l' -> Some (LId(l',t)))
| LCase(ll,lg,ld) -> begin | LCase(ll,lg,ld) -> begin
match (ll,betastep ll) with match (ll,betastep ll) with
| (_,Some ll') -> Some (LFst(ll')) | (_,Some ll') -> Some (LFst(ll'))

2
tactic.ml
View File

@ -6,6 +6,6 @@ type tactic =
| Apply of var_lambda | Apply of var_lambda
| Elim of var_lambda | Elim of var_lambda
| Cut of ty | Cut of ty
| Split of var_lambda option | Split
| Left | Left
| Right;; | Right;;