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

Assumption

Browse Source
This commit is contained in:
Adrien Vannson 2022-05-09 00:42:33 +02:00
parent 5304002158
commit 40ac538cc1
No known key found for this signature in database
GPG Key ID: FE2E66FD978C1A55
3 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lexer.mll
View File

@ -17,5 +17,6 @@ and token_tactic = parse
| [' ' '\t' '\n'] { token_tactic lexbuf }
| eof { EOF }
| "intro" { INTRO }
| "assumption" { ASSUMPTION }
| ['a'-'z']+['0'-'9']* as s { VAR_NAME s }
| '.' { DOT }

21
main.ml
View File

@ -62,7 +62,7 @@ let subgoals: (ty * (var_lambda * ty) list) list ref = ref [(ty, [])] in
let fill_holes = ref (fun holes -> List.hd holes) in
while !subgoals <> [] do
let (ty, hyp) = List.hd !subgoals in
let (ty, hyps) = List.hd !subgoals in
subgoals := List.tl !subgoals;
if is_interactive then (
@ -70,7 +70,7 @@ while !subgoals <> [] do
let _ = Sys.command("clear -x") in
(* Affichage des hypothèses *)
List.iter (fun (var, h) -> Printf.printf "%s: %s\n" var (string_of_ty h)) hyp;
List.iter (fun (var, h) -> Printf.printf "%s: %s\n" var (string_of_ty h)) hyps;
(* Affichage des sous-buts *)
Printf.printf "================\n";
@ -96,18 +96,29 @@ while !subgoals <> [] do
read_tactic ()
in
let f = !fill_holes in
match tactic with
| Intro var -> (
match ty with
| TImpl (ty1, ty2) -> (
subgoals := (ty2, (var, ty1) :: hyp) :: !subgoals;
let f = !fill_holes in
subgoals := (ty2, (var, ty1) :: hyps) :: !subgoals;
fill_holes := fun holes -> match holes with
| h :: hs -> f (LFun (var, ty1, h) :: hs)
| _ -> fail ()
)
| _ -> failwith "Can't intro"
)
| Assumption -> (
let rec explore = function
| (var, hyp) :: _ when hyp = ty -> (
fill_holes := fun holes -> f ((LVar var) :: holes)
)
| [] -> failwith "No such hypothesis"
| _ :: hyps -> explore hyps
in
explore hyps
)
done;
Printf.printf "Final proof :\n%s" (string_of_lam (!fill_holes []));;
Printf.printf "Final proof :\n%s\n" (string_of_lam (!fill_holes []));;

3
parser.mly
View File

@ -10,7 +10,7 @@
%token <string> VAR_NAME
%token <string> TYPE_NAME
%token DOT INTRO
%token DOT INTRO ASSUMPTION
/* L'ordre de définition définit la priorité */
%right RARROW
@ -38,3 +38,4 @@ main_tactic:
tactic:
| INTRO VAR_NAME DOT { Intro $2 }
| ASSUMPTION DOT { Assumption }