record type expression

butterunderflow · Feb 8, 2024 · 490d585 · 490d585
1 parent 5e039d0
commit 490d585
Show file tree

Hide file tree

Showing 4 changed files with 18 additions and 2 deletions.
diff --git a/lib/syntax/lexer.mll b/lib/syntax/lexer.mll
@@ -60,8 +60,11 @@ rule token = parse
     | ')'               { RPAREN }
     | '['               { LBRACKET }
     | ']'               { RBRACKET }
+    | '{'               { LBRACE }
+    | '}'               { RBRACE }
     | ','               { COMMA }
     | ':'               { COLON }
+    | ';'               { SEMI }
     | mod_ident as m    { MIDENT m}
     | ident as i        { IDENT i }
     | type_var as t     { TYPEVAR t } 

diff --git a/lib/syntax/parser.mly b/lib/syntax/parser.mly
@@ -35,6 +35,9 @@
 %token COLON
 %token LPAREN
 %token RPAREN
+%token LBRACE
+%token RBRACE
+%token SEMI
 
 %nonassoc below_COMMA
 %left     COMMA                        /* (e , e , e) */
@@ -106,6 +109,9 @@ variant:
     | c=MIDENT OF payload=type_expr  { (c, Some payload) } 
     | c=MIDENT                       { (c, None) };
 
+field_def: 
+    | n=IDENT COLON t=type_expr  { (n, t) }
+
 type_expr: 
     | LPAREN t_args = separated_list(COMMA, type_expr) RPAREN n=IDENT 
         { TCons(n, t_args) }
@@ -114,7 +120,8 @@ type_expr:
     | t_arg = type_expr n=IDENT { TCons(n, [t_arg]) }
     | n=IDENT { TCons (n, []) }
     | tv=TYPEVAR { TVar tv }
-    | arg=type_expr ARROW ret=type_expr { TArrow (arg, ret) };
+    | arg=type_expr ARROW ret=type_expr { TArrow (arg, ret) }
+    | LBRACE fields=separated_nontrivial_llist(SEMI, field_def) RBRACE { TRecord fields }
 
 expr:
     | c=constant { EConst c }

diff --git a/lib/syntax/parsetree.ml b/lib/syntax/parsetree.ml
@@ -22,6 +22,7 @@ and type_expr =
   | TField of path * string
   | TArrow of type_expr * type_expr
   | TTuple of type_expr list
+  | TRecord of (string * type_expr) list
 [@@deriving sexp]
 
 and para = PAnn of string * type_expr | PBare of string [@@deriving sexp]

diff --git a/lib/test/parse_test.ml b/lib/test/parse_test.ml
@@ -102,7 +102,12 @@ let%expect_test "Test: type expression parsing" =
     (TTuple
       ((TCons int ()) (TCons list ((TCons i ())))
         (TCons list ((TTuple ((TCons x ()) (TCons y ())))))
-        (TTuple ((TCons t1 ()) (TCons t2 ()))))) |}]
+        (TTuple ((TCons t1 ()) (TCons t2 ()))))) |}];
+  print_parsed_type_expr "{x: int; y: float; z: int -> float }";
+  [%expect {|
+    (TRecord
+      ((x (TCons int ())) (y (TCons float ()))
+        (z (TArrow (TCons int ()) (TCons float ()))))) |}]
 
 let%expect_test "Test: top level module" =
   print_parsed_program {|