From 4fe42be07b7b57147f9cac0d17c2611f71f0758a Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rosehogenson@posteo.net>
Date: Sat, 18 May 2024 07:23:11 -0700
Subject: Add structures.

---
 parser.sml | 24 ++++++++++++++++++------
 1 file changed, 18 insertions(+), 6 deletions(-)

(limited to 'parser.sml')

diff --git a/parser.sml b/parser.sml
index 6e82e19..ea68412 100644
--- a/parser.sml
+++ b/parser.sml
@@ -390,12 +390,14 @@ struct
         (case pats of
           [p] => p
         | _ => Syntax.PTuple pats))
-  <|> Syntax.PVar <$> identifier) st
+  <|> bind longIdentifier (fn [i] => const (Syntax.PVar i) | is => const (Syntax.PCon (is, Syntax.PTuple [])))) st
   and appPat : Syntax.pat parser = fn st =>
-      (bind identifier (fn ident =>
+      (bind longIdentifier (fn ident =>
           bind atpat (fn arg =>
           const (Syntax.PCon (ident, arg)))
-      <|> const (Syntax.PVar ident))
+      <|> const (case ident of
+                  [i] => Syntax.PVar i
+                | _ => Syntax.PCon (ident, Syntax.PTuple [])))
   <|> atpat) st
   and pat : Syntax.pat parser = fn st =>
     foldl
@@ -404,14 +406,14 @@ struct
           fun patLeft pat1 =
             bind (leftOp i) (fn opEx =>
             bind patLower (fn pat2 =>
-            let val app = Syntax.PCon (opEx, Syntax.PTuple [pat1, pat2])
+            let val app = Syntax.PCon ([opEx], Syntax.PTuple [pat1, pat2])
             in patLeft app <|> const app
             end))
           fun patRight pat1 =
             bind (rightOp i) (fn opEx =>
             bind patLower (fn pat2 =>
             bind (patRight pat2 <|> const pat2) (fn rest =>
-            const (Syntax.PCon (opEx, Syntax.PTuple [pat1, rest])))))
+            const (Syntax.PCon ([opEx], Syntax.PTuple [pat1, rest])))))
         in
           bind patLower (fn pat1 =>
           patLeft pat1 <|> patRight pat1 <|> const pat1)
@@ -565,8 +567,18 @@ struct
         else const (SOME (Syntax.DFun (name, map (fn (_, x, y) => (x, y)) cases)))
       end))) st
 
+  val rec strdec : Syntax.dec option parser = fn st =>
+      ((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))))))
+  <|> dec) st
+
   val program : Syntax.expr parser =
-    bind (many dec) (fn decs =>
+    bind (many strdec) (fn decs =>
     const (Syntax.ELet (List.mapPartial (fn x => x) decs, Syntax.EInt 0)))
   fun parse (f : string) : (string, Syntax.expr) Result.either = runParser program f
 end
-- 
cgit v1.3.1