This commit is contained in:
augustin64 2024-05-16 12:31:06 +02:00
parent fcfdbdc068
commit 543da0b297
4 changed files with 45 additions and 8 deletions

View File

@ -33,11 +33,33 @@ let rec string_of_expr = function
let s_ty = string_of_ty t in let s_ty = string_of_ty t in
"exf (" ^ s_e ^ " : " ^ s_ty ^ ")" "exf (" ^ s_e ^ " : " ^ s_ty ^ ")"
| Pair (e1, e2) -> | Pair (e1, e2) ->
"Pair("^(string_of_expr e1)^", "^(string_of_expr e2)^")" "("^(string_of_expr e1)^", "^(string_of_expr e2)^")"
| Left e | Right e -> | Left e ->
"["^(string_of_expr e)^"]" "l("^(string_of_expr e)^")"
| Right e ->
"r("^(string_of_expr e)^")"
let rec string_of_hlam = function
HFun ((s, t), e) ->
let s_ty = string_of_ty t in
let s_e = string_of_hlam e in
"fun (" ^ s ^ " : " ^ s_ty ^ ") => (" ^ s_e ^ ")"
| HApp (e1, e2) ->
"("^(string_of_hlam e1)^" "^(string_of_hlam e2)^")"
| HVar (s) -> s
| HExf (e, t) ->
let s_e = string_of_hlam e in
let s_ty = string_of_ty t in
"exf (" ^ s_e ^ " : " ^ s_ty ^ ")"
| HPair (e1, e2) ->
"("^(string_of_hlam e1)^", "^(string_of_hlam e2)^")"
| HLeft e ->
"l("^(string_of_hlam e)^")"
| HRight e ->
"r("^(string_of_hlam e)^")"
| Ref e ->
"{"^(string_of_hlam !e)^"}"
| Hole -> "?"
let print_ty t = let print_ty t =
print_string (string_of_ty t) print_string (string_of_ty t)
@ -45,6 +67,9 @@ let print_ty t =
let print_expr e = let print_expr e =
print_string (string_of_expr e) print_string (string_of_expr e)
let print_hlam e =
print_string (string_of_hlam e)
let print_goal ((_, ty, c) : goal) : unit = let print_goal ((_, ty, c) : goal) : unit =
let rec print_hyps (c : context) : unit = match c with let rec print_hyps (c : context) : unit = match c with
[] -> () [] -> ()

View File

@ -14,6 +14,7 @@ let ty_id = uppercase uppercase* digit*
rule token = parse rule token = parse
| [' ' '\t' '\n'] { token lexbuf } | [' ' '\t' '\n'] { token lexbuf }
| '.' { DOT } | '.' { DOT }
| ',' { COMMA }
| '+' { PLUS } | '+' { PLUS }
| '*' { TIMES } | '*' { TIMES }
| "True" { TOP } | "True" { TOP }
@ -28,12 +29,15 @@ rule token = parse
| "exf" { EXFALSO } | "exf" { EXFALSO }
| "/\\" { AND } | "/\\" { AND }
| "\\/" { OR } | "\\/" { OR }
| "l" { L }
| "r" { R }
| "Goal" { GOAL } | "Goal" { GOAL }
| "Undo" { UNDO } | "Undo" { UNDO }
| "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 }

View File

@ -88,9 +88,9 @@ let rec interactive (get_cmd : unit -> cmd) (sl : (interactive_state) list) : pr
[None, (None, [])] |> interactive get_cmd [None, (None, [])] |> interactive get_cmd
end else begin end else begin
print_error "Typing failed" ""; print_error "Typing failed" "";
(* print_expr l; print_expr l;
print_newline (); print_newline ();
print_ty t; *) print_ty t;
(cg, (g, gs))::sq |> interactive get_cmd (cg, (g, gs))::sq |> interactive get_cmd
end end
end end

View File

@ -7,7 +7,7 @@ open Parser_entry
%token EOF %token EOF
%token DOT %token DOT COMMA
%token PLUS TIMES %token PLUS TIMES
%token TOP BOT EXFALSO TILDE %token TOP BOT EXFALSO TILDE
%token LPAREN RPAREN %token LPAREN RPAREN
@ -18,13 +18,15 @@ 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 %token LEFT RIGHT SPLIT DESTRUCT
%token L R
%right TARR %right TARR
%right OR %right OR
%right AND %right AND
%right TILDE %right TILDE
%start main %start main
%type <parser_entry> main %type <parser_entry> main
@ -69,6 +71,12 @@ expression:
{ Fun (annot, e) } { Fun (annot, e) }
| EXFALSO LPAREN e=expression COLON t=ty RPAREN | EXFALSO LPAREN e=expression COLON t=ty RPAREN
{ Exf (e, t) } { Exf (e, t) }
| LPAREN e1=expression COMMA e2=expression RPAREN
{ Pair(e1, e2) }
| L LPAREN e=expression RPAREN
{ Left(e) }
| R LPAREN e=expression RPAREN
{ Right(e) }
| e=app_expr { e } | e=app_expr { e }
app_expr: app_expr: