Add l, r
This commit is contained in:
parent
fcfdbdc068
commit
543da0b297
33
affichage.ml
33
affichage.ml
@ -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
|
||||||
[] -> ()
|
[] -> ()
|
||||||
|
@ -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 }
|
||||||
|
4
main.ml
4
main.ml
@ -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
|
||||||
|
12
parser.mly
12
parser.mly
@ -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:
|
||||||
|
Loading…
Reference in New Issue
Block a user