idk ^w^

gyehoek.cabal

@@ -25,23 +25,22 @@ common ghcstuffs
   default-extensions:
     BlockArguments
     DeriveGeneric
-    OverloadedRecordDot
+    DerivingVia
     DuplicateRecordFields
     NoFieldSelectors
+    OrPatterns
+    OverloadedLabels
+    OverloadedRecordDot
     OverloadedStrings
     PartialTypeSignatures
     PatternSynonyms
     QuasiQuotes
-    DerivingVia
-    OverloadedLabels
-    OrPatterns
 
 executable gyehoek
   import:           ghcstuffs, ghcstuffs-dev
   main-is:          Main.hs
-
   build-depends:
-    , base                  ^>=4.21.2.0
+    , base     ^>=4.21.2.0
     , gyehoek
 
   hs-source-dirs:   app
@@ -49,19 +48,19 @@ executable gyehoek
 
 library
   import:           ghcstuffs, ghcstuffs-dev
-  ghc-options: -fplugin=Effectful.Plugin
+  ghc-options:      -fplugin=Effectful.Plugin
 
   -- cabal-fmt: expand src
   exposed-modules:
     Gyehoek.CPS.Convert
     Gyehoek.CPS.Lower
     Gyehoek.CPS.Syntax
+    Gyehoek.Driver
     Gyehoek.GenSym
     Gyehoek.Options
     Gyehoek.Scheme.Syntax
     Gyehoek.Sexp
     Gyehoek.Wasm
-    Gyehoek.Driver
 
   build-depends:
     , base                  ^>=4.21.2.0
@@ -79,36 +78,40 @@ library
     , megaparsec
     , mtl
     , optparse-applicative
+    , pretty-simple
     , prettyprinter
     , process
     , recursion-schemes
     , sexp-grammar
+    , string-interpolate
     , template-haskell
     , text
     , text-short
     , unordered-containers
     , vector
-    , string-interpolate
-    , pretty-simple
 
   hs-source-dirs:   src
   default-language: GHC2024
 
 test-suite test
-    import:           ghcstuffs, ghcstuffs-dev
-    type:             exitcode-stdio-1.0
-    hs-source-dirs:   test
-    main-is:          Main.hs
-    other-modules:
-        Gyehoek.Test.Golden
-        Gyehoek.Test.Sexp
-    build-depends:    base
-                    , gyehoek
-                    , filepath
-                    , tasty
-                    , tasty-silver
-                    , tasty-hunit
-                    , directory
-                    , process-extras
-                    , sexp-grammar
-    default-language: GHC2024
+  import:           ghcstuffs, ghcstuffs-dev
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          Main.hs
+  other-modules:
+    Gyehoek.Test.CPS.Syntax
+    Gyehoek.Test.Golden
+    Gyehoek.Test.Sexp
+
+  build-depends:
+    , base
+    , directory
+    , filepath
+    , gyehoek
+    , process-extras
+    , sexp-grammar
+    , tasty
+    , tasty-hunit
+    , tasty-silver
+
+  default-language: GHC2024

src/Gyehoek/CPS/Convert.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedLists #-}
+{- HLINT ignore "Use camelCase" -}
 module Gyehoek.CPS.Convert
-  ( convert
-  , convertProgram
+  ( convertProgram
   ) where
 
 import Gyehoek.CPS.Syntax
@@ -12,6 +12,7 @@ import Effectful
 import Control.Monad.Cont qualified as Cont
 import Control.Lens
 import qualified Data.List.NonEmpty as NE
+import qualified Gyehoek.Sexp
 
 
 -- 뻘짓이어라
@@ -21,6 +22,14 @@ telescope
   -> t a -> (t b -> r) -> r
 telescope f = Cont.runCont . traverse (Cont.cont . f)
 
+
+
+pattern Atomic e <-
+  e@( Scm.ExpLambda _ _
+  ; Scm.ExpVar _
+  ; Scm.ExpLit _ )
+
+-- | Transform an expression with a meta-continuation.
 convert
   :: forall es. (GenSym :> es)
   => Scm.Exp -> (Val -> Eff es Exp) -> Eff es Exp
@@ -31,21 +40,25 @@ 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)
+    ExpPrim p' . MkKappa [r] <$> k (ValVar r)
 
 convert (Scm.ExpLambda xs e) k = do
   f <- gensym' "λ-body"
   ktail <- gensym' "λ-tail"
