diff --git a/lexer.mll b/lexer.mll index f6f533a..c16d0f6 100644 --- a/lexer.mll +++ b/lexer.mll @@ -2,22 +2,21 @@ open Parser } -rule token_ty = parse - | [' ' '\t' '\n'] { token_ty lexbuf } +rule token = parse + | [' ' '\t' '\n'] { token lexbuf } | eof { EOF } | '(' { LPAREN } | ')' { RPAREN } | "->" { RARROW } | '~' { TILDE } - | "False" { FALSE } - | ['A'-'Z']+['0'-'9']* as s { TYPE_NAME s } -and token_tactic = parse - | [' ' '\t' '\n'] { token_tactic lexbuf } - | eof { EOF } | "intro" { INTRO } | "assumption" { ASSUMPTION } | "apply" { APPLY } + | "cut" { CUT } + | "False" { FALSE } + + | ['A'-'Z']+['0'-'9']* as s { TYPE_NAME s } | ['a'-'z']+['0'-'9']* as s { VAR_NAME s } | '.' { DOT } diff --git a/main.ml b/main.ml index d96472a..0015339 100644 --- a/main.ml +++ b/main.ml @@ -48,7 +48,7 @@ show "Please type the formula to prove\n"; let ty = try let lexbuf = Lexing.from_string (readline ()) in - Parser.main_type Lexer.token_ty lexbuf + Parser.main_type Lexer.token lexbuf with e -> ( Printf.printf "Can't parse type\n"; raise e @@ -84,7 +84,7 @@ while !subgoals <> [] do let rec read_tactic () = try let lexbuf = Lexing.from_string (readline ()) in - Parser.main_tactic Lexer.token_tactic lexbuf + Parser.main_tactic Lexer.token lexbuf with e -> ( Printf.printf "Can't parse tactic\n"; if is_interactive then @@ -132,6 +132,12 @@ while !subgoals <> [] do in explore hyps; ) + | Cut tint -> ( + subgoals := (TImpl(tint, ty), hyps)::(tint, hyps)::!subgoals; + fill_holes := function + | (pf::px::s) -> f ((LApp(pf, px))::s) + | _ -> fail () + ) done; let finalLam = !fill_holes [] in diff --git a/parser.mly b/parser.mly index 7d52621..dea3ca5 100644 --- a/parser.mly +++ b/parser.mly @@ -10,7 +10,7 @@ %token VAR_NAME %token TYPE_NAME -%token DOT INTRO ASSUMPTION APPLY +%token DOT INTRO ASSUMPTION APPLY CUT /* L'ordre de définition définit la priorité */ %right RARROW @@ -40,3 +40,4 @@ tactic: | INTRO VAR_NAME DOT { Intro $2 } | ASSUMPTION DOT { Assumption } | APPLY VAR_NAME DOT { Apply $2 } + | CUT ty DOT { Cut $2 } diff --git a/pieuvre.ml b/pieuvre.ml index 08fe688..6462c9a 100644 --- a/pieuvre.ml +++ b/pieuvre.ml @@ -16,7 +16,7 @@ let rec string_of_ty (t: ty) : string = (* Affiche un λ-terme avec la même syntaxe qu’en entrée *) let rec string_of_lam (l: lam) : string = match l with | LFun(v,t,l') -> "λ"^v^":"^(string_of_ty t)^" . "^(string_of_lam l') - | LApp(l1, l2) -> (string_of_lam l1)^" "^(string_of_lam l2) + | LApp(l1, l2) -> "("^(string_of_lam l1)^" "^(string_of_lam l2)^")" | LVar(v) -> v | LExf(l',t) -> "exf("^(string_of_lam l')^" : "^(string_of_ty t)^")" ;; diff --git a/tactic.ml b/tactic.ml index 2f9dbfb..be4a408 100644 --- a/tactic.ml +++ b/tactic.ml @@ -3,4 +3,5 @@ open Structs;; type tactic = | Intro of var_lambda | Assumption - | Apply of var_lambda;; + | Apply of var_lambda + | Cut of ty;;