From 0a9e4230eeecf7672044bd56aac9a128179fd2fc Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Fri, 10 Nov 2023 14:34:28 -0700
Subject: [PATCH] letrec

---
 src/Core.hs |  4 ++++
 src/TI.hs   | 25 ++++++++++++++++++++-----
 2 files changed, 24 insertions(+), 5 deletions(-)

diff --git a/src/Core.hs b/src/Core.hs
index 6c5b05a..d78f941 100644
--- a/src/Core.hs
+++ b/src/Core.hs
@@ -5,6 +5,7 @@ import Data.Coerce
 import Data.Pretty
 import Data.List            (intersperse)
 import Data.Function        ((&))
+import Data.String
 ----------------------------------------------------------------------------------
 
 data Expr = Var Name
@@ -44,6 +45,9 @@ data ScDef = ScDef Name [Name] Expr
 
 newtype Program = Program [ScDef]
 
+instance IsString Expr where
+    fromString = Var
+
 ----------------------------------------------------------------------------------
 
 instance Pretty Expr where
diff --git a/src/TI.hs b/src/TI.hs
index 4bca9e0..319a301 100644
--- a/src/TI.hs
+++ b/src/TI.hs
@@ -90,8 +90,14 @@ instantiate (Let NonRec bs e) h g = instantiate e h' (g' ++ g)
             let (h',a) = instantiate v h g
             in (h',(k,a))
 
--- instantiate (Let Rec ((k:=v):bs) e) h g = instantiate e h' ((k,a):g)
---     where (h',a) = instantiate v h g
+instantiate (Let Rec bs e) h g = instantiate e h' env
+    where
+        env = g' ++ g
+        (h', g') = mapAccumL instBinder h bs
+        instBinder :: TiHeap -> Binding -> (TiHeap, (Name, Addr))
+        instBinder h (k := v) =
+            let (h',a) = instantiate v h env
+            in (h',(k,a))
 
 instantiate (Prim (IntP n)) h _ = alloc h (NNum n)
 
@@ -149,10 +155,19 @@ doAdmin (TiState s d h g sts) = TiState s d h g (sts+1)
 dbgProg :: Program -> IO ()
 dbgProg p = prettyPrint `traverse_` eval (fromJust $ compile p)
 
-testProg :: Program
-testProg = Program
+letrecExample :: Program
+letrecExample = Program
     -- [ ScDef "main" [] $ Prim IntAddP :$ Prim (IntP 2) :$ Prim (IntP 3)
-    [ ScDef "main" [] $ Let NonRec ["x" := Prim (IntP 2)] (Var "x")
+    [ ScDef "pair" ["x","y","f"] $ "f" :$ "x" :$ "y"
+    , ScDef "fst" ["p"] $ "p" :$ "K"
+    , ScDef "snd" ["p"] $ "p" :$ "K1"
+    , ScDef "f" ["x","y"] $
+        Let Rec
+            [ "a" := "pair" :$ "x" :$ "b"
+            , "b" := "pair" :$ "y" :$ "a"
+            ]
+            ("fst" :$ ("snd" :$ ("snd" :$ ("snd" :$ "a"))))
+    , ScDef "main" [] $ "f" :$ Prim (IntP 3) :$ Prim (IntP 4)
     ]
 
 instance Pretty TiState where