From 06624f3183f4d773cf1023cabe2e370ebba5dee1 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rosehogenson@posteo.net>
Date: Fri, 16 May 2025 08:24:59 -0700
Subject: Use code generation for printing the AST

---
 Parser.sml | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

(limited to 'Parser.sml')

diff --git a/Parser.sml b/Parser.sml
index f632380..50d302d 100644
--- a/Parser.sml
+++ b/Parser.sml
@@ -426,6 +426,9 @@ struct
                   [i] => Syntax.PVar i
                 | _ => Syntax.PCon (ident, Syntax.PTuple [])))
   <|> atpat) st
+  and typedPat : Syntax.pat parser = fn st =>
+      (bind appPat (fn pat =>
+      pat <$ (reserved ":" >> parseType) <|> const pat)) st
   and pat : Syntax.pat parser = fn st =>
     foldl
       (fn (i, patLower) =>
@@ -445,7 +448,7 @@ struct
           bind patLower (fn pat1 =>
           patLeft pat1 <|> patRight pat1 <|> const pat1)
         end)
-      appPat
+      typedPat
       (List.tabulate (10, fn i => 9 - i)) st
 
   val rec atom : Syntax.expr parser =
@@ -546,7 +549,7 @@ struct
             else {infixTable = Vector.update (infixTable, level, (ops @ leftOps, rightOps))}
           end) >>
       const NONE)))
-  <|> (reserved "datatype" >>
+  <|> ((reserved "datatype" <|> reserved "and") >>
           (between (symbol "(") (symbol ")") (sepBy1 tyvar (symbol ","))
       <|> (fn x => [x]) <$> tyvar
       <|> const []) >>
@@ -561,6 +564,11 @@ struct
           <|> const (con, NONE)))
           (reserved "|")) (fn cons =>
       const (SOME (Syntax.DDatatype (name, cons))))))
+  <|> (reserved "type" >>
+      bind identifier (fn name =>
+      reserved "=" >>
+      bind parseType (fn ty =>
+      const (SOME (Syntax.DType (name, ty))))))
   <|> (reserved "val" >>
       bind (true <$ reserved "rec" <|> const false) (fn isRec =>
       bind pat (fn p =>
@@ -628,6 +636,7 @@ struct
     | fixDecConstructors constructors (Syntax.DFun (f, arms)) =
         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
-- 
cgit v1.3.1