From 2f471ae4b15d9225866c8abd5de07c7a118c55de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Sun, 19 Jul 2026 04:45:59 -0600 Subject: [PATCH] idk ^w^ --- gyehoek.cabal | 57 ++++++++------- src/Gyehoek/CPS/Convert.hs | 29 +++++--- src/Gyehoek/CPS/Lower.hs | 79 ++++++++++++--------- src/Gyehoek/CPS/Syntax.hs | 120 ++++++++++++++++++++++++-------- src/Gyehoek/Scheme/Syntax.hs | 11 ++- src/Gyehoek/Sexp.hs | 19 ++++- test/Gyehoek/Test/CPS/Syntax.hs | 39 +++++++++++ test/Gyehoek/Test/Golden.hs | 2 +- test/Gyehoek/Test/Sexp.hs | 8 ++- test/Main.hs | 2 + 10 files changed, 260 insertions(+), 106 deletions(-) create mode 100644 test/Gyehoek/Test/CPS/Syntax.hs diff --git a/gyehoek.cabal b/gyehoek.cabal index e49cc2b..10b604f 100644 --- a/gyehoek.cabal +++ b/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 diff --git a/src/Gyehoek/CPS/Convert.hs b/src/Gyehoek/CPS/Convert.hs index 24d93bd..1427ac3 100644 --- a/src/Gyehoek/CPS/Convert.hs +++ b/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 = _ diff --git a/src/Gyehoek/CPS/Lower.hs b/src/Gyehoek/CPS/Lower.hs index 4d00800..0b6d2e4 100644 --- a/src/Gyehoek/CPS/Lower.hs +++ b/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'} diff --git a/src/Gyehoek/CPS/Syntax.hs b/src/Gyehoek/CPS/Syntax.hs index afc8397..aae9b8d 100644 --- a/src/Gyehoek/CPS/Syntax.hs +++ b/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 |] diff --git a/src/Gyehoek/Scheme/Syntax.hs b/src/Gyehoek/Scheme/Syntax.hs index 76cc2bc..dc4c935 100644 --- a/src/Gyehoek/Scheme/Syntax.hs +++ b/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 diff --git a/src/Gyehoek/Sexp.hs b/src/Gyehoek/Sexp.hs index 6ffc0df..aa73a49 100644 --- a/src/Gyehoek/Sexp.hs +++ b/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||] diff --git a/test/Gyehoek/Test/CPS/Syntax.hs b/test/Gyehoek/Test/CPS/Syntax.hs new file mode 100644 index 0000000..96e3816 --- /dev/null +++ b/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)|] + ] diff --git a/test/Gyehoek/Test/Golden.hs b/test/Gyehoek/Test/Golden.hs index a0f2b6d..58e1ebb 100644 --- a/test/Gyehoek/Test/Golden.hs +++ b/test/Gyehoek/Test/Golden.hs @@ -14,7 +14,7 @@ import qualified System.Process.Text as PT disabled :: List String disabled = - [ "square" + [ ] root :: IO TestTree diff --git a/test/Gyehoek/Test/Sexp.hs b/test/Gyehoek/Test/Sexp.hs index b91b639..3bacf09 100644 --- a/test/Gyehoek/Test/Sexp.hs +++ b/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 diff --git a/test/Main.hs b/test/Main.hs index bf80964..c6eff44 100644 --- a/test/Main.hs +++ b/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 ]