l3-ENSL/pieuvre
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

renommage des tactiques, implémentation de la tactique try, suppression des tokens inutiles, etc..

Browse Source
This commit is contained in:
Marwan 2024-05-17 14:14:28 +02:00
parent b1ccb0ad71
commit d3dcebdb88
5 changed files with 80 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lexer.mll
View File

@ -15,9 +15,6 @@ rule token = parse
| [' ' '\t' '\n'] { token lexbuf } | [' ' '\t' '\n'] { token lexbuf }
| '.' { DOT } | '.' { DOT }
| ',' { COMMA } | ',' { COMMA }
| '+' { PLUS }
| '*' { TIMES }
| "True" { TOP }
| "False" { BOT } | "False" { BOT }
| '(' { LPAREN } | '(' { LPAREN }
| ')' { RPAREN } | ')' { RPAREN }
@ -37,7 +34,6 @@ rule token = parse
| "Qed" { QED } | "Qed" { QED }
| "exact" { EXACT } | "exact" { EXACT }
| "assumption" { ASSUMPTION } | "assumption" { ASSUMPTION }
| "destruct" { DESTRUCT }
| "intros" { INTROS } | "intros" { INTROS }
| "intro" { INTRO } | "intro" { INTRO }
| "cut" { CUT } | "cut" { CUT }
@ -45,6 +41,7 @@ rule token = parse
| "left" { LEFT } | "left" { LEFT }
| "right" { RIGHT } | "right" { RIGHT }
| "split" { SPLIT } | "split" { SPLIT }
| "try" { TRY }
| var_id as s { VARID(s) } | var_id as s { VARID(s) }
| ty_id as s { TYID(s) } | ty_id as s { TYID(s) }

64
main.ml
View File

@ -5,7 +5,7 @@ open Types
open Hlam open Hlam
type entry = type entry =
Simple of (unit -> cmd) Simple of (unit -> instr)
| Reduce of Lam.lam | Reduce of Lam.lam
| AlphaEquiv of Lam.lam * Lam.lam | AlphaEquiv of Lam.lam * Lam.lam
@ -14,11 +14,11 @@ type interactive_state = (hlam * ty) option * proof
let parse_lam t = let parse_lam t =
match Parser.main Lexer.token t with match Parser.main Lexer.token t with
| Lam l -> l | Lam l -> l
| Cmd _ -> failwith "entry must be a lam" | Instr _ -> failwith "entry must be a lam"
let parse_cmd t = let parse_cmd t =
match Parser.main Lexer.token t with match Parser.main Lexer.token t with
| Cmd c -> c | Instr is -> is
| Lam _ -> failwith "entry must be a cmd" | Lam _ -> failwith "entry must be a cmd"
let show_beta_reduction e = let show_beta_reduction e =
@ -60,7 +60,7 @@ let alpha_get_lam where_from =
- g, gs : next goals - g, gs : next goals
- sq : previous states of the interactive loop - sq : previous states of the interactive loop
*) *)
let rec interactive (get_cmd : unit -> cmd) (sl : (interactive_state) list) : proof = let rec interactive (get_instr : unit -> instr) (sl : (interactive_state) list) : proof =
let (cg, (g, gs)), sq = match sl with let (cg, (g, gs)), sq = match sl with
[] -> (None, (None, [])), [] [] -> (None, (None, [])), []
| s::sq -> s, sq | s::sq -> s, sq
@ -72,38 +72,40 @@ let rec interactive (get_cmd : unit -> cmd) (sl : (interactive_state) list) : pr
in in
try try
match get_cmd () with match get_instr () with
Goal ty -> Cmd c -> begin match c with
let rh = Ref (ref Hole) in Goal ty ->
[Some (rh, ty), (Some (rh, ty, []), [])] |> interactive get_cmd let rh = Ref (ref Hole) in
| Undo -> interactive get_cmd sq [Some (rh, ty), (Some (rh, ty, []), [])] |> interactive get_instr
| Qed -> begin match cg with | Undo -> interactive get_instr sq
None -> | Qed -> begin match cg with
print_error "No current goal" ""; None ->
(cg, (g, gs))::sq |> interactive get_cmd print_error "No current goal" "";
| Some (h, t) -> (cg, (g, gs))::sq |> interactive get_instr
let l = lam_of_hlam h | Some (h, t) ->
|> beta_reduce in let l = lam_of_hlam h
if Typing.typecheck [] l t then begin |> beta_reduce in
print_string "Ok"; if Typing.typecheck [] l t then begin
[None, (None, [])] |> interactive get_cmd print_string "Ok";
end else begin [None, (None, [])] |> interactive get_instr
print_error "Typing failed" ""; end else begin
print_expr l; print_error "Typing failed" "";
print_newline (); print_expr l;
print_ty t; print_newline ();
(cg, (g, gs))::sq |> interactive get_cmd print_ty t;
end (cg, (g, gs))::sq |> interactive get_instr
end
end
end end
| Tact t -> | Tact t ->
(cg, (apply_tactic (g, gs) t))::(clean_state (cg, (g, gs)))::sq |> interactive get_cmd (cg, (apply_tactic (g, gs) t))::(clean_state (cg, (g, gs)))::sq |> interactive get_instr
with with
Parser.Error -> Parser.Error ->
print_error "Invalid input" ""; print_error "Invalid input" "";
(cg, (g, gs))::sq |> interactive get_cmd (cg, (g, gs))::sq |> interactive get_instr
| TacticFailed arg -> | TacticFailed arg ->
print_error "Tactic failed" arg; print_error "Tactic failed" arg;
(cg, (g, gs))::sq |> interactive get_cmd (cg, (g, gs))::sq |> interactive get_instr
| End_of_file | Lexer.Eof -> | End_of_file | Lexer.Eof ->
print_string "Bye!\n"; print_string "Bye!\n";
(g, gs) (g, gs)
@ -176,8 +178,8 @@ let recupere_entree () =
let run () = let run () =
try try
match recupere_entree () with match recupere_entree () with
Simple get_cmd -> Simple get_instr ->
let _ = interactive get_cmd [None, (None, [])] in () let _ = interactive get_instr [None, (None, [])] in ()
| Reduce l -> | Reduce l ->
let _ = show_beta_reduction l in () let _ = show_beta_reduction l in ()
| AlphaEquiv (l1, l2) -> begin | AlphaEquiv (l1, l2) -> begin

