diff --git a/README.md b/README.md index 2e02f23..d7805c0 100644 --- a/README.md +++ b/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. \ No newline at end of file +a WIP compiler for R⁷RS Scheme targeting WebAssembly. diff --git a/flake.nix b/flake.nix index b380772..b3f31ed 100644 --- a/flake.nix +++ b/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 diff --git a/gyehoek.cabal b/gyehoek.cabal index eef1e01..0c88ccb 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -61,6 +61,7 @@ library Gyehoek.Driver Gyehoek.GenSym Gyehoek.Options + Gyehoek.Prelude Gyehoek.Scheme.Syntax Gyehoek.Sexp Gyehoek.Stack.Syntax diff --git a/repl b/repl deleted file mode 100755 index c655882..0000000 --- a/repl +++ /dev/null @@ -1,2 +0,0 @@ -#!/usr/bin/env sh -cabal repl --repl-options "-interactive-print=Text.Pretty.Simple.pPrint" --build-depends pretty-simple diff --git a/shake-wrapper.nix b/shake-wrapper.nix deleted file mode 100644 index 9b39443..0000000 --- a/shake-wrapper.nix +++ /dev/null @@ -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]} - '' diff --git a/src/Gyehoek/CPS/Close.hs b/src/Gyehoek/CPS/Close.hs index f9663f5..6ddeb01 100644 --- a/src/Gyehoek/CPS/Close.hs +++ b/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))) -|] diff --git a/src/Gyehoek/CPS/Convert.hs b/src/Gyehoek/CPS/Convert.hs index 74dbb9a..bfc4c8e 100644 --- a/src/Gyehoek/CPS/Convert.hs +++ b/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 diff --git a/src/Gyehoek/CPS/Eval.hs b/src/Gyehoek/CPS/Eval.hs index ddde213..f74c1d6 100644 --- a/src/Gyehoek/CPS/Eval.hs +++ b/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 diff --git a/src/Gyehoek/CPS/Lower.hs b/src/Gyehoek/CPS/Lower.hs index fdd49c3..ebd26de 100644 --- a/src/Gyehoek/CPS/Lower.hs +++ b/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 diff --git a/src/Gyehoek/CPS/Stackify.hs b/src/Gyehoek/CPS/Stackify.hs index b435e55..6df54c1 100644 --- a/src/Gyehoek/CPS/Stackify.hs +++ b/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 diff --git a/src/Gyehoek/CPS/Syntax.hs b/src/Gyehoek/CPS/Syntax.hs index d911ce0..9dda7a1 100644 --- a/src/Gyehoek/CPS/Syntax.hs +++ b/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 diff --git a/src/Gyehoek/Driver.hs b/src/Gyehoek/Driver.hs index 09034cc..ff1e7d4 100644 --- a/src/Gyehoek/Driver.hs +++ b/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 () diff --git a/src/Gyehoek/Options.hs b/src/Gyehoek/Options.hs index 1e25989..09d717e 100644 --- a/src/Gyehoek/Options.hs +++ b/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 {..} diff --git a/src/Gyehoek/Prelude.hs b/src/Gyehoek/Prelude.hs new file mode 100644 index 0000000..236556f --- /dev/null +++ b/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) + diff --git a/src/Gyehoek/Scheme/Syntax.hs b/src/Gyehoek/Scheme/Syntax.hs index cab601a..8981c54 100644 --- a/src/Gyehoek/Scheme/Syntax.hs +++ b/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 } diff --git a/src/Gyehoek/Stack/Syntax.hs b/src/Gyehoek/Stack/Syntax.hs index 2909447..1c5dddd 100644 --- a/src/Gyehoek/Stack/Syntax.hs +++ b/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 diff --git a/src/Gyehoek/Stack/VM.hs b/src/Gyehoek/Stack/VM.hs index 9a44959..a6600ff 100644 --- a/src/Gyehoek/Stack/VM.hs +++ b/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 diff --git a/t.scm b/t.scm deleted file mode 100644 index 6b87d22..0000000 --- a/t.scm +++ /dev/null @@ -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)) diff --git a/t.wat b/t.wat deleted file mode 100644 index b0bad4e..0000000 --- a/t.wat +++ /dev/null @@ -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))))) diff --git a/u.wat b/u.wat deleted file mode 100644 index 864840d..0000000 --- a/u.wat +++ /dev/null @@ -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))))) diff --git a/wasmtime.nix b/wasmtime.nix deleted file mode 100644 index 84393cb..0000000 --- a/wasmtime.nix +++ /dev/null @@ -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}" - ''; -} diff --git a/wasmtime.toml b/wasmtime.toml deleted file mode 100644 index 174e8f9..0000000 --- a/wasmtime.toml +++ /dev/null @@ -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 \ No newline at end of file