-  m <- convert e $ \e' ->
-    pure $ ExpContinue ktail [e']
-  ExpLet [(f, MkLambda xs ktail m)] <$> k (ValVar f)
+  m <- convert e $ \e' -> pure $ ExpContinue ktail [e']
+  ke <- k $ ValVar f
+  pure [cps|
+    (letrec ((#{f} (λ (##{xs} #{ktail}) #{m})))
+      #{ke})
+  |]
 
 convert (Scm.ExpApply f xs) k =
   telescope (convert @es) (f:|xs) \(f':|xs') -> do
-    r <- gensym' "r"
+    -- r <- gensym' "r"
     x <- gensym' "x"
     m <- k (ValVar x)
-    pure $ ExpFix [(r, MkKappa [x] m)] $ ExpApply f' (xs' ++ [ValVar r])
+    -- pure $ ExpFix [(r, MkKappa [x] m)] $ ExpApply f' (xs' ++ [ValVar r])
+    _
 
 convert (Scm.ExpBegin xs) k = _
 

src/Gyehoek/CPS/Lower.hs

@@ -23,6 +23,8 @@ import Gyehoek.Wasm qualified as Wasm
 import Gyehoek.Wasm hiding (Expr)
 import Language.Sexp.Located qualified as SL
 import Control.Monad.Fix
+import qualified Gyehoek.Sexp
+import Data.Text qualified as T
 
 
 data Env = MkEnv
@@ -70,10 +72,10 @@ popArg n = [expr|
 
 
 
-lowerVal :: Env -> Val -> Wasm.Expr
+lowerVal :: GenMod :> es => Env -> Val -> Eff es Wasm.Expr
 
 lowerVal g (ValLit l) =
-  case l of
+  pure $ case l of
     LitInt n -> [expr|
       (i32.const #{n})
       ##{makeSmallFixnum}
@@ -85,27 +87,36 @@ lowerVal g (ValLit l) =
       where b' :: Int = if b then 0b11 else 0b01
     _ -> _
 
-lowerVal g (ValVar x) = [expr|(local.get #{l})|]
+lowerVal g (ValVar x) = pure $ [expr|(local.get #{l})|]
   where
     l = succ $ V.elemIndex x g.vars ^?! _Just
 
+-- lowerVal g (ValLambda lam) = do
+--   idx <- lowerLambda g lam
+--   pure [expr|
+--     (i32.const 0)
+--     (ref.func #{idx})
+--     (struct.new $closure)
+--   |]
+
 lower' :: (GenMod :> es) => Env -> Exp -> Eff es Wasm.Expr
 
-lower' g (Halt [v]) = pure [expr|
-  ##{arg}
-  (return_call $halt (i32.const 1))
-|]
-  where arg = pushArg 0 (lowerVal g v)
+lower' g (Halt [v]) = do
+  arg <- pushArg 0 <$> lowerVal g v
+  pure [expr|
+    ##{arg}
+    (return_call $halt (i32.const 1))
+  |]
 
-lower' g (ExpPrim p [r] e) =
+lower' g (ExpPrim p k) =
   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
+    PrimAdd x y -> lowerBinOp "i32.add" g x y k
+    PrimMul x y -> lowerBinOp "i32.mul" g x y k
 
 lower' g (ExpIf c t f) = do
+  c' <- lowerVal g c
   t' <- lower' g t
   f' <- lower' g f
-  let c' = lowerVal g c
   pure [expr|
     ##{c'}
     (call $gh-truthy?)
@@ -113,7 +124,7 @@ lower' g (ExpIf c t f) = do
         (else ##{f'}))
   |]
 
-lower' g (ExpLet [(r,lam)] e) = do
+lower' g (ExpLetRec [(r,AbsLambda lam)] e) = do
   idx <- lowerLambda g lam
   let g' = g & #vars <>~ [r]
   let n = succ $ length g.vars
@@ -126,25 +137,27 @@ lower' g (ExpLet [(r,lam)] e) = do
     ##{e'}
   |]
 
-lower' g (ExpContinue k [x]) = pure . mconcat $
-  [ pushArg 0 (lowerVal g x)
-  , [expr|
-      (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 #{l})
-      i32.sub
-      (global.set $cont-stack-top)
-      (return_call_ref $cont-type)
-    |]
-  ]
+lower' g (ExpContinue k [x]) = do
+  arg <- pushArg 0 <$> lowerVal g x
+  pure [expr|
+    ##{arg}
+    (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 #{l})
+    i32.sub
+    (global.set $cont-stack-top)
+    (return_call_ref $cont-type)
+  |]
   where
     l = succ $ V.elemIndex k g.kvars ^?! _Just
 
-lower' g e = error . show $ e
+lower' g e = error $ case Gyehoek.Sexp.encode e of
+  Left _ -> show e
+  Right x -> T.unpack x
 
 lowerLambda :: GenMod :> es => Env -> Lambda -> Eff es Idx
 lowerLambda g (MkLambda xs ktail m) = do
@@ -167,13 +180,13 @@ lowerLambda g (MkLambda xs ktail m) = do
 
 lowerBinOp
   :: (GenMod :> es)
-  => Text -> Env -> Val -> Val -> Name -> Exp -> Eff es Wasm.Expr
-lowerBinOp op g x y r e = do
+  => Text -> Env -> Val -> Val -> Kappa -> Eff es Wasm.Expr
+lowerBinOp op g x y (MkKappa [r] e) = do
   let op' = SL.Symbol op
   let g' = g & #vars <>~ [r]
   let n = succ $ length (g ^. #vars)
-  let x' = lowerVal g x
-  let y' = lowerVal g y
+  x' <- lowerVal g x
+  y' <- lowerVal g y
   e' <- lower' g' e
   pure [expr|
     ##{x'}

src/Gyehoek/CPS/Syntax.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
 module Gyehoek.CPS.Syntax
   ( Val(..)
   , Kappa(..)
@@ -15,8 +16,12 @@ module Gyehoek.CPS.Syntax
   , pattern Halt1
   , _MkKappa
   , _ExpPrim
-  , _ExpFix
+  , _ExpLetRec
   , _ExpApply
+  , cps
+  , pattern AbsLambda'
+  , pattern AbsKappa'
+  , Abs(..)
   )
   where
 
@@ -27,46 +32,62 @@ import Data.List (List)
 import GHC.Generics (Generic)
 import Language.SexpGrammar.Generic
 import Control.Category
-import Control.Lens
+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 (:-)((:-)))
 
 -- Data types
 
 data Val
-  = ValLabel Name
-  | ValVar Name
+  = ValVar Name
   | ValLit Lit
-  deriving (Show, Generic)
+  deriving (Show, Generic, Data, Eq)
 
 data Kappa = MkKappa (List Name) Exp
-  deriving (Show, Generic)
+  deriving (Show, Generic, Data, Eq)
 
 data Lambda = MkLambda (List Name) Name Exp
-  deriving (Show, Generic)
+  deriving (Show, Generic, Data, Eq)
+
+data Abs
+  = AbsKappa Kappa
+  | AbsLambda Lambda
+  deriving (Show, Generic, Data, Eq)
+
+pattern AbsKappa' xs e = AbsKappa (MkKappa xs e)
+pattern AbsLambda' xs e ktail = AbsLambda (MkLambda xs e ktail)
 
 data Exp
-  = ExpPrim (Prim Val) (List Name) Exp
-  | ExpFix (NonEmpty (Name, Kappa)) Exp
-  | ExpLet (NonEmpty (Name, Lambda)) Exp
+  = ExpPrim (Prim Val) Kappa
+  | ExpLetRec (NonEmpty (Name, Abs)) Exp
   | ExpContinue Name (List Val)
   | ExpIf Val Exp Exp
-  | ExpApply Val (List Val)
-  deriving (Show, Generic)
+  | ExpApply
+    { op :: Val
+    , args :: List Val
+    , cont :: Name
+    }
+  deriving (Show, Generic, Data, Eq)
 
 pattern Halt :: List Val -> Exp
-pattern Halt xs = ExpApply (ValVar "halt") xs
+pattern Halt xs = ExpContinue "halt" xs
 
 pattern Halt1 :: Val -> Exp
-pattern Halt1 x = ExpApply (ValVar "halt") [x]
+pattern Halt1 x = ExpContinue "halt" [x]
 
 data Def = DefConstant Name Exp
-  deriving (Show, Generic)
+  deriving (Show, Generic, Data)
 
 data Program = MkProgram
   { body :: Exp
   }
-  deriving (Show, Generic)
+  deriving (Show, Generic, Data)
 
 makePrisms ''Kappa
 makePrisms ''Exp
@@ -76,13 +97,10 @@ makePrisms ''Exp
 
 instance S.SexpIso Val where
   sexpIso = match
-    $ With (. label)
-    $ With (. var)
-    $ With (. S.sexpIso)
+    --  $ With (. label)
+    $ With (\var -> var . S.sexpIso)
+    $ With (\lit -> lit . S.sexpIso)
     $ End
-    where
-      label = S.keyword >>> S.iso MkName getName
-      var = S.sexpIso
 
 instance S.SexpIso Lambda where
   sexpIso = match
@@ -91,9 +109,18 @@ instance S.SexpIso Lambda where
     where
       lambda = S.list $
         S.el Gyehoek.Sexp.lambdaKeyword
-        >>> S.el (S.list (S.rest S.sexpIso))
-        >>> S.el S.sexpIso
+        >>> S.el binders
         >>> S.el S.sexpIso
+      binders :: forall t.
+        IG.Grammar S.Position (Sexp :- t) (Name :- List Name :- t)
+      binders = S.list $
+        S.rest (S.sexpIso @Name)
+        >>> S.onTail (S.flipped $ IG.PartialIso
+                     (\(ktail:-args:-t) -> (args ++ [ktail]) :- t)
+                     (\(args:-t) -> case args ^? _Snoc of
+                         Just (args',ktail) -> Right $ ktail :- args' :- t
+                         Nothing -> Left $ S.expected "cont param")
+                     )
 
 instance S.SexpIso Kappa where
   sexpIso = match
@@ -105,11 +132,16 @@ instance S.SexpIso Kappa where
         >>> S.el (S.list $ S.rest S.sexpIso)
         >>> S.el S.sexpIso
 
+instance S.SexpIso Abs where
+  sexpIso = match
+    $ With (\lambda -> lambda . S.sexpIso)
+    $ With (\kappa -> kappa . S.sexpIso)
+    $ End
+
 instance S.SexpIso Exp where
   sexpIso = match
     $ With (. prim)
-    $ With (. fix)
-    $ With (. let_)
+    $ With (. letrec)
     $ With (. continue)
     $ With (. if_)
     $ With (. app)
@@ -119,16 +151,44 @@ instance S.SexpIso Exp where
         S.el (S.sym "continue")
         >>> S.el S.sexpIso
         >>> S.rest S.sexpIso
-      fix = Gyehoek.Sexp.let_ "fix" S.sexpIso S.sexpIso S.sexpIso
-      let_ = Gyehoek.Sexp.let_ "let" S.sexpIso S.sexpIso S.sexpIso
+      letrec = Gyehoek.Sexp.let_ "letrec" S.sexpIso S.sexpIso S.sexpIso
       if_ = S.list $ S.el (S.sym "if")
         >>> S.el S.sexpIso >>> S.el S.sexpIso >>> S.el S.sexpIso
-      app = S.list $ S.el S.sexpIso >>> S.rest S.sexpIso
+      app :: forall t.
+        IG.Grammar S.Position (Sexp :- t) (Name :- ([Val] :- (Val :- t)))
+      app = S.list $ S.el (S.sexpIso @Val)
+        -- >>> S.flipped Gyehoek.Sexp.nonEmptyGrammar
+        >>> S.rest (S.sexpIso @Val)
+        -- >>> _
+        >>> S.onTail (S.flipped $ IG.PartialIso
+                      (\(karg :- args :- op :- t) ->
+                         (args ++ [ValVar karg]) :- op :- t)
+                      (\(xs :- op :- t) -> case xs ^? _Snoc of
+                          Just (args,preview #ValVar -> Just karg) ->
+                            Right $ karg:- args :- op :- t
+                          _ -> Left $ S.expected "continuation arg"
+                      ))
+        where
+          _ = S.flipped $ Gyehoek.Sexp.nonEmptyGrammar @S.Position @Val
       prim = S.list $
         S.el (S.sym "prim")
         >>> S.el (primSexpIso id (S.sexpIso @Val))
         >>> S.el S.sexpIso
-        >>> S.el S.sexpIso
 
 instance S.SexpIso Program where
   sexpIso = with \prog -> S.sexpIso @Exp >>> prog
+
+
+-- quasiquoters
+
+class Data a => CPS a where
+  toCPS :: Sexp -> a
+
+instance CPS Exp where toCPS = Gyehoek.Sexp.fromSexp
+instance CPS Val where toCPS = Gyehoek.Sexp.fromSexp
+instance CPS Kappa where toCPS = Gyehoek.Sexp.fromSexp
+instance CPS Lambda where toCPS = Gyehoek.Sexp.fromSexp
+instance CPS Abs where toCPS = Gyehoek.Sexp.fromSexp
+
+cps :: QuasiQuoter
+cps = Gyehoek.Sexp.makeSx' [| toCPS |]

src/Gyehoek/Scheme/Syntax.hs

@@ -22,6 +22,7 @@ module Gyehoek.Scheme.Syntax
   , free
   , subst
   , getName
+  , scm
   )
   where
 
@@ -47,6 +48,7 @@ import Data.Functor.Foldable hiding (fold)
 import Data.HashSet (HashSet)
 import qualified Data.HashSet as HS
 import Data.Foldable (fold)
+import Language.Haskell.TH.Quote (QuasiQuoter)
 
 
 newtype Name = MkName { inner :: Text }
@@ -70,7 +72,7 @@ data Prim e
   | PrimWrite e
   | PrimZeroP e
   | PrimNewline
-  deriving (Show, Generic, Functor, Foldable, Traversable, Data)
+  deriving (Show, Generic, Functor, Foldable, Traversable, Data, Eq)
 
 instance Each (Prim e) (Prim e') e e'
 
@@ -80,7 +82,7 @@ data Lit
   | LitBool Bool
   | LitString Text
   | LitQuote Sexp
-  deriving (Show, Generic, Data)
+  deriving (Show, Generic, Data, Eq)
 
 pattern Void :: Lit
 pattern Void = LitNil
@@ -105,7 +107,7 @@ data Sexp
   = SexpCons Sexp Sexp
   | SexpSymbol Text
   | SexpLit Lit
-  deriving (Show, Generic, Data)
+  deriving (Show, Generic, Data, Eq)
 
 data CommandOrDef
   = Command Exp
@@ -228,6 +230,9 @@ instance SexpIso CommandOrDef where
 
 -- utilities
 
+scm :: QuasiQuoter
+scm = Gyehoek.Sexp.makeSx [|| Gyehoek.Sexp.fromSexp @Exp ||]
+
 free :: Exp -> HashSet Name
 free = cata \case
   ExpVarF x -> HS.singleton x

src/Gyehoek/Sexp.hs

@@ -35,11 +35,13 @@ module Gyehoek.Sexp
   , sxs
   , makeSx
   , makeSxs
+  , makeSx'
   , toSexp
   , fromSexp
   , stripLocation
   , format
   , equivalent
+  , encodeOrShow
   )
   where
 
@@ -84,6 +86,7 @@ import Debug.Pretty.Simple
 import qualified Data.Vector as V
 import qualified Data.Vector.Strict
 import Data.Function (on)
+import Data.String (IsString (fromString))
 
 
 sexp :: SexpIso a => Iso' a Text
@@ -385,6 +388,11 @@ deriving instance Lift SL.Atom
 deriving instance Lift SL.Position
 deriving instance Lift SL.Prefix
 
+encodeOrShow :: (SexpIso a, Show a, IsString s) => a -> s
+encodeOrShow a = fromString case encode a of
+  Left _ -> show a
+  Right e -> T.unpack e
+
 extQ :: (Typeable a, Typeable b) => (a -> r) -> (b -> r) -> a -> r
 extQ f g a = maybe (f a) g (cast a)
 
@@ -404,13 +412,15 @@ makeSxs f = QuasiQuoter
   , quoteDec = undefined
   }
 
-makeSx :: Data r => Code Q (Sexp -> r) -> QuasiQuoter
-makeSx f = QuasiQuoter
+-- | An untyped variant of 'makeSx', useful when the user function is
+-- polymorphic in its return value.
+makeSx' :: ExpQ -> QuasiQuoter
+makeSx' f = QuasiQuoter
   { quoteExp = \str -> do
       pos <- getPos
       case readSexpWithPos pos (T.pack str) of
         Left e -> fail e
-        Right x -> [| $(unTypeCode f) $e |]
+        Right x -> [| $f $e |]
           where
             e = dataToExpQ
               (const Nothing `extQ` metaSexp `extQ` metaSexps)
@@ -420,5 +430,8 @@ makeSx f = QuasiQuoter
   , quoteDec = undefined
   }
 
+makeSx :: Data r => Code Q (Sexp -> r) -> QuasiQuoter
+makeSx = makeSx' . unTypeCode
+
 sxs = makeSxs [||id||]
 sx = makeSx [||id||]

test/Gyehoek/Test/CPS/Syntax.hs

@@ -0,0 +1,39 @@
+module Gyehoek.Test.CPS.Syntax (root) where
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit
+import Language.Sexp.Located qualified as SL
+import Language.SexpGrammar ()
+import Gyehoek.CPS.Syntax (cps)
+import Gyehoek.CPS.Syntax qualified as Sut
+import Data.Function (on)
+import Gyehoek.Test.Sexp (equivto)
+
+
+root :: IO TestTree
+root = pure . testGroup "cps syntax" $
+  [ qqTree
+  ]
+
+qqTree :: TestTree
+qqTree = testGroup "parser"
+  [ testCase "lambda" do
+      assertEqual "" (Sut.MkLambda ["x","y"] "ktail"
+               (Sut.ExpContinue "ktail" [Sut.ValVar "x"]))
+        [cps|(λ (x y ktail) (continue ktail x))|]
+      assertEqual "" (Sut.MkLambda [] "ktail"
+               (Sut.ExpContinue "ktail" [Sut.ValVar "x"]))
+        [cps|(λ (ktail) (continue ktail x))|]
+  , testCase "kappa" do
+      assertEqual "" (Sut.MkKappa ["x","y"]
+               (Sut.ExpContinue "k123" [Sut.ValVar "x", Sut.ValVar "y"]))
+        [cps|(κ (x y) (continue k123 x y))|]
+  , testCase "application" do
+      assertEqual "" (Sut.ExpApply (Sut.ValVar "f")
+                     [Sut.ValVar "x",Sut.ValVar "y"]
+                     "k")
+        [cps|(f x y k)|]
+      assertEqual "" (Sut.ExpApply (Sut.ValVar "f")
+                     [] "k")
+        [cps|(f k)|]
+  ]

test/Gyehoek/Test/Golden.hs

@@ -14,7 +14,7 @@ import qualified System.Process.Text as PT
 
 disabled :: List String
 disabled =
-  [ "square"
+  [
   ]
 
 root :: IO TestTree

test/Gyehoek/Test/Sexp.hs

@@ -1,4 +1,10 @@
-module Gyehoek.Test.Sexp (root) where
+module Gyehoek.Test.Sexp
+  ( root
+  , EquivSexp(..)
+  , assertEquiv
+  , equivto
+  )
+  where
 
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit

test/Main.hs

@@ -4,6 +4,7 @@ import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.Silver.Interactive (defaultMain)
 import qualified Gyehoek.Test.Golden
 import qualified Gyehoek.Test.Sexp
+import qualified Gyehoek.Test.CPS.Syntax
 
 
 main :: IO ()
@@ -13,5 +14,6 @@ root :: IO TestTree
 root = testGroup "test" <$> sequenceA
   [ Gyehoek.Test.Golden.root
   , Gyehoek.Test.Sexp.root
+  , Gyehoek.Test.CPS.Syntax.root
   ]