From 543da0b297ea344cf04df3624c150f2576d165e1 Mon Sep 17 00:00:00 2001
From: augustin64 <me.git@augustin64.fr>
Date: Thu, 16 May 2024 12:31:06 +0200
Subject: [PATCH] Add l, r

---
 affichage.ml | 33 +++++++++++++++++++++++++++++----
 lexer.mll    |  4 ++++
 main.ml      |  4 ++--
 parser.mly   | 12 ++++++++++--
 4 files changed, 45 insertions(+), 8 deletions(-)

diff --git a/affichage.ml b/affichage.ml
index b570c00..24f9c3d 100644
--- a/affichage.ml
+++ b/affichage.ml
@@ -33,11 +33,33 @@ let rec string_of_expr = function
     let s_ty = string_of_ty t in
     "exf (" ^ s_e ^ " : " ^ s_ty ^ ")"
   | Pair (e1, e2) ->
-    "Pair("^(string_of_expr e1)^", "^(string_of_expr e2)^")"
-  | Left e | Right e ->
-    "["^(string_of_expr e)^"]"
-
+    "("^(string_of_expr e1)^", "^(string_of_expr e2)^")"
+  | Left 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 =
   print_string (string_of_ty t)
@@ -45,6 +67,9 @@ let print_ty t =
 let print_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 rec print_hyps (c : context) : unit = match c with
     [] -> ()
diff --git a/lexer.mll b/lexer.mll
index af507a8..5339075 100644
--- a/lexer.mll
+++ b/lexer.mll
@@ -14,6 +14,7 @@ let ty_id = uppercase uppercase* digit*
 rule token = parse
   | [' ' '\t' '\n']      { token lexbuf }
   | '.'             { DOT }
+  | ','             { COMMA }
   | '+'             { PLUS }
   | '*'             { TIMES }
   | "True"          { TOP }
@@ -28,12 +29,15 @@ rule token = parse
   | "exf"           { EXFALSO }
   | "/\\"           { AND }
   | "\\/"           { OR }
+  | "l"             { L }
+  | "r"             { R }
 
   | "Goal"          { GOAL }
   | "Undo"          { UNDO }
   | "Qed"           { QED }
   | "exact"         { EXACT }
   | "assumption"    { ASSUMPTION }
+  | "destruct"      { DESTRUCT }
   | "intros"        { INTROS }
   | "intro"         { INTRO }
   | "cut"           { CUT }
diff --git a/main.ml b/main.ml
index 3a00e01..4e6d6d5 100644
--- a/main.ml
+++ b/main.ml
@@ -88,9 +88,9 @@ let rec interactive (get_cmd : unit -> cmd) (sl : (interactive_state) list) : pr
             [None, (None, [])] |> interactive get_cmd
           end else begin
             print_error "Typing failed" "";
-            (* print_expr l;
+            print_expr l;
             print_newline ();
-            print_ty t; *)
+            print_ty t;
             (cg, (g, gs))::sq |> interactive get_cmd
           end
         end
diff --git a/parser.mly b/parser.mly
index 0d802ae..a30d5ed 100644
--- a/parser.mly
+++ b/parser.mly
@@ -7,7 +7,7 @@ open Parser_entry
 
 %token EOF
 
-%token DOT
+%token DOT COMMA
 %token PLUS TIMES
 %token TOP BOT EXFALSO TILDE
 %token LPAREN RPAREN
@@ -18,13 +18,15 @@ open Parser_entry
 
 %token GOAL UNDO QED
 %token EXACT ASSUMPTION INTRO INTROS CUT APPLY
-%token LEFT RIGHT SPLIT
+%token LEFT RIGHT SPLIT DESTRUCT
+%token L R
 
 %right TARR
 %right OR
 %right AND
 %right TILDE
 
+
 %start main
 %type <parser_entry> main
                                                          
@@ -69,6 +71,12 @@ expression:
                             { Fun (annot, e) }
   | EXFALSO LPAREN e=expression COLON t=ty RPAREN
                             { 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 }
 
 app_expr: