stupid

.dir-locals.el

@@ -1,5 +1,16 @@
-((haskell-cabal-mode
+((haskell-mode
+  . ((eval
+      . (progn (add-to-list 'haskell-font-lock-quasi-quote-modes
+                            '("cps" . scheme-mode))
+               (add-to-list 'haskell-font-lock-quasi-quote-modes
+                            '("scm" . scheme-mode))))))
+ (haskell-cabal-mode
   . ((eval
       . (progn (defun apply-cabal-fmt-h ()
                  (haskell-mode-buffer-apply-command "cabal-fmt"))
-               (add-hook 'before-save-hook #'apply-cabal-fmt-h nil t))))))
+               (add-hook 'before-save-hook #'apply-cabal-fmt-h nil t)))))
+ (nil
+  . ((eval
+      . (progn (defun display-ansi ()
+                 (interactive)
+                 (ansi-color-apply-on-region (point-min) (point-max))))))))

.envrc

@@ -1 +1,3 @@
 use flake
+watch_file gyehoek.cabal cabal.project
+PATH_add $(dirname $(cabal list-bin gyehoek))

.gitea/workflows/build.yaml

@@ -0,0 +1,13 @@
+name: build
+on: [push]
+
+jobs:
+  build:
+    runs-on: nixos
+    steps:
+      - name: Check out repository code
+        uses: actions/checkout@v4
+      - name: build gyehoek
+        run: nix build -L .#gyehoek
+      - name: test gyehoek
+        run: nix flake check -L

.gitignore

@@ -8,4 +8,5 @@ dist-newstyle
 *.tix
 .direnv
 result
-play/
+play/
+trace.html

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.

app/Gyehoek/CPS/Convert.hs

@@ -1,49 +0,0 @@
-{-# LANGUAGE OverloadedLists #-}
-module Gyehoek.CPS.Convert
-  ( convert
-  ) where
-
-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
-
-
--- 뻘짓이어라
-telescope
-  :: Traversable t
-  => (a -> (b -> r) -> r)
-  -> t a -> (t b -> r) -> r
-telescope f = Cont.runCont . traverse (Cont.cont . f)
-
-convert
-  :: forall es. (GenSym :> es)
-  => Scm.Exp -> (Val -> Eff es Exp) -> Eff es Exp
-
-convert (Scm.ExpVar x) k = k $ ValVar x
-convert (Scm.ExpLit l) k = k $ ValLit l
-
-convert (Scm.ExpPrim p) k =
-  telescope (convert @es) p \p' -> do
-    r <- gensym' "r"
-    ExpPrim p' [r] <$> k (ValVar r)
-
-convert (Scm.ExpLambda xs e) k = do
-  f <- gensym' "f"
-  ktail <- gensym' "ktail"
-  m <- convert e $ \e' ->
-    pure $ ExpApply (ValVar ktail) [e']
-  ExpFix [(f, MkKappa (xs ++ [ktail]) m)] <$> k (ValVar f)
-
-convert (Scm.ExpApply f xs) k =
-  telescope (convert @es) (f:|xs) \(f':|xs') -> do
-    r <- gensym' "r"
-    x <- gensym' "x"
-    m <- k (ValVar x)
-    pure $ ExpFix [(r, MkKappa [x] m)] $ ExpApply f' (xs' ++ [ValVar r])
-
-convert (Scm.ExpBegin xs) k = _
-
-convert _ k = _

app/Gyehoek/CPS/Lower.hs

@@ -1,95 +0,0 @@
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedLabels #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE MultilineStrings #-}
-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
-module Gyehoek.CPS.Lower
-  (
-  lower) where
-
-import Gyehoek.CPS.Syntax
-import Data.Generics.Labels
-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 Effectful.Writer.Static.Local
-import Data.Text (Text)
-import Data.Vector.Strict (Vector)
-import Control.Lens
-import Data.Foldable
-import Data.HashMap.Strict (HashMap)
-import Numeric.Natural
-import GHC.Generics (Generic)
-import Gyehoek.Scheme.Syntax (Lit(LitInt))
-import Text.Printf
-import qualified Data.Text as T
-import qualified Data.Vector.Strict as V
-import Data.IntMap.Strict (IntMap)
-
-
-data Env = MkEnv { vars :: Vector Name }
-  deriving (Show, Generic)
-
-emptyEnv :: Env
-emptyEnv = MkEnv mempty
-
-type instance Index Env = Natural
-type instance IxValue Env = Name
-
-instance Ixed Env where
-  ix i = #vars . ix (fromIntegral i)
-
-
-
-tshow :: Show a => a -> Text
-tshow = T.pack . show
-
-
-
-lowerVal :: Env -> Val -> Vector Text
-
-lowerVal g (ValLit l) =
-  case l of
-    LitInt n -> [ "i32.const " <> tshow n ]
-    _ -> _
-
-lowerVal g (ValVar x) = [ "local.get " <> tshow i ]
-  where
-    i = V.elemIndex x g.vars ^?! _Just
-
-lower' :: Env -> Exp -> Vector Text
-
-lower' g (Halt [e]) = lowerVal g e
-
-lower' g (ExpPrim p rs e) =
-  case p of
-    PrimAdd x y -> lowerBinOp "i32.add" g x y r e
-    PrimMul x y -> lowerBinOp "i32.mul" g x y r e
-  where
-    r = head rs
-
-lowerBinOp op g x y r e =
-  lowerVal g x
-  <> lowerVal g y
-  <> [ op, "local.set " <> tshow n ]
-  <> lower' g' e
-  where
-    g' = g & #vars <>~ [r]
-    n = length (g ^. #vars)
-
-
-
-makeFunc :: Vector Text -> Text
-makeFunc = (preamble<>) . (<>postamble) . T.unlines . toList . fmap indent
-  where
-    indent = ("    "<>)
-    preamble  = "(module\n\
-                \  (func (export \"main\") (result i32)\n\
-                \    (local i32 i32 i32 i32 i32 i32)\n"
-    postamble = "  ))"
-
-lower :: Exp -> Eff es Text
-lower = pure . makeFunc . lower' emptyEnv

app/Gyehoek/CPS/Syntax.hs

@@ -1,97 +0,0 @@
-{-# LANGUAGE OverloadedLabels #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Gyehoek.CPS.Syntax
-  ( Val(..)
-  , Kappa(..)
-  , Exp(..)
-  , Name(..)
-  , Prim(..)
-  , pattern Halt
-  , pattern Halt1
-  , _MkKappa
-  , _ExpPrim
-  , _ExpFix
-  , _ExpApply
-  )
-  where
-
-import Language.SexpGrammar qualified as S
-import Gyehoek.Sexp qualified
-import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit)
-import Data.Text (Text)
-import Data.List (List)
-import GHC.Generics (Generic)
-import Language.SexpGrammar.Generic
-import Control.Category
-import Control.Lens
-import Data.Text qualified as T
-import Data.Generics.Labels
-import Prelude hiding ((.), id)
-import Data.List.NonEmpty (NonEmpty)
-
--- Data types
-
-data Val
-  = ValLabel Name
-  | ValVar Name
-  | ValLit Lit
-  deriving (Show, Generic)
-
-data Kappa = MkKappa (List Name) Exp
-  deriving (Show, Generic)
-
-data Exp
-  = ExpPrim (Prim Val) (List Name) Exp
-  | ExpFix (NonEmpty (Name, Kappa)) Exp
-  | ExpApply Val (List Val)
-  | ExpIf Val Exp Exp
-  deriving (Show, Generic)
-
-pattern Halt :: List Val -> Exp
-pattern Halt xs = ExpApply (ValVar "halt") xs
-
-pattern Halt1 :: Val -> Exp
-pattern Halt1 x = ExpApply (ValVar "halt") [x]
-
-makePrisms ''Kappa
-makePrisms ''Exp
-
-
--- SexpIso instances
-
-instance S.SexpIso Val where
-  sexpIso = match
-    $ With (. label)
-    $ With (. var)
-    $ With (. S.sexpIso)
-    $ End
-    where
-      label = S.keyword >>> S.iso MkName getName
-      var = S.sexpIso
-
-instance S.SexpIso Kappa where
-  sexpIso = match
-    $ With (. kappa)
-    $ End
-    where
-      kappa = S.list $
-        S.el Gyehoek.Sexp.kappaKeyword
-        >>> S.el (S.list $ S.rest S.sexpIso)
-        >>> S.el S.sexpIso
-
-instance S.SexpIso Exp where
-  sexpIso = match
-    $ With (. prim)
-    $ With (. let_)
-    $ With (. app)
-    $ With (. if_)
-    $ End
-    where
-      let_ = Gyehoek.Sexp.let_ "fix" S.sexpIso S.sexpIso S.sexpIso
-      if_ = S.list $ S.el S.sexpIso >>> S.el S.sexpIso >>> S.el S.sexpIso
-      app = S.list $ S.el S.sexpIso >>> S.rest S.sexpIso
-      prim = S.list $
-        S.el (S.sym "prim")
-        >>> S.el (primSexpIso id (S.sexpIso @Val))
-        >>> S.el S.sexpIso
-        >>> S.el S.sexpIso

app/Gyehoek/Options.hs

@@ -1,51 +0,0 @@
-{-# LANGUAGE NoFieldSelectors #-}
-module Gyehoek.Options
-  ( Options(..)
-  , parser
-  )
-  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)
-
-
-data Options = MkOptions
-  { -- dumpANF :: Maybe FilePath
-  -- , dumpQBE :: Maybe FilePath
-  output :: FilePath
-  , sourceFile :: FilePath
-  }
-  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 "-"
-    )
-
-parser :: Parser Options
-parser = MkOptions
-  <$> parseOutput
-  <*> argument str (metavar "FILE")

app/Gyehoek/Scheme/Syntax.hs

@@ -1,166 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE OrPatterns #-}
-{-# LANGUAGE PatternSynonyms #-}
-module Gyehoek.Scheme.Syntax
-  ( Name(..)
-  , Prim(..)
-  , Lit(..)
-  , Define(..)
-  , Exp(..)
-  , Sexp(..)
-  , primSexpIso
-  )
-  where
-
-import Data.Text (Text)
-import Data.List (List)
-import Language.SexpGrammar
-  ( SexpIso(..), list, el, (>>>), rest, sym, symbol )
-import Language.SexpGrammar qualified as Sexp
-import Language.SexpGrammar.Generic
-import GHC.Generics
-import Prelude hiding ((.), id)
-import Control.Category
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import Gyehoek.Sexp qualified
-import Gyehoek.GenSym (Gen)
-import Control.Lens (Each)
-import Data.String (IsString)
-import Data.Hashable (Hashable)
-
-
-newtype Name = MkName { getName :: Text }
-  deriving newtype (Show, Eq, IsString, Gen, Hashable)
-  deriving stock (Generic)
-
-data Prim e
-  = PrimAdd e e
-  | PrimSub e e
-  | PrimMul e e
-  | PrimDiv e e
-  | PrimCons e e
-  | PrimCar e
-  | PrimCdr e
-  | PrimImmediateP e
-  | PrimConsP e
-  | PrimIntegerP e
-  | PrimWrite e
-  | PrimZeroP e
-  | PrimNewline
-  deriving (Show, Generic, Functor, Foldable, Traversable)
-
-instance Each (Prim e) (Prim e') e e'
-
-data Lit
-  = LitInt Int
-  | LitNil
-  | LitBool Bool
-  | LitString Text
-  | LitQuote Sexp
-  deriving (Show, Generic)
-
-data Define
-  = DefineConstant Name Exp
-  | DefineProcedure Name (List Name) (List Exp)
-  deriving (Show, Generic)
-
-data Exp
-  = ExpLet (NonEmpty (Name, Exp)) Exp
-  | ExpPrim (Prim Exp)
-  | ExpBegin (List Exp)
-  | ExpDefine Define
-  | ExpIf Exp Exp Exp
-  | ExpLit Lit
-  | ExpLambda (List Name) Exp
-  | ExpVar Name
-  | ExpApply Exp (List Exp)
-  deriving (Show, Generic)
-
-data Sexp
-  = SexpCons Sexp Sexp
-  | SexpSymbol Text
-  | SexpLit Lit
-  deriving (Show, Generic)
-
-
-
-instance SexpIso Name where
-  sexpIso = symbol >>> Sexp.partialOsi f g
-    where
-      f = Right . MkName
-      g (MkName s) = s
-
-primSexpIso :: (Text -> Text) -> Sexp.SexpGrammar a -> Sexp.SexpGrammar (Prim a)
-primSexpIso namefn a = match
-    $ With (. binop "+")
-    $ With (. binop "-")
-    $ With (. binop "*")
-    $ With (. binop "/")
-    $ With (. binop "cons")
-    $ With (. unop "car")
-    $ With (. unop "cdr")
-    $ With (. unop "immediate?")
-    $ With (. unop "cons?")
-    $ With (. unop "integer?")
-    $ With (. unop "write")
-    $ With (. unop "zero?")
-    $ With (. nullop "newline")
-    $ End
-    where
-      idn s = el (sym (namefn s))
-      nullop s = list $ idn s
-      unop s = list $ idn s >>> el a
-      binop s = list $ idn s >>> el a >>> el a
-
-instance SexpIso a => SexpIso (Prim a) where
-  -- sexpIso = primSexpIso ("prim:"<>) sexpIso
-  sexpIso = primSexpIso id sexpIso
-
-instance SexpIso Lit where
-  sexpIso = match
-    $ With (. sexpIso)
-    $ With (. sym "nil")
-    $ With (. sexpIso)
-    $ With (. sexpIso)
-    $ With (. Gyehoek.Sexp.prefixSugar "quote" Sexp.Quote sexpIso)
-    $ End
-
-instance SexpIso Sexp where
-  sexpIso = match
-    $ With (\cons -> cons . Gyehoek.Sexp.todo)
-    $ With (\s -> s . symbol)
-    $ With (\lit -> lit . sexpIso)
-    $ End
-
-instance SexpIso Define where
-  sexpIso = match
-    $ With (. defconst)
-    $ With (. defun)
-    $ End
-    where
-      defconst = list $ el (sym "define") >>> el sexpIso >>> el sexpIso
-      defun = list $ el (sym "define") >>> el args >>> rest sexpIso
-      args = list $ el sexpIso >>> rest sexpIso
-  
-instance SexpIso Exp where
-  sexpIso = match
-    $ With (. Gyehoek.Sexp.let_ "let" sexpIso sexpIso sexpIso)
-    $ With (. sexpIso)
-    $ With (\bgn -> bgn . list (el (sym "begin") >>> rest sexpIso))
-    $ With (. sexpIso)
-    $ With (. if_)
-    $ With (. sexpIso)
-    $ With (. lam)
-    $ With (. sexpIso)
-    $ With (\app -> app . list (el sexpIso >>> rest sexpIso))
-    $ End
-    where
-      if_ = list $ el (sym "if") >>> el sexpIso >>> el sexpIso >>> el sexpIso
-      lam = list
-        ( el Gyehoek.Sexp.lambdaKeyword
-          >>> el (sexpIso @(List Name))
-          >>> el sexpIso )

app/Gyehoek/Sexp.hs

@@ -1,143 +0,0 @@
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE OverloadedLabels #-}
-module Gyehoek.Sexp
-  ( let_
-  , sexp
-  , nonempty
-  , nonEmptyGrammar
-  , encode
-  , decode
-  , parseSexps
-  , prefixSugar
-  , todo
-  , isoIso
-  , encodeWith
-  , decodeWith
-  , kappa
-  , lambda
-  , kappaKeyword
-  , lambdaKeyword
-  )
-where
-
-import Data.Text (Text)
-import Language.SexpGrammar as Sexp hiding (List, encode, decode, encodeWith, decodeWith, iso)
-import Language.SexpGrammar qualified as Sexp
-import Language.Sexp qualified as S
-import Language.SexpGrammar.Generic
-import Data.InvertibleGrammar.Base qualified as IGB
-import Data.InvertibleGrammar qualified as IG
-import Data.InvertibleGrammar.Base ((:-)((:-)))
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import Data.List (List)
-import Data.Text.Encoding
-import Data.Either (either)
-import GHC.Generics (Generic)
-import Control.Lens
-import Data.Generics.Labels
-import System.Process
-import GHC.IO.Unsafe (unsafePerformIO)
-import qualified Data.Text.IO as TIO
-import Control.Monad (join)
-import qualified Language.Sexp.Located as SexpLoc
-import Data.Void (absurd)
-
-
-sexp :: SexpIso a => Iso' a Text
-sexp = iso
-  (either error id . encode)
-  (either error id . decode)
-
-encode :: SexpIso a => a -> Either String Text
-encode = encodeWith sexpIso
-
-decode :: SexpIso a => Text -> Either String a
-decode = decodeWith sexpIso
-
-encodeWith :: SexpGrammar a -> a -> Either String Text
-encodeWith g = (_Right %~ decodeUtf8 . view strict) . Sexp.encodeWith g
-
-decodeWith :: SexpGrammar a -> Text -> Either String a
-decodeWith g = Sexp.decodeWith g "FILE" . view lazy . encodeUtf8
-
-parseSexps :: SexpIso a => FilePath -> Text -> Either String (List a)
-parseSexps f = marshal . SexpLoc.parseSexps f . view lazy . encodeUtf8
-  where marshal = join . traverseOf (_Right . each) (fromSexp sexpIso)
-
-nonEmptyGrammar :: Grammar p (NonEmpty x :- t) (List x :- x :- t)
-nonEmptyGrammar = IGB.Iso
-  (\((x:|xs) :- t) -> reverse xs :- x :- t)
-  (\(xs :- x :- t) -> (x :| reverse xs) :- t)
-
-nonempty :: SexpGrammar a -> SexpGrammar (NonEmpty a)
-nonempty a =
-  list (el a >>> rest a) >>>
-    IG.flipped nonEmptyGrammar
-
-let_
-  :: Text
-  -> (forall t. Grammar Position (Sexp :- t) (a :- t))
-  -> (forall t. Grammar Position (Sexp :- t) (b :- t))
-  -> Grammar Position (Sexp :- (NonEmpty (a, b) :- t1)) t2
-  -> Grammar Position (Sexp :- t1) t2
-let_ kw name rhs e = list (el (sym kw) >>> el bindings >>> el e)
-  where
-    -- bindings :: Grammar Position (Sexp :- _) (List (_, _) :- _)
-    bindings = nonempty binding
-    binding :: Grammar Position (Sexp :- t) ((_, _) :- t)
-    binding = list (el name >>> el rhs) >>> pair
-
-data DotList a = MkDotList (NonEmpty a) a
-  deriving (Show, Generic)
-
-dotlist :: (forall t. Grammar Position (Sexp :- t) (a :- t)) -> _
-dotlist x = list $ rest $ coproduct
-  [ x >>> _
-  ]
-
--- | Define a sexp representation as either (⟨name⟩ ⟨e⟩) or '⟨e⟩.
-prefixSugar
-  :: Text -> Prefix
-  -> Grammar Position (Sexp :- t') a
-  -> Grammar Position (Sexp :- t') a
-prefixSugar name prefix e = coproduct
-  -- 'something
-  [ Sexp.prefixed prefix e
-  -- (quote something)
-  , list $ el (sym name) >>> el e
-  ]
-
-todo :: Grammar p (Sexp :- t) t'
-todo = (IGB.Flip $ IGB.PartialIso absurd f) >>> IGB.PartialIso absurd g
-  where
-    f _ = Left $ unexpected "todo"
-    g _ = Left $ unexpected "todo"
-
-kappa
-  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
-  -> Grammar Position (Sexp :- List a :- t1) t2
-  -> Grammar Position (Sexp :- t1) t2
-kappa name e = list $
-  el kappaKeyword
-  >>> el (list $ rest name)
-  >>> el e
-
-lambda
-  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
-  -> Grammar Position (Sexp :- List a :- t1) t2
-  -> Grammar Position (Sexp :- t1) t2
-lambda name e = list $
-  el lambdaKeyword
-  >>> el (list $ rest name)
-  >>> el e
-
-isoIso :: Iso' s a -> Grammar p (s :- t) (a :- t)
-isoIso l = Sexp.iso (view l) (review l)
-
-kappaKeyword :: Grammar Position (Sexp :- t) t
-kappaKeyword = coproduct [ sym "κ", sym "kappa" ]
-
-lambdaKeyword :: Grammar Position (Sexp :- t) t
-lambdaKeyword = coproduct [ sym "λ", sym "lambda" ]

app/Gyehoek/Wasm.hs

@@ -1,28 +0,0 @@
-{- HLINT ignore "Use newtype instead of data" -}
-module Gyehoek.Wasm
-  ()
-  where
-
-import Data.List (List)
-import GHC.Generics (Generic)
-
-
-data Module = MkModule
-  { typeSection :: List Type
-  }
-  deriving (Show, Generic)
-
-data Type
-  deriving (Show, Generic)
-
-data Function = MkFunction
-  { params :: List Type
-  , result :: List Type
-  , locals :: List Type
-  , body :: Expr
-  }
-  deriving (Show, Generic)
-
-type Expr = List Instr
-
-type Instr = ByteString

app/Main.hs

@@ -1,84 +1,6 @@
-{-# LANGUAGE OverloadedLabels #-}
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OrPatterns #-}
-module Main
-  (main)
-  where
+module Main (main) where
 
-import Gyehoek.Options
-import qualified Data.Text.IO as TIO
-import Data.Text (Text)
-import Prelude hiding (readFile)
-import Options.Applicative
-import Control.Lens
-import Data.Generics.Labels
-import System.OsPath (OsPath)
-import System.FilePath ((-<.>), dropExtension)
-import Effectful.FileSystem
-import Effectful
-import Effectful.FileSystem.IO qualified as FS
-import Effectful.FileSystem.IO.ByteString qualified as FB
-import Gyehoek.GenSym (runGenSym, GenSym, gensym, gensym')
-import qualified Gyehoek.Sexp as Sexp
-import Data.Text.Lens
-import Data.List (List)
-import qualified Gyehoek.Scheme.Syntax as Scm
-import Effectful.Exception
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import System.IO (Handle)
-import Data.List.NonEmpty (NonEmpty)
-import qualified Cradle as C
-import Gyehoek.CPS.Convert
-import Gyehoek.CPS.Lower
-import Data.Foldable
-import qualified Gyehoek.Scheme.Syntax
-import Gyehoek.CPS.Syntax
-import Data.Maybe (fromMaybe)
+import Gyehoek.Driver qualified
 
 
-main :: IO ()
-main = do
-  opts <- execParser $ info (helper <*> parser) fullDesc
-  runEff . runFileSystem . runGenSym . driver $ opts
-
-
-
-hPutStr :: FileSystem :> es => Handle -> Text -> Eff es ()
-hPutStr h = FB.hPutStr h . T.encodeUtf8
-
-hPutStrLn :: FileSystem :> es => Handle -> Text -> Eff es ()
-hPutStrLn h = FB.hPutStrLn h . T.encodeUtf8
-
-hGetContents :: FileSystem :> es => Handle -> Eff es Text
-hGetContents h = T.decodeUtf8 <$> FB.hGetContents h
-
-readFile :: FileSystem :> es => FilePath -> Eff es Text
-readFile f = FS.withFile f FS.ReadMode hGetContents
-
-withFile
-  :: (FileSystem :> es)
-  => FilePath -> FS.IOMode -> (Handle -> Eff es a) -> Eff es a
-withFile "-" FS.ReadMode k = k FS.stdin
-withFile "-" (FS.WriteMode; FS.AppendMode) k = k FS.stdout
-withFile f m k = FS.withFile f m k
-
-readScm :: FileSystem :> es => FilePath -> Eff es Scm.Exp
-readScm f =
-  withFile f FS.ReadMode $ \h ->
-    Sexp.parseSexps f <$> hGetContents h
-     >>= either error wrap
-  where
-    wrap [x] = pure x
-    wrap xs = pure . Gyehoek.Scheme.Syntax.ExpBegin $ xs
-
-driver
-  :: (GenSym :> es, FileSystem :> es, IOE :> es)
-  => Options -> Eff es ()
-driver opts = do
-  scm <- readScm opts.sourceFile
-  cps <- convert scm (pure . Halt1)
-  wat <- lower cps
-  withFile opts.output FS.WriteMode \h ->
-    hPutStr h wat
+main = Gyehoek.Driver.main

cabal.project

@@ -1,4 +1,10 @@
 packages: *.cabal
+tests: True
+-- required for doctest-parallel
+write-ghc-environment-files: always
+
+-- https://github.com/martijnbastiaan/doctest-parallel/pull/66
+allow-older: Cabal:process 
 
 source-repository-package
     type: git

doc/abi.org

@@ -0,0 +1,218 @@
+#+title: ABI
+
+largely based on the Guile Hoot's [[https://codeberg.org/spritely/hoot/src/branch/main/design/ABI.md][ABI]].
+
+* calling convention
+
+** non-tail calls
+
+- set the global variable ~$current-closure~ to the callee's closure.
+- load arguments into globals ~$arg0~, ~$arg1~, ~$arg2~, …
+- push return continuation onto ~$cont-stack~
+
+* scratchpad
+
+#+begin_src scheme
+  ;; Scheme source
+  (define (silly f g h x)
+    (f (h x) (g x)))
+
+
+  ;; continuation-passing style
+  (define (silly f g h x ktail)
+    (h x (κ (x0)
+            (g x (κ (x1)
+                    (f x0 x1 ktail))))))
+
+  ;; with explicit stacks
+  (define (silly)
+    (define f (pop!))
+    (define g (pop!))
+    (define h (pop!))
+    (define x (pop!))
+    (define ktail (pop-cont!))
+    (push-cont! (κ (x0)
+                   (define x* (pop!))
+                   (define g* (pop!))
+                   (push-cont! (κ (x1)
+                                  (define f* (pop!))
+                                  (define x0* (pop!))
+                                  (push-cont! ktail)
+                                  (push! x0*)
+                                  (push! x1)
+                                  (call! f)))
+                   (push! x*)
+                   (call! g)))
+    (push! x)
+    (call! h))
+#+end_src
+
+** fac
+
+*** Scheme source
+
+#+begin_src scheme
+(define fac
+  (λ (n)
+    (if (zero? n)
+        1
+        (* n (fac (- n 1))))))
+
+(fac 3)
+#+end_src
+
+*** CPS
+
+#+begin_src scheme
+  (define fac
+  (λ (n ktail)
+    (zero? n (κ (x0)
+                (if x0
+                    1
+                    (- n 1
+                       (κ (x1)
+                          (fac x1
+                               (κ (x2)
+                                  (* n x2 ktail))))))))))
+
+(fac 3 halt)
+
+#+end_src
+
+*** tailified
+
+#+begin_src scheme
+(define (fac-k1)
+  (define n (pop!))
+  (define x2 (pop!))
+  (define x3 (* n x2))
+  (define ktail (pop-cont!))
+  (push! x3)
+  (call! ktail))
+
+(define (fac-k0)
+  (define x0 (pop!))
+  (define n (pop!))
+  (if x0
+      (begin (define ktail (pop-cont!))
+             (push! 1)
+             (call! ktail))
+      (begin (define x1 (- n 1))
+             (push! x1)
+             (push-cont! fac-k1)
+             (call! fac))))
+
+(define (fac)
+  (define n (pop!))
+  (push! n)
+  (push-cont! fac-k0)
+  (push! n)
+  (call! zero?))
+
+(push! 3)
+(push-cont! halt)
+(call! fac)
+#+end_src
+
+evaluation of ~(fac 0)~:
+
+#+begin_src scheme
+(push! 0)                  ; [] []
+(push-cont! halt)          ; [0] []
+(call! fac)                ; [0] [halt]
+(define n (pop!))          ; [0] [halt]
+(push! n)                  ; [] [halt]
+(push-cont! fac-k0)        ; [0] [halt]
+(push! n)                  ; [0] [halt fac-k0]
+(call! zero?)              ; [0 0] [halt fac-k0]
+#<internals of zero?>      ; [0 0] [halt fac-k0]
+(define x0 (pop!))         ; [0 #t] [halt]
+(define n (pop!))          ; [0] [halt]
+(define ktail (pop-cont!)) ; [] [halt]
+(push! 1)                  ; [] []
+(call! ktail)              ; [1] []
+#+end_src
+
+evaluation of ~(fac 3)~
+
+#+begin_src scheme
+(push! 3)                  ; [] []
+(push-cont! halt)          ; [3] []
+(call! fac)                ; [3] [halt]
+
+(define n (pop!))          ; [3] [halt]
+(push! n)                  ; [] [halt]
+(push-cont! fac-k0)        ; [3] [halt]
+(push! n)                  ; [3] [halt fac-k0]
+(call! zero?)              ; [3 3] [halt fac-k0]
+#<internals of zero?>      ; [3 3] [halt fac-k0]
+(define x0 (pop!))         ; [3 #f] [halt]
+(define n (pop!))          ; [3] [halt]
+(define x1 (- n 1))        ; [] [halt]
+(push! n)                  ; [] [halt]
+(push! x1)                 ; [3] [halt]
+(push-cont! fac-k1)        ; [3 2] [halt]
+(call! fac)                ; [3 2] [halt fac-k1]
+
+(define n (pop!))          ; [3 2] [halt fac-k1]
+(push! n)                  ; [3 ] [halt fac-k1]
+(push-cont! fac-k0)        ; [3 2] [halt fac-k1]
+(push! n)                  ; [3 2] [halt fac-k1 fac-k0]
+(call! zero?)              ; [3 2 2] [halt fac-k1 fac-k0]
+#<internals of zero?>      ; [3 2 2] [halt fac-k1 fac-k0]
+(define x0 (pop!))         ; [3 2 #f] [halt fac-k1]
+(define n (pop!))          ; [3 2] [halt fac-k1]
+(define x1 (- n 1))        ; [3] [halt fac-k1]
+(push! n)                  ; [3] [halt fac-k1]
+(push! x1)                 ; [3 2] [halt fac-k1]
+(push-cont! fac-k1)        ; [3 2 1] [halt fac-k1]
+(call! fac)                ; [3 2 1] [halt fac-k1 fac-k1]
+
+(define n (pop!))          ; [3 2 1] [halt fac-k1 fac-k1]
+(push! n)                  ; [3 2] [halt fac-k1 fac-k1]
+(push-cont! fac-k0)        ; [3 2 1] [halt fac-k1 fac-k1]
+(push! n)                  ; [3 2 1] [halt fac-k1 fac-k1 fac-k0]
+(call! zero?)              ; [3 2 1 1] [halt fac-k1 fac-k1 fac-k0]
+#<internals of zero?>      ; [3 2 1 1] [halt fac-k1 fac-k1 fac-k0]
+(define x0 (pop!))         ; [3 2 1 #f] [halt fac-k1 fac-k1]
+(define n (pop!))          ; [3 2 1] [halt fac-k1 fac-k1]
+(define x1 (- n 1))        ; [3 2] [halt fac-k1 fac-k1]
+(push! n)                  ; [3 2] [halt fac-k1]
+(push! x1)                 ; [3 2 1] [halt fac-k1 fac-k1]
+(push-cont! fac-k1)        ; [3 2 1 0] [halt fac-k1 fac-k1]
+(call! fac)                ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1]
+
+(define n (pop!))          ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1]
+(push! n)                  ; [3 2 1] [halt fac-k1 fac-k1 fac-k1]
+(push-cont! fac-k0)        ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1]
+(push! n)                  ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1 fac-k0]
+(call! zero?)              ; [3 2 1 0 0] [halt fac-k1 fac-k1 fac-k1 fac-k0]
+#<internals of zero?>      ; [3 2 1 0 0] [halt fac-k1 fac-k1 fac-k1 fac-k0]
+(define x0 (pop!))         ; [3 2 1 0 #t] [halt fac-k1 fac-k1 fac-k1]
+(define n (pop!))          ; [3 2 1 0] [halt fac-k1 fac-k1 fac-k1]
+(define ktail (pop-cont!)) ; [3 2 1] [halt fac-k1 fac-k1 fac-k1]
+(push! 1)                  ; [3 2 1 1] [halt fac-k1 fac-k1]
+(call! ktail)              ; [3 2 1 1] [halt fac-k1 fac-k1]
+
+(define n (pop!))          ; [3 2 1 1] [halt fac-k1 fac-k1]
+(define x2 (pop!))         ; [3 2 1] [halt fac-k1 fac-k1]
+(define x3 (* n x2))       ; [3 2] [halt fac-k1 fac-k1]
+(define ktail (pop-cont!)) ; [3 2] [halt fac-k1 fac-k1]
+(push! x3)                 ; [3 2] [halt fac-k1]
+(call! ktail)              ; [3 2 1] [halt fac-k1]
+
+(define n (pop!))          ; [3 2 1] [halt fac-k1]
+(define x2 (pop!))         ; [3 2] [halt fac-k1]
+(define x3 (* n x2))       ; [3] [halt fac-k1]
+(define ktail (pop-cont!)) ; [3] [halt fac-k1]
+(push! x3)                 ; [3] [halt]
+(call! ktail)              ; [3 2] [halt]
+
+(define n (pop!))          ; [3 2] [halt]
+(define x2 (pop!))         ; [3] [halt]
+(define x3 (* n x2))       ; [] [halt]
+(define ktail (pop-cont!)) ; [] [halt]
+(push! x3)                 ; [] []
+(call! ktail)              ; [6] []
+;; => (halt 6)
+#+end_src

doc/closure-conversion.org

@@ -0,0 +1,134 @@
+#+title: closure-conversion
+
+the closure-conversion phase makes closed-over variables explicit by addition of the primitive ~make-closure~, taking a code pointer (in the CPS language, bare lambda) and the environment.
+
+nice testable properties of closure-converted code:
+- code pointers only appear in function position
+- no function has free variables
+
+multiple ~env-ref~ calls could probably be replaced with a primitive that loads the entire environment at once, returning multiple variables.
+
+* scratchpad
+
+** example
+
+#+caption: scheme source
+#+begin_src scheme
+  (letrec ((curried-add (λ (n)
+                          (λ (m)
+                            (+ n m)))))
+    ((curried-add 3) 4))
+#+end_src
+
+#+caption: cps
+#+begin_src scheme
+  (letrec ((curried-add
+            (λ (n ktail0)
+              (letrec ((curried-add-in
+                        (λ (m ktail1)
+                          (prim (+ n m)
+                                (κ (x0) (continue ktail1 x0))))))
+                (continue ktail0 curried-add-in)))))
+    (letrec ((k0 (κ (adder) (adder 4 halt))))
+      (curried-add 3 k0)))
+#+end_src
+
+#+caption: closure-converted
+#+begin_src scheme
+  (letrec ((curried-add
+            (λ (n ktail0)
+              (letrec ((curried-add-in-code
+                        (λ (env m ktail1)
+                          (prim (env-ref 0 env)
+                                (κ (n)
+                                   (prim (+ n m)
+                                         (κ (x0) (continue ktail1 x0))))))))
+                (prim (make-closure curried-add-in-code n)
+                      (κ (curried-add-in)
+                         (continue ktail0 curried-add-in)))))))
+    (letrec ((k0 (κ (adder-closure)
+                    (prim (closure-code adder-closure)
+                          (κ (adder)
+                             (adder adder-closure 4 halt))))))
+      (curried-add 3 k0)))
+#+end_src
+
+** wasm
+
+#+begin_src scheme
+(letrec ((make-adder
+        (lambda (n)
+          (lambda (x)
+            (+ n x)))))
+((make-adder 3) 2))
+#+end_src
+
+#+begin_src scheme
+(define add-code
+  (lambda (n env)
+    (+ n (env-ref env 'x))))
+
+(define make-adder-code
+  (lambda (n)
+    (make-closure add-code ('x n))))
+
+(define make-adder (make-closure make-adder-code))
+
+(apply-closure (apply-closure make-addder 3) 2)
+#+end_src
+
+#+begin_src wat
+(module
+ (type $heap-object (sub (struct (field $hash (mut i32)))))
+ (type $closure (sub $heap-object
+                     (struct (field $hash (mut i32))
+                             (field $code (ref $cont-type)))))
+ (type $closure1 (sub $closure
+                      (struct (field $hash (mut i32))
+                              (field $code (ref $cont-type))
+                              (field $env0 (ref eq)))))
+ (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 $argn (mut (ref null eq)) (ref.null eq))
+
+ (global $current-closure (mut (ref null $closure)) (ref.null $closure))
+
+ (func $add-code (param $nargs i32)
+       (local $n (ref eq))
+       (local $x (ref eq))
+       (local.set $n (global.get $arg0))
+       (local.set $x (struct.get $closure1
+                                 (global.get $current-closure)
+                                 $env0))
+       (return (i32.add $n $x)))
+
+ (func $make-adder-code (param $nargs i32)
+       (local $n (ref eq))
+       (local.set $n (global.get $arg0))
+       (return (struct.new $closure1
+                           0
+                           $add-code)))
+
+ (func $main
+       (local.set $make-adder
+                  (struct.new $closure
+                              0
+                              $make-adder-code))
+       (global.set $current-closure $make-adder)
+       (global.set $arg0 (i32.const 3))
+       (local.set $f (call (struct.get $closure
+                                       $make-adder
+                                       $code)
+                           1))
+       (global.set $current-closure $f)
+       (global.set $arg0 (i32.const 2))
+       (return (call (struct.get $closure
+                                 $f
+                                 $code)
+                     1))))
+#+end_src

doc/data-model.org

@@ -0,0 +1,23 @@
+#+title: representation of Scheme types
+
+the Scheme unitype is encoded as ~(ref eq)~ with immediates in ~(ref i31)~ and heap objects in ~$heap-object~:
+#+begin_src wat
+  (type $heap-object (sub (struct (field $hash (mut i32)))))
+#+end_src
+
+* immediates
+
+all immediates are stored in ~(ref i31)~ and thus must fit in 31 bits. the most important immediate, the integer, is indicated by a null low bit.
+#+begin_example
+XXXX XXXX XXXX XXXX XXXX XXXX XXXX XX00
+                                     || 
+                                     |\ used by wasm's i31 rep
+      zero indicates a 30-bit fixnum /
+      in the upper bits
+#+end_example
+
+| type/value | low bits |
+|------------+----------|
+| small int  |        0 |
+| ~false~      |       01 |
+| ~true~       |       11 |

doc/index.org

@@ -0,0 +1,53 @@
+#+title: Gyehoek Scheme
+
+#+begin_center
+(this document is written in present tense as if the project is complete, but Gyehoek is a work-in-progress.)
+#+end_center
+
+Gyehoek is an R⁷RS-compliant Scheme compiler targeting WebAssembly 3.0, relying principally on the recently standardised garbage collector and tail call proposals. the Gyehoek compiler is implemented in Haskell, and the Gyehoek runtime is a Rust program providing primitive routines and WebAssembly execution via the Wasmtime library.
+
+primitives are implemented as native Rust functions made available to the guest by Wasmtime. in the future, it would be ideal to provide the primitives as a WASI interface to help decouple ourselves from a specific Wasm runtime, but it is not a priority.
+
+Gyehoek allows separate compilation, ~eval~, first-class continuations, and so on.
+
+* pipeline
+
+a Scheme program's journey through Gyehoek is as follows:
+1. read (source code → Scheme data)
+2. parse (Scheme data → AST)
+3. expand(?) (AST → AST)
+4. contify (AST → CPS)
+5. close (CPS → CPS)
+6. lower (CPS → Wasm)
+
+** read
+
+in the read phase, Gyehoek's reader serialises textual source code into a sequence of tokens, which are then parsed into S-expressions. this phase is completely agnostic towards any interpretation of the data — it's just data, not code (yet). this distinction between reading and parsing is made so that the reader can easily be shared amongst many parsers, allowing convenient definition of human-readable representations for all sorts of compiler internals. Gyehoek's intermediate languages and WebAssembly text format are of particular interest.
+
+the reader may be configured to extend R⁷RS's syntax with a special "antiquotation" notation, used internally in the compiler to elegantly interpolate and splice S-expression literals via Haskell's quasiquotation.
+#+begin_src haskell
+  let meta = 123 :: Int
+  in [sx|(a b c #{meta} d)|] -- ⇒ (a b c 123 d)
+
+  let metas = ["c","d"] :: List Text
+  in [sx|(a b ##{metas} e f)|] -- ⇒ (a b "c" "d" e f)
+#+end_src
+
+Gyehoek's lexer and parser are generated by Alex and Happy, respectively.
+
+unless otherwise noted, the term "parse" will be used in reference to the phase taking S-expressions to ASTs, while "read" refers to the combined Alex/Happy process. if the tokenisation process (Alex) must be distinguished from the "parse" process (Happy), the former is called "lexical analysis" and the latter "syntactic analysis."
+
+** parse
+
+- use invertible-grammar library
+
+** expand
+
+** contify
+
+- procedures are distinguished from continuations, and procedure applications are distinguished from continuation jumps.
+- all continuations and lambda will be named i think. the exception is continuations for primitive calls.
+
+** close
+
+** lower

doc/make-vm-stackier.org

@@ -0,0 +1,100 @@
+* rationale?
+
+previously, the VM's stack was used for storing local variables across blocks; a Scheme procedure was split into several low-level routines (one for the procedure itself and one for each continuation), and the stack was used as a communication channel for these separate routines. in contrast, registers were local to each routine. this aligns with Wasm's model of functions pretty well, with Wasm /locals/ acting as the VM's /registers/, and a global mutable stack serving as fallback.
+
+this worked quite well until it became time to implement ~call/cc~.
+
+we are considering making the following alterations to the VM:
+- explicitly segment the stack into frames.
+- passing procedures and return addresses on the stack.
+- new instructions:
+  + ~(tail-call /n/)~
+  + ~(call /n/)~
+  + ~(load /r/ /n/)~
+  + ~(return /n/)~
+
+* scratchpad
+
+#+begin_src scheme
+  (letrec ((fac (λ (n)
+                (if (zero? n)
+                    1
+                    (* n (fac (- n 1)))))))
+  (fac 3))
+#+end_src
+
+#+begin_src scheme
+  (λ (ktail0)
+  (letrec ((fac
+            (λ (n ktail1)
+              (zero?
+               n
+               (κ (x0)
+                  (if x0
+                      (continue ktail1 1)
+                      (- n 1
+                         (κ (x1)
+                            (fac x1
+                                 (κ (x2)
+                                    (* n x2 ktail1)))))))))))
+    (fac 3)))
+#+end_src
+
+#+begin_example
+n ktail1
+| |
+| | x0
+| | |
+| | ^
+| |
+| | x1
+| | |
+| | ^
+| | 
+| | x2
+| | |
+^ ^ ^
+#+end_example
+
+#+begin_src scheme
+  (define $fac-c0
+    (pop! %x0 0) ; [ x0 $fac-c0 n $fac ktail1 ]
+    (if %x0 ; [ $fac-c0 n $fac ktail1 ]
+        ;; every variable but `ktail1' is dead so we pop them all.
+        ;; this probably means that `if' should take two continuations
+        ;; rather than two blocks.
+        (then (push! 1) ; [ $fac-c0 n $fac ktail1 ]
+              (return 1)) ; [ 1 $fac-c0 n $fac ktail1 ]
+        (else (load %n 1) ; [ $fac-c0 n $fac ktail1 ]
+              (prim %x1 (- %n 1)) ; [ $fac-c0 n $fac ktail1 ]
+              (push! $fac-c1) ; [ $fac-c0 n $fac ktail1 ]
+              (push! $fac) ; [ $fac-c1 $fac-c0 n $fac ktail1 ]
+              (push! %x1) ; [ $fac $fac-c1 $fac-c0 n $fac ktail1 ]
+              (call 1) ; [ x1 $fac $fac-c1 $fac-c0 n $fac ktail1 ]
+              )))
+
+  (define $fac-c1
+    (pop! %x2) ; [ x2 $fac-c1 $fac-c0 n $fac ktail1 ]
+    (load %n 3) ; [ $fac-c1 $fac-c0 n $fac ktail1 ]
+    (prim %x3 (* %n %x2))
+    (push! %x3) ; [ $fac-c1 $fac-c0 n $fac ktail1 ]
+    (return 1) ; [ x3 $fac-c1 $fac-c0 n $fac ktail1 ]
+    )
+
+  (define $fac
+    (load %ktail1 2) ; [ n $fac ktail1 ]
+    (load %n 0) ; [ n $fac ktail1 ]
+    (push! $fac-c0) ; [ n $fac ktail1 ]
+    (push! $zero?) ; [ $fac-c0 n $fac ktail1 ]
+    (push! %n) ; [ $zero? $fac-c0 n $fac ktail1 ]
+    (call 1) ; [ n $zero? $fac-c0 n $fac ktail1 ]
+    )
+
+  (define $start
+    (push! $fac) ; [ $start ktail0 ]
+    (push! 3) ; [ $fac $start ktail0 ]
+    (tail-call 1) ; [ 3 $fac $start ktail0 ]
+    ;; ↑ `tail-call' knows how to dispose of the caller's stack frame.
+    )
+#+end_src
+

doc/notes.org

@@ -0,0 +1,53 @@
+#+title: assorted notes on compilation
+
+* letrec
+
+consider:
+
+#+begin_src scheme
+  (letrec ((even? (lambda (n)
+                    (if (zero? n)
+                        #t
+                        (odd? (- n 1)))))
+           (odd? (lambda (n)
+                   (if (zero? n)
+                       #f
+                       (even? (- n 1))))))
+    (even? 12))
+#+end_src
+
+#+RESULTS:
+: #t
+
+since ~letrec~ is a primitive construct in the CPS language, the translation of mutually recursive functions is straightforward:
+
+#+begin_src scheme
+  (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))
+#+end_src
+
+#+RESULTS:
+: #t
+
+however, Scheme permits ~letrec~-expressions with non-lambda right-hand sides, while the CPS language permits only kappa and lambda forms. thus, the handling of these forms is less trivial.
+
+for now we'll just reject any ~letrec~ forms with non-lambda right-hand sides, lol. they aren't very important.

flake.lock

@@ -66,6 +66,21 @@
         "type": "github"
       }
     },
+    "crane": {
+      "locked": {
+        "lastModified": 1784248371,
+        "narHash": "sha256-0l0Y4D4wbZhp1Oi6h8OpbLtIm/4FN88oCf54MK2ZgiM=",
+        "owner": "ipetkov",
+        "repo": "crane",
+        "rev": "f7d151ec0bf52cf9662e2f59d7bea28588c2f070",
+        "type": "github"
+      },
+      "original": {
+        "owner": "ipetkov",
+        "repo": "crane",
+        "type": "github"
+      }
+    },
     "flake-compat": {
       "flake": false,
       "locked": {
@@ -587,6 +602,7 @@
     },
     "root": {
       "inputs": {
+        "crane": "crane",
         "haskellNix": "haskellNix",
         "nixpkgs": [
           "haskellNix",

flake.nix

@@ -7,6 +7,7 @@
       url = "git+https://git.deertopia.net/msyds/sydpkgs";
       inputs.nixpkgs.follows = "nixpkgs";
     };
+    crane.url = "github:ipetkov/crane";
   };
 
   outputs = { self, nixpkgs, sydpkgs, haskellNix, ... }@inputs:
@@ -19,27 +20,49 @@
       overlays = [
         haskellNix.overlay
         (final: prev: {
+          gyehoek-wasm-runtime = final.callPackage ./wasm-runtime {
+            crane-lib = inputs.crane.mkLib final;
+          };
           gyehoek = final.haskell-nix.project' {
             src = ./.;
             compiler-nix-name = "ghc912";
+            configureArgs = "-f-doctest";
+            modules = [({ pkgs, lib, ...}: {
+              packages.gyehoek.components.tests.test.preCheck =
+                let
+                  bin = [
+                    pkgs.git # tasty uses git diff
+                  ];
+                in ''
+                  export GYEHOEK_WASM_RUNTIME=${
+                    lib.getExe final.gyehoek-wasm-runtime
+                  }
+                  export PATH=${lib.makeBinPath bin}:$PATH
+                '';
+            })];
             shell = {
               withHoogle = true;
-              inputsFrom = [];
+              inputsFrom = [
+                final.gyehoek-wasm-runtime
+              ];
               tools = {
                 cabal = {};
                 haskell-language-server = {};
               };
               buildInputs = with final; [
-                gcc
-                qbe
                 haskellPackages.cabal-fmt
-                self.packages.${final.stdenv.hostPlatform.system}.shake
-                final.wabt
-                final.nodejs
-                final.wasmtime
-                final.wasm-tools
-                final.wac-cli
-                final.guile
+                wabt
+                nodejs
+                wasm-tools
+                wac-cli
+                guile
+                rust-analyzer
+                wasmtime
+                # bashInteractive is necessary to work around an
+                # optparse-applicative issue
+                #
+                # https://github.com/pcapriotti/optparse-applicative/pull/408
+                bashInteractive
               ];
             };
           };
@@ -67,14 +90,18 @@
       _pkgs = each-system ({ pkgs, ... }: pkgs);
       _hf = hf;
 
-      packages = each-system ({ pkgs, system, ... }:
-        hf.packages.${system} // {
-          default = hf.packages.${system}."gyehoek:exe:gyehoek";
-          shake = pkgs.callPackage ./shake-wrapper.nix {};
-        });
+      packages = each-system ({ pkgs, lib, system, ... }:
+        hf.packages.${system} // lib.fix (packages: {
+          gyehoek = hf.packages.${system}."gyehoek:exe:gyehoek";
+          default = packages.gyehoek;
+          inherit (pkgs) gyehoek-wasm-runtime;
+        }));
 
       devShells = each-system
         ({ pkgs, system, ... }: hf.devShells.${system});
+
+      checks = each-system
+        ({ pkgs, system, ... }: hf.checks.${system});
     };
 
   nixConfig = {

golden/exec/adder/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 9

golden/exec/adder/source.scm

@@ -0,0 +1,4 @@
+(let ((make-adder (lambda (x)
+                    (lambda (y)
+                      (+ x y)))))
+  ((make-adder 4) 5))

golden/exec/apply-twice/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 17

golden/exec/apply-twice/source.scm

@@ -0,0 +1,5 @@
+;; apply `f' to `x' twice.
+((λ (f x)
+   (f (f x)))
+ (λ (x) (+ x 4))
+ 9)

golden/exec/apply2/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 10

golden/exec/apply2/source.scm

@@ -0,0 +1,5 @@
+((λ (f g x)
+   (f (g x)))
+ (λ (x) (+ x 4))
+ (λ (x) (* x 2))
+ 3)

golden/exec/arith/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 22

golden/exec/begin-1/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 456

golden/exec/begin-1/source.scm

@@ -0,0 +1 @@
+(begin 123 456) ; => 456

golden/exec/callcc-constant/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 123

golden/exec/callcc-constant/source.scm

@@ -0,0 +1 @@
+(call/cc (λ (cc) (cc 123)))

golden/exec/callcc-discard/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 1234

golden/exec/callcc-discard/source.scm

@@ -0,0 +1 @@
+(call/cc (λ (_) 1234))

golden/exec/callcc-early-exit-1/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/callcc-early-exit-1/source.scm

@@ -0,0 +1,12 @@
+(letrec ((iter (λ (n f)
+                 (if (zero? n)
+                     #f
+                     (begin (f n)
+                            (iter (- n 1) f))))))
+  (call/cc
+   (λ (k)
+     (iter 10 (λ (n)
+                ;; i don't feel like implementing (= n 5) right now lmfao
+                (if (zero? (- n 5))
+                    (k #t)
+                    #f))))))

golden/exec/callcc-early-exit-2/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/callcc-early-exit-2/source.scm

@@ -0,0 +1,4 @@
+(call/cc
+ (λ (k)
+   (begin (k #t)
+          #f)))

golden/exec/callcc-early-exit-3/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/callcc-early-exit-3/source.scm

@@ -0,0 +1,5 @@
+;; confer ../callcc-early-exit-4
+(letrec ((app (λ (f x)
+                (begin (f x)
+                       #f))))
+  (call/cc (λ (k) (app k #t))))

golden/exec/callcc-early-exit-4/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/callcc-early-exit-4/source.scm

@@ -0,0 +1,5 @@
+;; confer ../callcc-early-exit-3
+(letrec ((app (λ (f x)
+                (begin (f x)
+                       #f))))
+  (call/cc (λ (k) (app (λ (x) (k x)) #t))))

golden/exec/callcc-early-exit-5/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/callcc-early-exit-5/source.scm

@@ -0,0 +1,4 @@
+(call/cc
+ (λ (k)
+   (begin ((λ () (k #t)))
+          #f)))

golden/exec/callcc-early-exit-6/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 12

golden/exec/callcc-early-exit-6/source.scm

@@ -0,0 +1,4 @@
+(* 2 (call/cc
+      (λ (k)
+        (begin (k 6)
+               3))))

golden/exec/callcc-nested-1/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 456

golden/exec/callcc-nested-1/source.scm

@@ -0,0 +1,5 @@
+(call/cc
+ (λ (k1)
+   (call/cc
+    (λ (k2)
+      (k1 456)))))

golden/exec/callcc-nested-2/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 456

golden/exec/callcc-nested-2/source.scm

@@ -0,0 +1,5 @@
+(call/cc
+ (λ (k1)
+   (call/cc
+    (λ (k2)
+      (k2 456)))))

golden/exec/complicated-1/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 155

golden/exec/complicated-1/source.scm

@@ -0,0 +1,10 @@
+(letrec ((factorial (λ (n)
+                      (if (zero? n)
+                          1
+                          (* n (factorial (- n 1)))))))
+  (letrec ((sum-of-factorials
+            (λ (n)
+              (if (zero? n)
+                  0
+                  (+ (factorial n) (sum-of-factorials (- n 1)))))))
+    (+ 2 (sum-of-factorials 5))))

golden/exec/cons-1/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > (6 . 7)

golden/exec/cons-1/source.scm

@@ -0,0 +1 @@
+(cons 6 7)

golden/exec/factorial/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 2432902008176640000

golden/exec/factorial/source.scm

@@ -0,0 +1,5 @@
+(letrec ((fac (λ (n)
+                (if (zero? n)
+                    1
+                    (* n (fac (- n 1)))))))
+  (fac 20))

golden/exec/false/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #f

golden/exec/false/source.scm

@@ -0,0 +1 @@
+#f

golden/exec/fn-of-fn/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 128

golden/exec/fn-of-fn/source.scm

@@ -0,0 +1,3 @@
+(((λ (f) f)
+  (λ (x) (* x 4)))
+ 32)

golden/exec/if-false/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 555

golden/exec/if-false/source.scm

@@ -0,0 +1 @@
+(if #false 777 555)

golden/exec/if-number/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 777

golden/exec/if-number/source.scm

@@ -0,0 +1 @@
+(if 123 777 555)

golden/exec/if-true/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 777

golden/exec/if-true/source.scm

@@ -0,0 +1 @@
+(if #true 777 555)

golden/exec/lambda/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #<procedure>

golden/exec/lambda/source.scm

@@ -0,0 +1 @@
+(λ (x) x)

golden/exec/let-fn/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 16

golden/exec/let-fn/source.scm

@@ -0,0 +1,2 @@
+(let ((square (λ (x) (* x x))))
+  (square 4))

golden/exec/letrec-fn/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 16

golden/exec/letrec-fn/source.scm

@@ -0,0 +1,2 @@
+(letrec ((square (λ (x) (* x x))))
+  (square 4))

golden/exec/square/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 25

golden/exec/square/source.scm

@@ -0,0 +1 @@
+((λ (x) (* x x)) 5)

golden/exec/true/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/true/source.scm

@@ -0,0 +1 @@
+#t

golden/print/begin-nonempty-thin

@@ -0,0 +1,4 @@
+(begin
+  책을
+  더
+  먹으세요~!)

golden/print/begin-nonempty-wide

@@ -0,0 +1,4 @@
+(begin
+  책을
+  더
+  먹으세요~!)

golden/print/lambda-thin

@@ -0,0 +1,5 @@
+(lambda
+    (어간
+     어미)
+  (display
+   꾸깃))

golden/print/lambda-wide

@@ -0,0 +1,2 @@
+(lambda (어간 어미)
+  (display 꾸깃))

golden/print/null

@@ -0,0 +1 @@
+()

golden/print/rainbow

@@ -0,0 +1 @@
+((((()))))

golden/print/simple-list-thin

@@ -0,0 +1,4 @@
+(가
+ 나
+ 다
+ 라)

golden/print/simple-list-wide

@@ -0,0 +1 @@
+(가 나 다 라)

golden/read/bool/read

@@ -0,0 +1,41 @@
+[ MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/bool/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 1
+            }
+        )
+    } :< SimpleF ( SimpleBoolean True )
+, MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/bool/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 4
+            }
+        )
+    } :< SimpleF ( SimpleBoolean True )
+, MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/bool/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 10
+            }
+        )
+    } :< SimpleF ( SimpleBoolean False )
+, MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/bool/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 13
+            }
+        )
+    } :< SimpleF ( SimpleBoolean False )
+]

golden/read/bool/source.scm

@@ -0,0 +1 @@
+#t #true #f #false

golden/read/datum-comment/source.scm

@@ -0,0 +1,4 @@
+#;(a datum comment can
+span multiple lines)
+
+(but it ends here)

golden/read/decimal/read

@@ -0,0 +1,36 @@
+[ MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/decimal/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 1
+            }
+        )
+    } :< SimpleF
+    ( SimpleNumber 45.0 )
+, MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/decimal/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 4
+            }
+        )
+    } :< SimpleF
+    ( SimpleNumber 5667.0 )
+, MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/decimal/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 10
+            }
+        )
+    } :< SimpleF
+    ( SimpleNumber
+        ( -123.0 )
+    )
+]

golden/read/decimal/source.scm

@@ -0,0 +1 @@
+45 +5667 -123

golden/read/delimited-identifier/read

@@ -0,0 +1,5 @@
+[ Fix
+    ( SimpleF
+        ( Symbol "aaaa bc" )
+    )
+]

golden/read/delimited-identifier/source.scm

@@ -0,0 +1 @@
+|aaaa bc|

golden/read/empty/read

@@ -0,0 +1 @@
+[]

golden/read/list-dot-flat/read

@@ -0,0 +1,62 @@
+[ MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/list-dot-flat/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 1
+            }
+        )
+    } :< CompoundF
+    ( DotListF
+        (
+            ( MkAnn
+                { syntax = SynNone
+                , position = Just
+                    ( SourcePos
+                        { sourceName = "golden/read/list-dot-flat/source.scm"
+                        , sourceLine = Pos 1
+                        , sourceColumn = Pos 2
+                        }
+                    )
+                } :< SimpleF
+                ( SimpleSymbol "가" )
+            ) :|
+            [ MkAnn
+                { syntax = SynNone
+                , position = Just
+                    ( SourcePos
+                        { sourceName = "golden/read/list-dot-flat/source.scm"
+                        , sourceLine = Pos 1
+                        , sourceColumn = Pos 5
+                        }
+                    )
+                } :< SimpleF
+                ( SimpleSymbol "나" )
+            , MkAnn
+                { syntax = SynNone
+                , position = Just
+                    ( SourcePos
+                        { sourceName = "golden/read/list-dot-flat/source.scm"
+                        , sourceLine = Pos 1
+                        , sourceColumn = Pos 8
+                        }
+                    )
+                } :< SimpleF
+                ( SimpleSymbol "다" )
+            ]
+        )
+        ( MkAnn
+            { syntax = SynNone
+            , position = Just
+                ( SourcePos
+                    { sourceName = "golden/read/list-dot-flat/source.scm"
+                    , sourceLine = Pos 1
+                    , sourceColumn = Pos 13
+                    }
+                )
+            } :< SimpleF
+            ( SimpleSymbol "라" )
+        )
+    )
+]

golden/read/list-dot-flat/source.scm

@@ -0,0 +1 @@
+(가 나 다 . 라)

golden/read/list-flat/read

@@ -0,0 +1,91 @@
+[ MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/list-flat/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 1
+            }
+        )
+    } :< CompoundF
+    ( ListF Ordinary
+        [ MkAnn
+            { syntax = SynNone
+            , position = Just
+                ( SourcePos
+                    { sourceName = "golden/read/list-flat/source.scm"
+                    , sourceLine = Pos 1
+                    , sourceColumn = Pos 2
+                    }
+                )
+            } :< SimpleF
+            ( SimpleSymbol "가" )
+        , MkAnn
+            { syntax = SynNone
+            , position = Just
+                ( SourcePos
+                    { sourceName = "golden/read/list-flat/source.scm"
+                    , sourceLine = Pos 1
+                    , sourceColumn = Pos 5
+                    }
+                )
+            } :< SimpleF
+            ( SimpleSymbol "나" )
+        , MkAnn
+            { syntax = SynNone
+            , position = Just
+                ( SourcePos
+                    { sourceName = "golden/read/list-flat/source.scm"
+                    , sourceLine = Pos 1
+                    , sourceColumn = Pos 8
+                    }
+                )
+            } :< SimpleF
+            ( SimpleSymbol "다" )
+        , MkAnn
+            { syntax = SynNone
+            , position = Just
+                ( SourcePos
+                    { sourceName = "golden/read/list-flat/source.scm"
+                    , sourceLine = Pos 1
+                    , sourceColumn = Pos 11
+                    }
+                )
+            } :< SimpleF
+            ( SimpleSymbol "라" )
+        , MkAnn
+            { syntax = SynNone
+            , position = Just
+                ( SourcePos
+                    { sourceName = "golden/read/list-flat/source.scm"
+                    , sourceLine = Pos 1
+                    , sourceColumn = Pos 14
+                    }
+                )
+            } :< SimpleF
+            ( SimpleNumber 1.0 )
+        , MkAnn
+            { syntax = SynNone
+            , position = Just
+                ( SourcePos
+                    { sourceName = "golden/read/list-flat/source.scm"
+                    , sourceLine = Pos 1
+                    , sourceColumn = Pos 16
+                    }
+                )
+            } :< SimpleF
+            ( SimpleNumber 2.0 )
+        , MkAnn
+            { syntax = SynNone
+            , position = Just
+                ( SourcePos
+                    { sourceName = "golden/read/list-flat/source.scm"
+                    , sourceLine = Pos 1
+                    , sourceColumn = Pos 18
+                    }
+                )
+            } :< SimpleF
+            ( SimpleNumber 3.0 )
+        ]
+    )
+]

golden/read/list-flat/source.scm

@@ -0,0 +1 @@
+(가 나 다 라 1 2 3)

golden/read/list/read

@@ -0,0 +1,148 @@
+[ MkAnn
+    { syntax = SynNone
+    , position = Just
+        ( SourcePos
+            { sourceName = "golden/read/list/source.scm"
+            , sourceLine = Pos 1
+            , sourceColumn = Pos 1
+            }
+        )
+    } :< CompoundF
+    ( DotListF
+        (
+            ( MkAnn
+                { syntax = SynNone
+                , position = Just
+                    ( SourcePos
+                        { sourceName = "golden/read/list/source.scm"
+                        , sourceLine = Pos 1
+                        , sourceColumn = Pos 2
+                        }
+                    )
+                } :< SimpleF
+                ( SimpleSymbol "a" )
+            ) :|
+            [ MkAnn
+                { syntax = SynNone
+                , position = Just
+                    ( SourcePos
+                        { sourceName = "golden/read/list/source.scm"
+                        , sourceLine = Pos 1
+                        , sourceColumn = Pos 4
+                        }
+                    )
+                } :< SimpleF
+                ( SimpleSymbol "b" )
+            , MkAnn
+                { syntax = SynNone
+                , position = Just
+                    ( SourcePos
+                        { sourceName = "golden/read/list/source.scm"
+                        , sourceLine = Pos 1
+                        , sourceColumn = Pos 6
+                        }
+                    )
+                } :< CompoundF
+                ( ListF Ordinary
+                    [ MkAnn
+                        { syntax = SynNone
+                        , position = Just
+                            ( SourcePos
+                                { sourceName = "golden/read/list/source.scm"
+                                , sourceLine = Pos 1
+                                , sourceColumn = Pos 7
+                                }
+                            )
+                        } :< SimpleF
+                        ( SimpleSymbol "c" )
+                    , MkAnn
+                        { syntax = SynNone
+                        , position = Just
+                            ( SourcePos
+                                { sourceName = "golden/read/list/source.scm"
+                                , sourceLine = Pos 1
+                                , sourceColumn = Pos 9
+                                }
+                            )
+                        } :< SimpleF
+                        ( SimpleSymbol "d" )
+                    ]
+                )
+            ]
+        )
+        ( MkAnn
+            { syntax = SynNone
+            , position = Just
+                ( SourcePos
+                    { sourceName = "golden/read/list/source.scm"
+                    , sourceLine = Pos 1
+                    , sourceColumn = Pos 14
+                    }
+                )
+            } :< CompoundF
+            ( ListF Ordinary
+                [ MkAnn
+                    { syntax = SynNone
+                    , position = Just
+                        ( SourcePos
+                            { sourceName = "golden/read/list/source.scm"
+                            , sourceLine = Pos 1
+                            , sourceColumn = Pos 15
+                            }
+                        )
+                    } :< SimpleF
+                    ( SimpleSymbol "가" )
+                , MkAnn
+                    { syntax = SynNone
+                    , position = Just
+                        ( SourcePos
+                            { sourceName = "golden/read/list/source.scm"
+                            , sourceLine = Pos 1
+                            , sourceColumn = Pos 18
+                            }
+                        )
+                    } :< CompoundF
+                    ( DotListF
+                        (
+                            ( MkAnn
+                                { syntax = SynNone
+                                , position = Just
+                                    ( SourcePos
+                                        { sourceName = "golden/read/list/source.scm"
+                                        , sourceLine = Pos 1
+                                        , sourceColumn = Pos 19
+                                        }
+                                    )
+                                } :< SimpleF
+                                ( SimpleSymbol "나" )
+                            ) :| []
+                        )
+                        ( MkAnn
+                            { syntax = SynNone
+                            , position = Just
+                                ( SourcePos
+                                    { sourceName = "golden/read/list/source.scm"
+                                    , sourceLine = Pos 1
+                                    , sourceColumn = Pos 24
+                                    }
+                                )
+                            } :< SimpleF
+                            ( SimpleSymbol "다" )
+                        )
+                    )
+                , MkAnn
+                    { syntax = SynNone
+                    , position = Just
+                        ( SourcePos
+                            { sourceName = "golden/read/list/source.scm"
+                            , sourceLine = Pos 1
+                            , sourceColumn = Pos 28
+                            }
+                        )
+                    } :< SimpleF
+                    ( SimpleSymbol "라" )
+                ]
+            )
+        )
+    )
+]