Support struct expressions

1 files changed, 16 insertions, 11 deletions

diff --git a/Parser.sml b/Parser.sml
index 50d302d..4e20c13 100644
--- a/Parser.sml
+++ b/Parser.sml
@@ -606,11 +606,15 @@ struct
       ((reserved "structure" >>
       bind identifier (fn strID =>
       reserved "=" >>
-      reserved "struct" >>
-      bind (many strdec) (fn bindings =>
-      reserved "end" >>
-      const (SOME (Syntax.DStruct (strID, List.mapPartial (fn x => x) bindings))))))
+      bind structExpr (fn str =>
+      const (SOME (Syntax.DStruct (strID, str))))))
   <|> dec) st
+  and structExpr : Syntax.structExpr parser = fn st =>
+        ((reserved "struct" >>
+        bind (many strdec) (fn bindings =>
+        reserved "end" >>
+        const (Syntax.SStruct (List.mapPartial (fn x => x) bindings))))
+    <|> Syntax.SIdent <$> longIdentifier) st
 
   (* There's ambiguity between pattern variables and constructors that can only
    * be resolved by checking for constructors in scope *)
@@ -637,17 +641,18 @@ struct
         Syntax.DFun (f, map (fn (args, body) => (map (fixPatConstructors constructors) args, fixConstructors constructors body)) arms)
     | fixDecConstructors _ (decl as Syntax.DDatatype _) = decl
     | fixDecConstructors _ (decl as Syntax.DType _) = decl
-    | fixDecConstructors constructors (Syntax.DStruct (name, decs)) =
-        let
-          val constructors = ref constructors
-          val decs : Syntax.dec list =
-            map
+    | fixDecConstructors constructors (Syntax.DStruct (name, str)) = Syntax.DStruct (name, fixStructExprConstructors constructors str)
+
+  and fixStructExprConstructors (constructors : unit StringMap.map) (Syntax.SStruct decls) : Syntax.structExpr =
+        let val constructors = ref constructors in
+          Syntax.SStruct
+            (map
               (fn dec =>
                 (constructors := foldl (fn (x, acc) => StringMap.insert x () acc) (!constructors) (findConstructors dec) ;
                 fixDecConstructors (!constructors) dec))
-              decs
-        in Syntax.DStruct (name, decs)
+              decls)
         end
+    | fixStructExprConstructors _ expr = expr
 
   and fixConstructors (constructors : unit StringMap.map) (Syntax.ETuple exprs) : Syntax.expr =
         Syntax.ETuple (map (fixConstructors constructors) exprs)