From 9c7c9c47308372783e288e779221ef107c8f94be Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Wed, 13 Dec 2023 11:35:09 -0700
Subject: [PATCH 1/2] arith fixes

---
 src/GM.hs    | 12 ++++++------
 tst/Arith.hs | 19 ++++++++++---------
 2 files changed, 16 insertions(+), 15 deletions(-)

diff --git a/src/GM.hs b/src/GM.hs
index 9f3a27b..dbf4718 100644
--- a/src/GM.hs
+++ b/src/GM.hs
@@ -701,12 +701,12 @@ buildInitialHeap (Program ss) = mapAccumL allocateSc mempty compiledScs
                 compileBinder (_ := v, a) = compileC g' v <> [Update a]
 
         -- special cases for prim functions; essentially inlining
-        compileE g ("negate#" :$ a) = compileE g a <>                 [Neg]
-        compileE g ("+#" :$ a :$ b) = compileE g a <> compileE g b <> [Add]
-        compileE g ("-#" :$ a :$ b) = compileE g a <> compileE g b <> [Sub]
-        compileE g ("*#" :$ a :$ b) = compileE g a <> compileE g b <> [Mul]
-        compileE g ("/#" :$ a :$ b) = compileE g a <> compileE g b <> [Div]
-        compileE g ("==#" :$ a :$ b) = compileE g a <> compileE g b <> [Equals]
+        compileE g ("negate#" :$ a)  = compileE g a <>                 [Neg]
+        compileE g ("+#" :$ a :$ b)  = compileE g b <> compileE g a <> [Add]
+        compileE g ("-#" :$ a :$ b)  = compileE g b <> compileE g a <> [Sub]
+        compileE g ("*#" :$ a :$ b)  = compileE g b <> compileE g a <> [Mul]
+        compileE g ("/#" :$ a :$ b)  = compileE g b <> compileE g a <> [Div]
+        compileE g ("==#" :$ a :$ b) = compileE g b <> compileE g a <> [Equals]
 
         compileE g (Case e as) = compileE g e <> [CaseJump (compileD g as)]
 
diff --git a/tst/Arith.hs b/tst/Arith.hs
index da55be1..b6c3a2f 100644
--- a/tst/Arith.hs
+++ b/tst/Arith.hs
@@ -35,7 +35,7 @@ instance Arbitrary ArithExpr where
             gen :: Int -> Gen ArithExpr
             gen n
                 | n > 0 = oneof
-                    -- i don't feel like dealing with zero at the moment
+                    -- i don't feel like dealing with division at the moment
                     [ IntA <$> int
                     , NegateA <$> arbitrary
                     -- , IdA <$> arbitrary
@@ -47,7 +47,8 @@ instance Arbitrary ArithExpr where
                 where
                     b f = liftA2 f s s
                     s = gen (n `div` 2)
-                    int = chooseInt (minBound,maxBound)
+                    -- int = chooseInt (minBound,maxBound)
+                    int = chooseInt (-500,500)
 
 prop_ArithExprEqCoreExpr :: ArithExpr -> Bool
 prop_ArithExprEqCoreExpr e = arithResult `eq1` coreResult
@@ -55,23 +56,23 @@ prop_ArithExprEqCoreExpr e = arithResult `eq1` coreResult
         arithResult = Just (evalA e)
         coreResult  = evalCore (toCore e)
 
-toCore :: ArithExpr -> Program
+toCore :: ArithExpr -> Program'
 toCore expr = Program
         [ ScDef "id" ["x"] $ Var "x"
         , ScDef "main" [] $ go expr
         ]
     where
-        go :: ArithExpr -> Expr
-        go (IntA n)    = IntE n
+        go :: ArithExpr -> Expr'
+        go (IntA n)    = LitE (IntL n)
         go (NegateA e) = "negate#" :$ go e
         go (IdA e)     = "id" :$ go e
-        go (a :+ b)  = f "+#" a b
-        go (a :- b)  = f "-#" a b
-        go (a :* b)  = f "*#" a b
+        go (a :+ b)    = f "+#" a b
+        go (a :- b)    = f "-#" a b
+        go (a :* b)    = f "*#" a b
 
         f n a b = n :$ go a :$ go b
 
-evalCore :: Program -> Maybe Int
+evalCore :: Program' -> Maybe Int
 evalCore p = do
     a <- fst <$> evalProg p
     case a of

From 1f2d540c729e128d3d40a573a04e367ce1d52085 Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Wed, 13 Dec 2023 11:45:03 -0700
Subject: [PATCH 2/2] test lazy arith

---
 tst/Arith.hs | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/tst/Arith.hs b/tst/Arith.hs
index b6c3a2f..d1a648e 100644
--- a/tst/Arith.hs
+++ b/tst/Arith.hs
@@ -16,9 +16,15 @@ data ArithExpr = IntA Int
                | NegateA ArithExpr
                -- to test Evals
                | IdA ArithExpr
+               -- strict arith; these get inlined
                | ArithExpr :+ ArithExpr
                | ArithExpr :* ArithExpr
                | ArithExpr :- ArithExpr
+               -- non-strict ops; these get wrapped in an `id` call to test
+               -- non-inlined arith
+               | ArithExpr ::+ ArithExpr
+               | ArithExpr ::* ArithExpr
+               | ArithExpr ::- ArithExpr
                deriving Show
 
 evalA :: ArithExpr -> Int
@@ -28,6 +34,9 @@ evalA (NegateA a) = negate (evalA a)
 evalA (a :+ b)    = evalA a + evalA b
 evalA (a :* b)    = evalA a * evalA b
 evalA (a :- b)    = evalA a - evalA b
+evalA (a ::+ b)   = evalA a + evalA b
+evalA (a ::* b)   = evalA a * evalA b
+evalA (a ::- b)   = evalA a - evalA b
 
 instance Arbitrary ArithExpr where
     arbitrary = gen 4
@@ -38,10 +47,13 @@ instance Arbitrary ArithExpr where
                     -- i don't feel like dealing with division at the moment
                     [ IntA <$> int
                     , NegateA <$> arbitrary
-                    -- , IdA <$> arbitrary
+                    , IdA <$> arbitrary
                     , b (:+)
                     , b (:-)
                     , b (:*)
+                    , b (::+)
+                    , b (::-)
+                    , b (::*)
                     ]
                 | otherwise = IntA <$> int
                 where
@@ -69,6 +81,9 @@ toCore expr = Program
         go (a :+ b)    = f "+#" a b
         go (a :- b)    = f "-#" a b
         go (a :* b)    = f "*#" a b
+        go (a ::+ b)   = f ("id" :$ "+#") a b
+        go (a ::- b)   = f ("id" :$ "-#") a b
+        go (a ::* b)   = f ("id" :$ "*#") a b
 
         f n a b = n :$ go a :$ go b