diff --git a/app/Gyehoek/ANF.hs b/app/Gyehoek/ANF/Syntax.hs similarity index 94% rename from app/Gyehoek/ANF.hs rename to app/Gyehoek/ANF/Syntax.hs index 747d3cf..d0254d7 100644 --- a/app/Gyehoek/ANF.hs +++ b/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 diff --git a/app/Gyehoek/Syntax.hs b/app/Gyehoek/Scheme/Syntax.hs similarity index 98% rename from app/Gyehoek/Syntax.hs rename to app/Gyehoek/Scheme/Syntax.hs index bb1b358..1358a67 100644 --- a/app/Gyehoek/Syntax.hs +++ b/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) diff --git a/app/Gyehoek/Scratch.hs b/app/Gyehoek/Scratch.hs deleted file mode 100644 index 661f691..0000000 --- a/app/Gyehoek/Scratch.hs +++ /dev/null @@ -1 +0,0 @@ -module Gyehoek.Scratch where diff --git a/app/Main.hs b/app/Main.hs index 1cbce18..590b6c1 100644 --- a/app/Main.hs +++ b/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) diff --git a/gyehoek.cabal b/gyehoek.cabal index 934e457..0393842 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -13,48 +13,54 @@ 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: - , base ^>=4.21.2.0 + , base ^>=4.21.2.0 , 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 diff --git a/play/a.out b/play/a.out index 5c33913..e0e7218 100755 Binary files a/play/a.out and b/play/a.out differ diff --git a/play/t.ssa b/play/t.ssa index 5c0952c..cd2e7f5 100644 --- a/play/t.ssa +++ b/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 } \ No newline at end of file diff --git a/runtime/gyehoek.c b/runtime/gyehoek.c index 8ba51fd..3c3e48c 100644 --- a/runtime/gyehoek.c +++ b/runtime/gyehoek.c @@ -3,7 +3,7 @@ SCM scm_write (SCM x) { if (SCM_IMP (x)) { - printf ("#\n", SCM_UNPACK (x)); + printf ("#\n", SCM_UNPACK (x) >> 2); } else { printf ("#\n", SCM_UNPACK(x)); }