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

81
main.ml
View File

@ -1,8 +1,14 @@
open Structs;; open Structs;;
open Pieuvre;; open Pieuvre;;
open Tactic;;
let fail () = (* Lorsqu'une tactique ne peut se lancer. Contient la tactique ainsi qu'un message contenant l'erreur.*)
failwith "Unknown error";; 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,24 +160,16 @@ 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 -> ( with e -> raise TacticParseException
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 let f = !fill_holes in
match tactic with match tactic with
| Intro var -> ( | Intro var -> (
match ty with match ty with
@ -179,16 +177,16 @@ while !subgoals <> [] do
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)
| _ -> fail () | _ -> raise TrouException
) )
| _ -> failwith "Can't intro" | _ -> raise (TacticException(tactic,"Cannot intro when the goal is no implication."))
) )
| Assumption -> ( | Assumption -> (
let rec explore = function let rec explore = function
| (var, hyp) :: _ when hyp = ty -> ( | (var, hyp) :: _ when hyp = ty -> (
fill_holes := fun holes -> f ((LVar var) :: holes) fill_holes := fun holes -> f ((LVar var) :: holes)
) )
| [] -> failwith "No such hypothesis" | [] -> raise (TacticException(tactic,"Cannot find a tactic that equals the goal."))
| _ :: hyps -> explore hyps | _ :: hyps -> explore hyps
in in
explore hyps explore hyps
@ -199,10 +197,10 @@ while !subgoals <> [] do
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)
| [] -> fail () | [] -> raise TrouException
) )
| None -> failwith ("Hypothesis " ^ var ^ " not found") | None -> raise (TacticException(tactic,"Cannot apply hypotesis "^var^" as it does not exist."))
| _ -> failwith ("Hypothesis " ^ var ^ " unusable") | _ -> raise (TacticException(tactic,"Cannot apply hypotesis "^var^" as it is no implication."))
) )
| Elim var -> ( | Elim var -> (
match find_hyp var with match find_hyp var with
@ -211,34 +209,34 @@ while !subgoals <> [] do
subgoals := (TImpl(tl,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
| 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)
| _ -> fail () | _ -> raise TrouException
) )
| Some TOr(tl,tr) -> ( | Some TOr(tl,tr) -> (
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 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)
| _ -> fail () | _ -> raise TrouException
) )
| None -> failwith ("Hypothesis " ^ var ^ " not found") | None -> raise (TacticException(tactic,"Cannot apply hypotesis "^var^" as it does not exist."))
| _ -> failwith ("Hypothesis " ^ var ^ " unusable") | _ -> 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 *) (* Pour montrer A, on montre B -> A et B *)
| Cut tint -> ( | Cut tint -> (
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)
| _ -> fail () | _ -> raise TrouException
) )
| Split ovar -> ( | Split -> (
match ty with match ty with
| TAnd(t1,t2) -> ( | TAnd(t1,t2) -> (
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)
| _ -> fail () | _ -> raise TrouException
) )
| _ -> failwith "Target not a and clause" | _ -> raise (TacticException(tactic,"Cannot split as the goal is no /\\ clause"))
) )
| Left -> ( | Left -> (
match ty with match ty with
@ -246,9 +244,9 @@ while !subgoals <> [] do
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)
| _ -> fail () | _ -> raise TrouException
) )
| _ -> failwith "Target not a or clause" | _ -> raise (TacticException(tactic,"Cannot prove left as the goal is no \\/ clause"))
) )
| Right -> ( | Right -> (
match ty with match ty with
@ -256,10 +254,31 @@ while !subgoals <> [] do
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)
| _ -> fail () | _ -> raise TrouException
) )
| _ -> failwith "Target not a or clause" | _ -> raise (TacticException(tactic,"Cannot prove right as the goal is no \\/ clause"))
) )
end
in
let rec applyUntilWorking () =
try
(
let readTactic = read_tactic () in
applyTactic readTactic
)
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))
| TacticParseException ->
Printf.printf "\027[31mCannot parse the tactic, please refer to pieuvre documentation.\027[0m\n";
if(is_interactive) then applyUntilWorking () else raise TacticParseException
| e ->
Printf.printf "\027[31mPieuvre Failed Unexpectedly !\027[0m\n";
raise e
in
applyUntilWorking ()
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;;