cleanup

README.md

@@ -1,3 +1,3 @@
-# gyehoek-hs (계획)
+# 계획
 
-a (wip) toy compiler for a Scheme-like language. currently targetting [QBE](https://c9x.me/compile/). nabbing from GHC and GNU Guile.
+a WIP compiler for R⁷RS Scheme targeting WebAssembly.

flake.nix

@@ -20,7 +20,6 @@
       overlays = [
         haskellNix.overlay
         (final: prev: {
-          shake-wrapper = final.callPackage ./shake-wrapper.nix {};
           gyehoek-runtime = final.callPackage ./runtime {
             crane-lib = inputs.crane.mkLib final;
           };
@@ -49,7 +48,6 @@
               };
               buildInputs = with final; [
                 haskellPackages.cabal-fmt
-                shake-wrapper
                 wabt
                 nodejs
                 wasm-tools
@@ -88,7 +86,7 @@
         hf.packages.${system} // lib.fix (packages: {
           gyehoek = hf.packages.${system}."gyehoek:exe:gyehoek";
           default = packages.gyehoek;
-          inherit (pkgs) gyehoek-runtime shake-wrapper;
+          inherit (pkgs) gyehoek-runtime;
         }));
 
       devShells = each-system

gyehoek.cabal

@@ -61,6 +61,7 @@ library
     Gyehoek.Driver
     Gyehoek.GenSym
     Gyehoek.Options
+    Gyehoek.Prelude
     Gyehoek.Scheme.Syntax
     Gyehoek.Sexp
     Gyehoek.Stack.Syntax

repl

@@ -1,2 +0,0 @@
-#!/usr/bin/env sh
-cabal repl --repl-options "-interactive-print=Text.Pretty.Simple.pPrint" --build-depends pretty-simple

shake-wrapper.nix

@@ -1,14 +0,0 @@
-{ runCommandLocal, makeWrapper, lib, haskellPackages }:
-
-let
-  our-ghc = haskellPackages.ghc.withPackages (ps: [
-    ps.shake
-  ]);
-in runCommandLocal
-  "shake-wrapper"
-  { nativeBuildInputs = [ makeWrapper ]; }
-  ''
-    mkdir -p $out/bin
-    makeWrapper ${lib.getExe haskellPackages.shake} $out/bin/shake \
-      --prefix PATH : ${lib.makeBinPath [our-ghc]}
-  ''

src/Gyehoek/CPS/Close.hs

@@ -4,29 +4,12 @@ module Gyehoek.CPS.Close
   ) where
 
 import Gyehoek.CPS.Syntax
-import Effectful
-import Data.Functor.Foldable
-import Control.Monad ((>=>))
-import Control.Lens
-import Data.List.NonEmpty (NonEmpty)
-import qualified Data.HashSet as HS
-import qualified Data.Set.Ordered as O
-import Data.Set.Ordered (OSet)
 import Gyehoek.GenSym
-import Data.String.Interpolate (i)
-import Debug.Pretty.Simple
-import Data.HashSet (HashSet)
+import Gyehoek.Prelude
 
 
-cataM
-  :: (Monad m, Traversable (Base t), Recursive t)
-  => (Base t a -> m a) -> t -> m a
-cataM f = cata (sequenceA >=> f)
-
 close :: GenSym :> es => Exp -> Eff es Exp
-
 close = transformM \case
-
   ExpLetRec [(f, AbsLambda lam@(MkLambda bs kb m))] e -> do
     f_code <- gensym' @Name $ f ^. _Wrapped'. to (<> "-code")
     -- it would probably be most sane to generate a symbol for `env`,
@@ -55,45 +38,5 @@ close = transformM \case
 
   e -> pure e
 
