From 4763deb1df6e409f79623f58d2ceb4e022585e6a Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 11 Sep 2022 23:11:30 -0700
Subject: Don't break the parser abstraction for recursion.

Parsers are values. Of course, one can always make recursion from
scratch even if the language doesn't allow recursive values.
---
 parser.sml | 81 ++++++++++++++++++++++++++++++++++----------------------------
 1 file changed, 44 insertions(+), 37 deletions(-)

(limited to 'parser.sml')

diff --git a/parser.sml b/parser.sml
index af7ec76..930431f 100644
--- a/parser.sml
+++ b/parser.sml
@@ -312,41 +312,48 @@ struct
       | op1 :: ops => Syntax.EIdent <$> foldl (op <|>) op1 ops
     end)
 
-  (* These need to be declared as functions so they can be mutually recursive.
-     Of course, functions are values. *)
-  fun atom (st : state) : Syntax.expr parserResponse =
-    (Syntax.EInt <$> integer
-    <|> Syntax.EStr <$> stringConstant
-    <|> Syntax.EIdent <$> identifier
-    <|> (symbol "(" >>
-         bind (sepBy1 expr (symbol ",")) (fn exprs =>
-         symbol ")" >>
-         const
-           (case exprs of
-             [x] => x
-           | _ => Syntax.ETuple exprs)))) st
-  and expr0 (st : state) : Syntax.expr parserResponse =
-    bind atom (fn e0 =>
-    foldl (fn (x, acc) => Syntax.EApp (acc, x)) e0 <$> many atom) st
-  and expr (st : state) : Syntax.expr parserResponse =
-    foldl
-      (fn (i, exprLower) =>
-        let
-          fun exprLeft expr1 =
-            bind (leftOp i) (fn opEx =>
-            bind exprLower (fn expr2 =>
-            let val app = Syntax.EApp (opEx, Syntax.ETuple [expr1, expr2])
-            in exprLeft app <|> const app
-            end))
-          fun exprRight expr1 =
-            bind (rightOp i) (fn opEx =>
-            bind exprLower (fn expr2 =>
-            bind (exprRight expr2 <|> const expr2) (fn rest =>
-            const (Syntax.EApp (opEx, Syntax.ETuple [expr1, rest])))))
-        in
-          bind exprLower (fn expr1 =>
-          exprLeft expr1 <|> exprRight expr1 <|> const expr1)
-        end)
-      expr0
-      (List.tabulate (10, fn i => 9 - i)) st
+  (* Values cannot be recursive. So we take the recursive call as a parameter,
+     and wire it together with the Y combinator. *)
+  fun expr' (expr : Syntax.expr parser) : Syntax.expr parser =
+    let
+      val atom =
+        Syntax.EInt <$> integer
+        <|> Syntax.EStr <$> stringConstant
+        <|> Syntax.EIdent <$> identifier
+        <|> (symbol "(" >>
+             bind (sepBy1 expr (symbol ",")) (fn exprs =>
+             symbol ")" >>
+             const
+               (case exprs of
+                 [x] => x
+               | _ => Syntax.ETuple exprs)))
+      val expr0 =
+        bind atom (fn e0 =>
+        foldl (fn (x, acc) => Syntax.EApp (acc, x)) e0 <$> many atom)
+    in
+      foldl
+        (fn (i, exprLower) =>
+          let
+            fun exprLeft expr1 =
+              bind (leftOp i) (fn opEx =>
+              bind exprLower (fn expr2 =>
+              let val app = Syntax.EApp (opEx, Syntax.ETuple [expr1, expr2])
+              in exprLeft app <|> const app
+              end))
+            fun exprRight expr1 =
+              bind (rightOp i) (fn opEx =>
+              bind exprLower (fn expr2 =>
+              bind (exprRight expr2 <|> const expr2) (fn rest =>
+              const (Syntax.EApp (opEx, Syntax.ETuple [expr1, rest])))))
+          in
+            bind exprLower (fn expr1 =>
+            exprLeft expr1 <|> exprRight expr1 <|> const expr1)
+          end)
+        expr0
+        (List.tabulate (10, fn i => 9 - i))
+    end
+
+    fun Y (f : ('a -> 'b) -> 'a -> 'b) : 'a -> 'b = f (fn x => Y f x)
+
+    val expr = Y expr'
 end
-- 
cgit v1.3.1