app/Gyehoek/ANF/Syntax.hs

@@ -7,7 +7,7 @@
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# OPTIONS_GHC -Wno-orphans -Wno-unused-matches -Wno-missing-signatures #-}
 {- HLINT ignore "Avoid lambda using `infix`" -}
-module Gyehoek.ANF
+module Gyehoek.ANF.Syntax
   (toANF, lower)
   where
 
@@ -21,8 +21,8 @@ import Data.Generics.Labels
 import Data.Vector.Strict (Vector)
 import Data.Function (fix)
 import Effectful.Writer.Static.Local
-import Gyehoek.Syntax qualified as Lam
-import Gyehoek.Syntax (Name, Prim(..), Lit(..))
+import Gyehoek.Scheme.Syntax qualified as Lam
+import Gyehoek.Scheme.Syntax (Name, Prim(..), Lit(..))
 import Gyehoek.GenSym
 import Control.Monad.Cont
 import Data.Foldable
@@ -185,7 +185,12 @@ expr2 =
          (PrimCons
           (Lam.ExpLit (LitInt 2))
           (Lam.ExpLit (LitInt 3)))))
-    , Lam.ExpPrim (PrimWrite (Lam.ExpLit (LitInt 4)))
+    , Lam.ExpPrim
+      (PrimWrite
+       (Lam.ExpPrim
+        (PrimMul
+         (Lam.ExpLit (LitInt 5))
+         (Lam.ExpLit (LitInt 4)))))
     ]
 
 
@@ -364,9 +369,14 @@ lowerPrim r p e k =
   telescope (lowerVal <$> p) \case
     (preview binaryPrim -> Just (bop,a,b)) -> do
       r1 <- gensym
+      r2 <- gensym
       Emit [ QBE.BinaryOp (r1 QBE.:= QBE.Long) bop a b
-           , QBE.BinaryOp (lowerName r QBE.:= QBE.Long) QBE.And
-             (QBE.ValTemporary r1) (QBE.ValConst (QBE.CInt 0b10))
+           , QBE.BinaryOp (r2 QBE.:= QBE.Long) QBE.And
+             (QBE.ValTemporary r1)
+             (QBE.ValConst (QBE.CInt 0xffff_ffff_ffff_fffd))
+           , QBE.BinaryOp (lowerName r QBE.:= QBE.Long) QBE.Or
+             (QBE.ValTemporary r2)
+             (QBE.ValConst (QBE.CInt 0b10))
            ]
         <$> lower' e k
     PrimCons x y -> lowerCons r x y e k

app/Gyehoek/Scheme/Syntax.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE PartialTypeSignatures #-}
-module Gyehoek.Syntax where
+module Gyehoek.Scheme.Syntax where
 
 import Data.Text (Text)
 import Data.List (List)

app/Gyehoek/Scratch.hs

@@ -1 +0,0 @@
-module Gyehoek.Scratch where

app/Main.hs

@@ -6,7 +6,7 @@ module Main
   (main)
   where
 
-import qualified Gyehoek.ANF as ANF
+import qualified Gyehoek.ANF.Syntax as ANF
 import Gyehoek.QBE (render)
 import qualified Data.Text.IO as TIO
 import Prelude hiding ((.),id)