-  e -> error [i|unimplemented case: #{e}|]
-
-  -- lam@(ExpLambdaF bs m) -> do
-  --   env <- gensym' @Name "env"
-  --   let upvalBinds = free' (embed lam)
-  --         & itraversed %@~ \i x -> (x, [cps|(env-ref #{env} #{i})|])
-  --   let upvals = upvalBinds ^.. each . _1
-  --   pure [cps|
-  --     (make-closure (λ (#{env} ##{bs})
-  --                     (let #{upvalBinds}
-  --                       #{m}))
-  --                   ##{upvals})
-  --    |]
-  -- ExpApplyF f xs ->
-  --   pure [scm|
-  --     (apply-closure #{f} ##{xs})
-  --   |]
-
 closeProgram :: GenSym :> es => Program -> Eff es Program
 closeProgram = traverseOf #body close
-
-curriedadd :: Program
-curriedadd = [cps|
-  (letrec ((curried-add
-            (λ (n ktail1)
-              (letrec ((curried-add-in
-                        (λ (m ktail2)
-                          (prim (+ n m)
-                                (κ (x0) (continue ktail2 x0))))))
-                (continue ktail1 curried-add-in)))))
-    (letrec ((k0 (κ (adder) (adder 4 halt))))
-      (curried-add 5 k0)))
-|]
-
-square :: Program
-square = [cps|
-(letrec ((lambda-body0 (λ (x lambda-tail1)
-                (prim (* x x) (κ (r2) (continue lambda-tail1 r2))))))
-  (letrec
-    ((r3 (κ (x4) (continue halt x4))))
-    (lambda-body0 5 r3)))
-|]

src/Gyehoek/CPS/Convert.hs

@@ -9,16 +9,9 @@ import Gyehoek.CPS.Syntax
 import Gyehoek.Scheme.Syntax qualified as Scm
 import Gyehoek.GenSym
 import Data.List.NonEmpty (NonEmpty((:|)))
-import Effectful
 import Control.Monad.Cont qualified as Cont
-import Control.Lens
 import qualified Data.List.NonEmpty as NE
-import qualified Gyehoek.Sexp
-import Data.String.Interpolate (i)
-import Data.Functor (unzip)
-import Data.List (List)
-import Prelude hiding (unzip)
-import Debug.Pretty.Simple (pTraceShowMForceColor)
+import Gyehoek.Prelude
 
 
 -- 뻘짓이어라
@@ -109,8 +102,6 @@ convert (Scm.ExpLetRec bs m) k = do
     (letrec #{bs''} #{m'})
   |]
 
--- convert e k = error [i|unimplemented expr: #{e}|]
-
 convertLambda
   :: GenSym :> es
   => List Name -> Scm.Exp -> Eff es Lambda

src/Gyehoek/CPS/Eval.hs

@@ -5,24 +5,13 @@ module Gyehoek.CPS.Eval
   ) where
 
 import Gyehoek.CPS.Syntax
-import Data.String.Interpolate (i)
-import Data.HashMap.Strict (HashMap)
 import Control.Lens
 import Data.Maybe (fromMaybe)
-import Data.Generics.Labels ()
-import GHC.Generics (Generic)
-import Data.List (List)
 import Text.Show.Functions ()
 import qualified Data.HashMap.Strict as H
-import Debug.Pretty.Simple (pTraceShowId)
-import qualified Data.Text as T
+import Gyehoek.Prelude
 
 
-data Code
-  = CodeKap (List Obj -> List Obj)
-  | CodeLam (List Obj -> Name -> List Obj)
-  deriving (Show, Generic)
-
 data Env = MkEnv
   { vars :: HashMap Name Obj
   , labels :: HashMap Name (Env, Abs)
@@ -78,7 +67,7 @@ evalVal g = \case
 emptyEnv :: Env
 emptyEnv = MkEnv
   { vars = mempty
-  , labels = H.singleton "halt" $
+  , labels = H.singleton "halt"
     ( emptyEnv
     , AbsKappa' ["h0"] $ Halt [ValVar "h0"]
     )
@@ -86,22 +75,3 @@ emptyEnv = MkEnv
 
 evalProgram :: Program -> List Obj
 evalProgram (MkProgram e) = eval emptyEnv e
-
-curriedadd :: Program
-curriedadd = [cps|
-(letrec ((curried-add
-          (λ (n ktail1)
-            (letrec ((curried-add-in
-                      (λ (m ktail2)
-                        (prim (+ n m)
-                              (κ (x0) (continue ktail2 x0))))))
-              (continue ktail1 curried-add-in)))))
-  (letrec ((k0 (κ (adder) (adder 4 halt))))
-    (curried-add 5 k0)))
-|]
-
-idfn = [cps|
-        (letrec ((id (λ (x ktail)
-                       (continue ktail x))))
-          (id 456 halt))
-      |] :: Program

src/Gyehoek/CPS/Lower.hs

@@ -5,20 +5,15 @@
 {-# LANGUAGE MultilineStrings #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE ApplicativeDo #-}
-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
 {-# LANGUAGE RecursiveDo #-}
 {- HLINT ignore "Use camelCase" -}
 module Gyehoek.CPS.Lower
   (lower, lowerProgram) where
 
 import Gyehoek.CPS.Syntax
-import Data.Generics.Labels ()
-import Effectful
-import Data.Text (Text)
 import Data.Vector.Strict (Vector)
 import Control.Lens hiding (op)
 import Numeric.Natural
-import GHC.Generics (Generic)
 import qualified Data.Vector.Strict as V
 import Gyehoek.Wasm qualified as Wasm
 import Gyehoek.Wasm hiding (Expr)
@@ -26,12 +21,9 @@ import Language.Sexp.Located qualified as SL
 import Control.Monad.Fix
 import qualified Gyehoek.Sexp
 import Data.Text qualified as T
-import Data.List qualified
 import Data.Foldable (fold)
-import Gyehoek.Sexp (encodeOrShow, toSexp)
-import Debug.Pretty.Simple
-import GHC.Stack (HasCallStack)
-import Data.String.Interpolate
+import Gyehoek.Sexp (encodeOrShow)
+import Gyehoek.Prelude
 
 
 data Env = MkEnv

src/Gyehoek/CPS/Stackify.hs

@@ -9,18 +9,12 @@ import Gyehoek.CPS.Syntax
 import Gyehoek.Stack.Syntax qualified as Stk
 import Data.Sequence (Seq)
 import Data.Sequence qualified as Seq
-import Effectful
 import Gyehoek.GenSym
 import Effectful.Writer.Static.Shared
-import Control.Lens
-import Data.String.Interpolate
-import Gyehoek.Stack.Syntax (Imm(..))
-import GHC.Generics (Generic)
 import Data.Foldable
-import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as H
-import Data.List (List, elemIndex)
-import GHC.Exts (IsList(fromList))
+import Data.List (elemIndex)
+import Gyehoek.Prelude
 
 
 type Stackify = Writer Stk.Program

src/Gyehoek/CPS/Syntax.hs

@@ -36,8 +36,6 @@ module Gyehoek.CPS.Syntax
   , pattern AbsKappa'
   , Abs(..)
   , Free(..)
-  , Vars(..)
-  , Subst(..)
   , pattern ValLabel
   , labelName -- don't like that this is part of the api
   )
@@ -45,32 +43,21 @@ module Gyehoek.CPS.Syntax
 
 import Language.SexpGrammar qualified as S
 import Gyehoek.Sexp qualified
-import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit(..), pattern Void, getName)
-import Data.List (List)
-import GHC.Generics (Generic)
-import Data.Generics.Labels ()
+import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit(..), pattern Void)
 import Language.SexpGrammar.Generic
 import Control.Category
-import Control.Lens hiding (op)
 import Prelude hiding ((.), id)
-import Data.List.NonEmpty (NonEmpty)
 import Language.Haskell.TH.Quote (QuasiQuoter)
-import Data.Data (Data)
 import Language.Sexp.Located (Sexp)
 import qualified Data.InvertibleGrammar.Base as IG
-import qualified Gyehoek.Scheme.Syntax as Gyehoek
 import Data.InvertibleGrammar.Base (type (:-)((:-)))
-import Data.HashSet (HashSet)
 import qualified Data.HashSet as HS
-import Data.Hashable (Hashable)
 import Data.Monoid (Endo)
-import Data.Containers.ListUtils (nubOrd)
 import Data.Functor.Foldable.TH
-import Data.Functor.Foldable (Recursive(..), Corecursive (..))
-import Control.DeepSeq (NFData)
 import qualified Gyehoek.Sexp as GS
 import qualified Language.Sexp.Located as SL
 import Data.Data.Lens (uniplate)
+import Gyehoek.Prelude hiding (op)
 
 -- Data types
 
@@ -385,52 +372,3 @@ instance Vars Exp where
   vars k (ExpPrim p kap) = ExpPrim <$> vars k p <*> pure kap
   vars k (ExpContinue kname xs) = ExpContinue <$> k kname <*> pure xs
   vars _ e = pure e
-
-
-
-data Scope
-  = Bind (List Name) (List Scope)
-  | Use (List Name) (List Scope)
-  deriving (Show, Eq)
-
-makeBaseFunctor ''Scope
-
-class Scoped a where
-  scope :: a -> Scope
-
-instance Scoped Kappa where
-  scope (MkKappa bs e) =
-    Bind bs [scope e]
-
-instance Scoped Lambda where
-  scope (MkLambda bs k e) = Bind (bs ++ [k]) [scope e]
-
-instance Scoped Abs where
-  scope = \case
-    AbsKappa k -> scope k
-    AbsLambda l -> scope l
-
-instance Scoped Val where
-  scope = \case
-    ValVar x -> Use [x] []
-    _ -> Use [] []
-
-instance Scoped Exp where
-  scope = \case
-    ExpApply f xs k ->
-      Use (((f:xs) ^.. each . _ValVar) ++ [k]) []
-    ExpLetRec bs e ->
-      Bind (bs ^.. each . _1) $
-        (bs ^.. each . _2 . to scope)
-        ++ [scope e]
-    ExpPrim p k ->
-      Use (p ^.. each . _ValVar) [scope k]
-    ExpContinue k xs ->
-      Use (k : (xs ^.. each . _ValVar)) []
-    ExpIf c t f ->
-      Use (c ^.. _ValVar) [ scope t, scope f ]
-
-
-
-class Subst a where
-  substWith :: (Name -> Maybe Val) -> a -> a

src/Gyehoek/Driver.hs

@@ -3,7 +3,6 @@ module Gyehoek.Driver
   where
 
 import Gyehoek.Options
-import Data.Text (Text)
 import Prelude hiding (readFile)
 import Options.Applicative
 import Control.Lens
@@ -23,21 +22,17 @@ import Gyehoek.CPS.Eval qualified as CPS
 import Control.Monad
 import Text.Pretty.Simple (pShowNoColor)
 import System.Process.Typed
-import Data.Text.Encoding (encodeUtf8)
 import System.Environment.Blank (getEnvDefault)
-import GHC.Conc (atomically)
 import qualified Data.Text.IO as TIO
 import qualified Data.ByteString.Lazy as BS
 import Gyehoek.CPS.Stackify (stackifyProgram)
-import Text.Pretty.Simple (pShow)
 import Gyehoek.Stack.VM (eval, writeObj, Obj)
 import qualified Data.Text as T
-import Data.List (List)
 import Gyehoek.Stack.Syntax qualified as Stk
-import Effectful.Exception
 import Gyehoek.CPS.Close (closeProgram)
 import Control.Lens.Extras (is)
 import Control.Arrow ((>>>))
+import Gyehoek.Prelude
 
 
 main :: IO ()

src/Gyehoek/Options.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE NoFieldSelectors #-}
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE RecordWildCards #-}
 module Gyehoek.Options
   ( Options(..)
   , Runtime(..)
@@ -6,14 +7,9 @@ module Gyehoek.Options
   )
   where
 
-import System.IO (Handle)
-import Data.HashSet (HashSet)
 import Options.Applicative
-import System.FilePath
-import qualified Data.HashSet as HS
-import Control.Lens hiding (argument)
-import GHC.Generics (Generic)
 import Data.Foldable
+import Gyehoek.Prelude hiding (argument)
 
 
 data Runtime = Stackify | Wasm | CPS
@@ -31,55 +27,35 @@ data Options = MkOptions
   }
   deriving (Show, Generic)
 
--- osPath :: ReadM _
--- osPath = eitherReader $
---   (_Left %~ show) . encodeUtf @(Either _)
-
--- parseDumpQBE =
---   optional $ strOption
---     ( long "dump-qbe"
---     <> metavar "FILE"
---     )
-
--- parseDumpANF =
---   optional $ strOption
---     ( long "dump-anf"
---     <> metavar "FILE"
---     )
-
-parseOutput = strOption
-    ( long "output"
-    <> short 'o'
-    <> metavar "FILE"
-    <> value "-"
-    )
-
-parseRuntime = option rdr . fold $
-  [ long "runtime"
-  , short 'R'
-  , value Nothing
-  ]
-  where
-    rdr = maybeReader \case
-      "stackify" -> Just (Just Stackify)
-      "wasm" -> Just (Just Wasm)
-      "cps" -> Just (Just CPS)
-      "none" -> Just Nothing
-      _ -> Nothing
-
-parseDumpClosed = switch (long "dump-closed")
-parseDumpCPS = switch (long "dump-cps")
-parseDumpStackified = switch (long "dump-stackified")
-parseDumpParsed = switch (long "dump-parsed")
-parseInspectWasm = switch $ long "inspect-wasm" <> short 'p'
+runtimeReader = maybeReader \case
+  "stackify" -> Just (Just Stackify)
+  "wasm" -> Just (Just Wasm)
+  "cps" -> Just (Just CPS)
+  "none" -> Just Nothing
+  _ -> Nothing
 
 parser :: Parser Options
-parser = MkOptions
-  <$> parseDumpClosed
-  <*> parseDumpCPS
-  <*> parseDumpParsed
-  <*> parseDumpStackified
-  <*> parseRuntime
-  <*> parseInspectWasm
-  <*> parseOutput
-  <*> argument str (metavar "FILE")
+parser = do
+  dumpClosed <- switch (long "dump-closed")
+  dumpCPS <- switch (long "dump-cps")
+  dumpStackified <- switch (long "dump-stackified")
+  dumpParsed <- switch (long "dump-parsed")
+  inspectWasm <- switch $ long "inspect-wasm" <> short 'p'
+  runtime <- option runtimeReader . fold $
+    [ long "runtime"
+    , short 'R'
+    , value (Just Stackify)
+    , completeWith ["stackify","wasm","cps","none"]
+    , showDefaultWith $ const "stackify"
+    ]
+  output <- strOption . fold $
+    [ long "output"
+    , short 'o'
+    , metavar "FILE"
+    , value "-"
+    ]
+  sourceFile <- argument str . fold $
+    [ metavar "FILE"
+    , action "file"
+    ]
+  pure $ MkOptions {..}

src/Gyehoek/Prelude.hs

@@ -0,0 +1,34 @@
+module Gyehoek.Prelude
+  ( module Control.Lens
+  , module Effectful
+  , module Data.Generics.Labels
+  , module Data.String.Interpolate
+  , Text
+  , List
+  , Generic
+  , Data
+  , NFData
+  , HashMap
+  , HashSet
+  , coerce
+  , IsList(fromList)
+  , HasCallStack
+  , Hashable
+  ) where
+
+import Control.Lens
+import Data.List (List)
+import Data.Text (Text)
+import Effectful (Eff, runEff, runPureEff, (:>))
+import GHC.Generics (Generic)
+import Data.Data (Data)
+import Control.DeepSeq (NFData)
+import Data.HashMap.Strict (HashMap)
+import Data.HashSet (HashSet)
+import Data.Coerce (coerce)
+import GHC.Exts (IsList(..))
+import Data.Generics.Labels ()
+import Data.String.Interpolate
+import GHC.Stack (HasCallStack)
+import Data.Hashable (Hashable)
+

src/Gyehoek/Scheme/Syntax.hs

@@ -35,27 +35,21 @@ module Gyehoek.Scheme.Syntax
   )
   where
 
-import Data.Text (Text)
-import Data.List (List, intersperse)
+import Data.List (intersperse)
 import Language.SexpGrammar
   ( SexpIso(..), list, el, rest, sym, symbol )
 import Language.SexpGrammar qualified as Sexp
 import Language.SexpGrammar.Generic
 import Effectful
-import GHC.Generics (Generic)
 import Prelude hiding ((.), id)
 import Control.Category
-import Data.List.NonEmpty (NonEmpty)
 import Gyehoek.Sexp qualified as GS
 import Gyehoek.GenSym (Gen)
 import Control.Lens
 import Data.Generics.Labels ()
 import Data.String (IsString)
-import Data.Hashable (Hashable)
-import Data.Data (Data)
 import Data.Functor.Foldable.TH (makeBaseFunctor)
 import Data.Functor.Foldable hiding (fold)
-import Data.HashSet (HashSet)
 import qualified Data.HashSet as HS
 import Data.Foldable (fold, toList)
 import Language.Haskell.TH.Quote (QuasiQuoter)
@@ -63,9 +57,8 @@ import Effectful.FileSystem (runFileSystem)
 import qualified Effectful.FileSystem.IO as FS
 import qualified Data.Text.Encoding as T
 import qualified Effectful.FileSystem.IO.ByteString as FB
-import Control.DeepSeq (NFData)
 import qualified Data.Set.Ordered as O
-import Data.Sequence (Seq)
+import Gyehoek.Prelude
 
 
 newtype Name = MkName { inner :: Text }

src/Gyehoek/Stack/Syntax.hs

@@ -18,24 +18,15 @@ module Gyehoek.Stack.Syntax
   ) where
 
 import Control.Lens
-import Data.List (List)
-import GHC.Generics (Generic)
-import Data.HashMap.Strict (HashMap)
-import Language.SexpGrammar (SexpIso, (>>>), (:-))
+import Language.SexpGrammar (SexpIso, (>>>))
 import Language.SexpGrammar qualified as S
 import Language.SexpGrammar.Generic
-import Data.Coerce (coerce)
-import Data.Text (Text)
 import qualified Gyehoek.Sexp
-import Language.Haskell.TH.Quote (QuasiQuoter)
-import Data.Data (Data)
-import qualified Data.HashMap.Strict as H
-import Effectful
 import Gyehoek.Scheme.Syntax (Name(..), Lit(..), Prim(..))
 import GHC.Exts (IsList(..))
 import Data.List (intersperse)
-import Control.DeepSeq (NFData)
 import Gyehoek.CPS.Syntax (Imm(..), Obj(..), Hob(..), labelName)
+import Gyehoek.Prelude
 
 
 newtype Program = MkProgram

src/Gyehoek/Stack/VM.hs

@@ -9,18 +9,10 @@ module Gyehoek.Stack.VM
   ) where
 
 import Gyehoek.Stack.Syntax
-import Data.List (List)
-import GHC.Generics (Generic)
 import Control.Lens
-import Data.HashMap.Strict (HashMap)
-import Data.Text (Text)
 import qualified Data.HashMap.Strict as H
-import Data.String.Interpolate (i)
-import Gyehoek.Scheme.Syntax (Sexp(..))
-import Debug.Pretty.Simple (pTraceShowIdForceColor)
-import qualified Data.List.NonEmpty as NE
-import Data.Functor (($>))
 import Data.List (unfoldr)
+import Gyehoek.Prelude
 
 
 data VM = MkVM

t.scm

@@ -1,21 +0,0 @@
-(define (-& x y k) (k (- x y)))
-(define (zero?& x k) (k (zero? x)))
-(define (halt x) x)
-
-(letrec ((even? (lambda (n ktail)
-                  (zero?& n
-                          (lambda (x1)
-                            (if x1
-                                #t
-                                (-& n 1
-                                    (lambda (x2)
-                                      (odd? x2 ktail))))))))
-         (odd? (lambda (n ktail)
-                 (zero?& n
-                         (lambda (x1)
-                           (if x1
-                               #f
-                               (-& n 1
-                                   (lambda (x2)
-                                     (even? x2 ktail)))))))))
-  (even? 12 halt))

t.wat

@@ -1,142 +0,0 @@
-(module
-  (import
-    "gyehoek"
-    "write"
-    (func $gh-write (param (ref eq))))
-  (import
-    "gyehoek"
-    "truthy?"
-    (func $gh-truthy? (param (ref eq)) (result i32)))
-  (type $heap-object (sub (struct (field $hash (mut i32)))))
-  (type $cont-type (func (param i32)))
-  (type $cont-stack-type (array (mut (ref null $cont-type))))
-  (type
-    $closure
-    (sub
-      $heap-object
-      (struct
-        (field $hash (mut i32))
-        (field $code (ref $cont-type)))))
-  (global $cont-stack-top (mut i32) (i32.const 0))
-  (global
-    $cont-stack
-    (ref $cont-stack-type)
-    (array.new_default $cont-stack-type (i32.const 128)))
-  (global $arg0 (mut (ref null eq)) (ref.null eq))
-  (global $arg1 (mut (ref null eq)) (ref.null eq))
-  (global $arg2 (mut (ref null eq)) (ref.null eq))
-  (global $arg3 (mut (ref null eq)) (ref.null eq))
-  (global $arg4 (mut (ref null eq)) (ref.null eq))
-  (global $arg5 (mut (ref null eq)) (ref.null eq))
-  (global $arg6 (mut (ref null eq)) (ref.null eq))
-  (global $arg7 (mut (ref null eq)) (ref.null eq))
-  (global $arg8 (mut (ref null eq)) (ref.null eq))
-  (global $arg9 (mut (ref null eq)) (ref.null eq))
-  (global $arg10 (mut (ref null eq)) (ref.null eq))
-  (global $arg11 (mut (ref null eq)) (ref.null eq))
-  (global $arg12 (mut (ref null eq)) (ref.null eq))
-  (global $arg13 (mut (ref null eq)) (ref.null eq))
-  (global $arg14 (mut (ref null eq)) (ref.null eq))
-  (global $arg15 (mut (ref null eq)) (ref.null eq))
-  (global $result (mut (ref null eq)) (ref.null eq))
-  (func
-    $halt
-    (param i32)
-    (@gyehoek begin popArg)
-    (global.get $arg0)
-    ref.as_non_null
-    (@gyehoek end popArg)
-    (global.set $result))
-  (func
-    (param i32)
-    (@gyehoek
-      :origin
-      "(λ (x λ-tail1) (prim (* x x) (κ (r2) (continue λ-tail1 r2))))")
-    (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
-    (@gyehoek
-      :origin
-      "(prim (* x x) (κ (r2) (continue λ-tail1 r2)))")
-    (global.get $arg1)
-    (i31.get_s (ref.cast (ref i31)))
-    (i32.const 1)
-    i32.shr_u
-    (global.get $arg1)
-    (i31.get_s (ref.cast (ref i31)))
-    (i32.const 1)
-    i32.shr_u
-    i32.mul
-    (@gyehoek "construct small fixnum")
-    (i32.const 1)
-    i32.shl
-    ref.i31
-    (global.set $arg2)
-    (@gyehoek :origin "(continue λ-tail1 r2)")
-    (@gyehoek "push args")
-    (@gyehoek begin pushArg)
-    (global.get $arg2)
-    (global.set $arg0)
-    (@gyehoek end pushArg)
-    (@gyehoek "nargs")
-    (i32.const 1)
-    (@gyehoek "pop cont stack")
-    (global.get $cont-stack-top)
-    (i32.const 1)
-    i32.sub
-    (global.set $cont-stack-top)
-    (global.get $cont-stack)
-    (global.get $cont-stack-top)
-    (array.get $cont-stack-type)
-    ref.as_non_null
-    (return_call_ref $cont-type))
-  (elem declare funcref (ref.func 3))
-  (func
-    (param i32)
-    (@gyehoek :origin "(κ (x4) (continue halt x4))")
-    (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
-    (@gyehoek begin pushArg)
-    (global.get $arg2)
-    (global.set $arg0)
-    (@gyehoek end pushArg)
-    (return_call $halt (i32.const 1)))
-  (elem declare funcref (ref.func 4))
-  (func
-    $scm-entry
-    (param i32)
-    (@gyehoek
-      :origin
-      "(letrec ((λ-body0 (λ (x λ-tail1) (prim (* x x) (κ (r2) (continue λ-tail1 r2)))))) (letrec ((r3 (κ (x4) (continue halt x4)))) (λ-body0 5 r3)))")
-    (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
-    (i32.const 0)
-    (ref.func 3)
-    (struct.new $closure)
-    (global.set $arg1)
-    (@gyehoek :origin "(λ-body0 5 r3)")
-    (@gyehoek "push cont" :idx 4)
-    (array.set
-      $cont-stack-type
-      (global.get $cont-stack)
-      (global.get $cont-stack-top)
-      (ref.func 4))
-    (global.set
-      $cont-stack-top
-      (i32.add (global.get $cont-stack-top) (i32.const 1)))
-    (@gyehoek :origin "(λ-body0 5 r3)")
-    (@gyehoek "load args")
-    (@gyehoek begin pushArg)
-    (i32.const 5)
-    (@gyehoek "construct small fixnum")
-    (i32.const 1)
-    i32.shl
-    ref.i31
-    (global.set $arg0)
-    (@gyehoek end pushArg)
-    (i32.const 1)
-    (global.get $arg1)
-    (ref.cast (ref $closure))
-    (struct.get $closure $code)
-    (return_call_ref $cont-type)
-    (@gyehoek todo (f' (global.get $arg1)) (ktail 1)))
-  (func
-    (export "main")
-    (call $scm-entry (i32.const 0))
-    (call $gh-write (ref.as_non_null (global.get $result)))))

u.wat

@@ -1,127 +0,0 @@
-(module
- (import "gyehoek" "write" (func $gh-write (param (ref eq))))
- (import "gyehoek" "truthy?" (func $gh-truthy? (param (ref eq)) (result i32)))
- (type $heap-object (sub (struct (field $hash (mut i32)))))
- (type $cont-type (func (param i32)))
- (type $cont-stack-type (array (mut (ref null $cont-type))))
- (type
-  $closure
-  (sub
-   $heap-object
-   (struct
-    (field $hash (mut i32))
-    (field $code (ref $cont-type)))))
- (global $cont-stack-top (mut i32) (i32.const 0))
- (global
-  $cont-stack
-  (ref $cont-stack-type)
-  (array.new_default $cont-stack-type (i32.const 128)))
- (type $arg-array-type (array (mut (ref null eq))))
- (global
-  $arg-array
-  (ref $arg-array-type)
-  (array.new_default $arg-array-type (i32.const 32)))
- (global $result (mut (ref null eq)) (ref.null eq))
- (func
-  $halt
-  (param i32)
-  (global.get $arg-array)
-  (i32.const 0)
-  (array.get $arg-array-type)
-  ref.as_non_null
-  (global.set $result))
- (func
-  (param i32)
-  (@gyehoek
-   :origin
-   (lambda (x lambda-tail1)
-     (prim (* x x) (kappa (r2) (continue lambda-tail1 r2)))))
-  (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
-  (global.get $arg-array)
-  (i32.const 0)
-  (array.get $arg-array-type)
-  ref.as_non_null
-  (local.set 1)
-  (local.get 1)
-  (i31.get_s (ref.cast (ref i31)))
-  (i32.const 1)
-  i32.shr_u
-  (local.get 1)
-  (i31.get_s (ref.cast (ref i31)))
-  (i32.const 1)
-  i32.shr_u
-  i32.mul
-  (i32.const 1)
-  i32.shl
-  ref.i31
-  (local.set 2)
-  (global.get $arg-array)
-  (i32.const 0)
-  (local.get 2)
-  (array.set $arg-array-type)
-  (i32.const 1)
-  (global.get $cont-stack)
-  (global.get $cont-stack-top)
-  (array.get $cont-stack-type)
-  ref.as_non_null
-  (global.get $cont-stack-top)
-  (i32.const 1)
-  i32.sub
-  (global.set $cont-stack-top)
-  (return_call_ref $cont-type))
- (elem declare funcref (ref.func 3))
- (func
-  (param i32)
-  (@gyehoek :origin (kappa (x4) (continue halt x4)))
-  (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
-  (global.get $arg-array)
-  (i32.const 0)
-  (array.get $arg-array-type)
-  ref.as_non_null
-  (local.set 1)
-  (global.get $arg-array)
-  (i32.const 0)
-  (local.get 1)
-  (array.set $arg-array-type)
-  (return_call $halt (i32.const 1)))
- (func
-  $scm-entry
-  (param i32)
-  (@gyehoek
-   :origin
-   (letrec ((lambda-body0
-             (lambda (x lambda-tail1)
-               (prim (* x x) (kappa (r2) (continue lambda-tail1 r2))))))
-     (letrec ((r3 (kappa (x4) (continue halt x4))))
-       (lambda-body0 5 r3))))
-  (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
-  (i32.const 0)
-  (ref.func 3)
-  (struct.new $closure)
-  (local.set 1)
-  (@gyehoek "push return cont" :idx 4)
-  (array.set $cont-stack-type
-             (global.get $cont-stack)
-             (global.get $cont-stack-top)
-             (ref.func 4))
-  (global.set $cont-stack-top
-              (i32.add (global.get $cont-stack-top)
-                       (i32.const 1)))
-  (@gyehoek "load args")
-  (global.get $arg-array)
-  (i32.const 0)
-  (i32.const 5)
-  (i32.const 1)
-  i32.shl
-  ref.i31
-  (array.set $arg-array-type)
-  (@gyehoek todo (f' (local.get 1)) (ktail 1))
-  (return_call_ref $cont-type
-                   (i32.const 1)
-                   (struct.get $closure $code
-                               (ref.cast (ref $closure) (local.get 1)))))
- (elem declare funcref (ref.func 4))
- (func
-  (export "main")
-  (call $scm-entry (i32.const 0))
-  (call $gh-write (ref.as_non_null (global.get $result)))))

wasmtime.nix

@@ -1,26 +0,0 @@
-# A Wasmtime wrapper that provides our desired configuration.
-{ wasmtime
-, makeWrapper
-, symlinkJoin
-, formats
-, extraSettings ? {}
-}:
-
-let
-  config = {
-    wasm.gc = true;
-  };
-  config-file =
-    (formats.toml {}).generate
-      "gyehoek-wasmtime.toml"
-      (config // extraSettings);
-in symlinkJoin {
-  name = "gyehoek-wasmtime";
-  inherit (wasmtime) version;
-  paths = [ wasmtime ];
-  nativeBuildInputs = [ makeWrapper ];
-  postBuild = ''
-    wrapProgram $out/bin/wasmtime \
-      --add-flags "--config ${config-file}"
-  '';
-}

wasmtime.toml

@@ -1,6 +0,0 @@
-# Comment out certain settings to use default values.
-# For more settings, please refer to the documentation:
-# https://bytecodealliance.github.io/wasmtime/cli-cache.html
-
-[wasm]
-gc=true