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)

gyehoek.cabal

@@ -13,29 +13,34 @@ build-type:    Simple
 -- extra-doc-files:    CHANGELOG.md
 -- extra-source-files:
 
+common ghcstuffs-dev
+  ghc-options:
+    -Wno-unused-matches -Wno-missing-signatures -Wno-typed-holes
+
 common ghcstuffs
   ghc-options:
     -Wall -fdefer-type-errors -fno-show-valid-hole-fits
-    -fdefer-out-of-scope-variables -Wno-typed-holes
-    -fplugin=Effectful.Plugin
+    -fdefer-out-of-scope-variables -fplugin=Effectful.Plugin
 
   other-extensions:
     BlockArguments
+    DeriveGeneric
+    OverloadedStrings
     PartialTypeSignatures
+    PatternSynonyms
 
 executable gyehoek
-  import:           ghcstuffs
+  import:           ghcstuffs, ghcstuffs-dev
   main-is:          Main.hs
 
   -- cabal-fmt: expand app -Main
   other-modules:
-    Gyehoek.ANF
-    Gyehoek.Sexp
+    Gyehoek.ANF.Syntax
     Gyehoek.GenSym
     Gyehoek.QBE
     Gyehoek.QBE.Parse
-    Gyehoek.Scratch
-    Gyehoek.Syntax
+    Gyehoek.Scheme.Syntax
+    Gyehoek.Sexp
 
   -- other-extensions:
   build-depends:
@@ -43,18 +48,19 @@ executable gyehoek
     , effectful
     , effectful-core
     , effectful-plugin
+    , generic-lens
+    , invertible-grammar
     , lens
     , megaparsec
     , mtl
+    , optparse-applicative
     , prettyprinter
     , qbe
     , recursion-schemes
+    , sexp-grammar
     , template-haskell
     , text
     , vector
-    , generic-lens
-    , sexp-grammar
-    , invertible-grammar
 
   hs-source-dirs:   app
   default-language: GHC2024

play/t.ssa

@@ -3,10 +3,13 @@ export
 function w $main () {
 @start
     %x0 =l call $GC_malloc (l 16)
-    %.3 =l add %x0, 8
+    %.4 =l add %x0, 8
     storel 10, %x0
-    storel 14, %.3
+    storel 14, %.4
     %x1 =l call $scm_write (l %x0)
-    %x2 =l call $scm_write (l 18)
-    ret %x2
+    %.5 =l mul 22, 18
+    %.6 =l and %.5, 18446744073709551613
+    %x2 =l or %.6, 2
+    %x3 =l call $scm_write (l %x2)
+    ret %x3
 }

runtime/gyehoek.c

@@ -3,7 +3,7 @@
 
 SCM scm_write (SCM x) {
   if (SCM_IMP (x)) {
-    printf ("#<immediate %ld>\n", SCM_UNPACK (x));
+    printf ("#<immediate %ld>\n", SCM_UNPACK (x) >> 2);
   } else {
     printf ("#<heap object %ld>\n", SCM_UNPACK(x));
   }