34
parser.mly
View File

@ -8,8 +8,7 @@ open Parser_entry
%token EOF %token EOF
%token DOT COMMA %token DOT COMMA
%token PLUS TIMES %token BOT EXFALSO TILDE
%token TOP BOT EXFALSO TILDE
%token LPAREN RPAREN %token LPAREN RPAREN
%token FUN ARR COLON TARR %token FUN ARR COLON TARR
%token AND OR %token AND OR
@ -18,7 +17,7 @@ open Parser_entry
%token GOAL UNDO QED %token GOAL UNDO QED
%token EXACT ASSUMPTION INTRO INTROS CUT APPLY %token EXACT ASSUMPTION INTRO INTROS CUT APPLY
%token LEFT RIGHT SPLIT DESTRUCT %token LEFT RIGHT SPLIT TRY
%token L R %token L R
%right TARR %right TARR
@ -33,26 +32,29 @@ open Parser_entry
%% %%
main: main:
| e=expression EOF { Lam e } | e=expression EOF { Lam e }
| ts=nonempty_list(tactic) EOF { Cmd ts } | ts=nonempty_list(instr) EOF { Instr ts }
tactic: instr:
| c=command DOT { c } | c=command DOT { Cmd c }
| t=tactic DOT { Tact t }
command: command:
| GOAL t=ty { Goal t } | GOAL t=ty { Goal t }
| UNDO { Undo } | UNDO { Undo }
| QED { Qed } | QED { Qed }
| EXACT e=expression { Tact (Exact_term e) }
| EXACT s=TYID { Tact (Exact_proof s) }
| ASSUMPTION { Tact (Assumption) }
| INTROS { Tact (Intros) }
| INTRO { Tact (Intro) }
| SPLIT { Tact (Split) }
| RIGHT { Tact (Right) }
| LEFT { Tact (Left) }
| CUT t=ty { Tact (Cut t) }
| APPLY s=TYID { Tact (Apply s) }
tactic:
| EXACT e=expression { TExact_term e }
| EXACT s=TYID { TExact_proof s }
| ASSUMPTION { TAssumption }
| INTROS { TIntros }
| INTRO { TIntro }
| SPLIT { TSplit }
| RIGHT { TRight }
| LEFT { TLeft }
| CUT t=ty { TCut t }
| APPLY s=TYID { TApply s }
| TRY t=tactic { TTry t }
ty_annot: ty_annot:
| id=VARID COLON t=ty { (id, t) } | id=VARID COLON t=ty { (id, t) }

7
parser_entry.ml
View File

@ -3,11 +3,14 @@ open Types
open Proof open Proof
type cmd = type cmd =
| Goal of ty Goal of ty
| Undo | Undo
| Qed | Qed
type instr =
Cmd of cmd
| Tact of tactic | Tact of tactic
type parser_entry = type parser_entry =
| Lam of lam | Lam of lam
| Cmd of cmd list | Instr of instr list

44
proof.ml
View File

@ -7,16 +7,17 @@ type goal = hlam * Types.ty * context
type proof = goal option * goal list type proof = goal option * goal list
type tactic = type tactic =
Exact_term of lam TExact_term of lam
| Exact_proof of id | TExact_proof of id
| Assumption | TAssumption
| Intros | TIntros
| Intro | TIntro
| Cut of ty | TCut of ty
| Apply of id | TApply of id
| Split | TSplit
| Right | TRight
| Left | TLeft
| TTry of tactic
let hyp_count = ref 0 let hyp_count = ref 0
let get_fresh_hyp () = let get_fresh_hyp () =
@ -216,18 +217,19 @@ let tact_left ((g, gs) : proof) : proof =
Some (new_h, t_l, cs), gs Some (new_h, t_l, cs), gs
| _ -> raise (TacticFailed "Not a disjunction") | _ -> raise (TacticFailed "Not a disjunction")
let apply_tactic (p : proof) (t : tactic) : proof = let rec apply_tactic (p : proof) (t : tactic) : proof =
match t with match t with
Exact_term e -> tact_exact_term p e TExact_term e -> tact_exact_term p e
| Exact_proof hyp -> tact_exact_proof p hyp | TExact_proof hyp -> tact_exact_proof p hyp
| Intros -> tact_intros p | TIntros -> tact_intros p
| Intro -> tact_intro p | TIntro -> tact_intro p
| Assumption -> tact_assumption p | TAssumption -> tact_assumption p
| Cut t -> tact_cut p t | TCut t -> tact_cut p t
| Apply h -> tact_apply p h | TApply h -> tact_apply p h
| Split -> tact_split p | TSplit -> tact_split p
| Right -> tact_right p | TRight -> tact_right p
| Left -> tact_left p | TLeft -> tact_left p
| TTry t -> try apply_tactic p t with TacticFailed _ -> p
let tact_try (p : proof) (t : tactic) : proof = let tact_try (p : proof) (t : tactic) : proof =