cleanup

test/Gyehoek/Test/CPS/Eval.hs

@@ -58,7 +58,7 @@ test_eval = do
       <&> fmap ("golden/exec" </>)
   pure $ testGroup "cps interpreter"
     [ testGroup "higher-order" $ cpsCase Driver.eval_cps2_e2e <$> cs
-    -- , testGroup "first-order" $ cpsCase Driver.eval_cps_e2e <$> cs
+    -- , testGroup "first-order" $ cpsCase Driver.eval_cps1_e2e <$> cs
     ]
 
 maybeBroken name broken = applyWhen (name `elem` broken) expectFail

test/Gyehoek/Test/CPS/Stackify.hs

@@ -1,96 +0,0 @@
-module Gyehoek.Test.CPS.Stackify where
-
-import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.HUnit
-import qualified Gyehoek.CPS.Stackify as Sut
-import Gyehoek.Stack.VM as Stk
-import Gyehoek.CPS.Syntax (cps)
-import Gyehoek.CPS.Syntax qualified as CPS
-import Gyehoek.GenSym (runGenSym)
-import Effectful
-import Gyehoek.Prelude
-import Gyehoek.Jalmot
-import Test.Tasty.ExpectedFailure (expectFail, ignoreTestBecause)
-
-
--- test_stackify =
---   [ trivialReturn
---   , tailCall
---   , prim
---   , condition
---   , procedure
---   ]
-
--- evalsTo :: HasCallStack => List Obj -> Sut.Program -> Assertion
--- evalsTo rs e = runJalmotUnsafe (Stk.eval e') @?= rs
---   where
---     e' = e & Sut.stackifyProgram & runGenSym & runPureEff
-
--- trivialReturn = testGroup "trivial return"
---   [ testCase "return int" do
---       evalsTo [ObjImm (ImmInt 4)]
---         [cps|(λ (ktail) (continue ktail 4))|]
---   , testCase "return bool" do
---       evalsTo [ObjImm (ImmBool True)]
---         [cps|(λ (ktail) (continue ktail #t))|]
---       evalsTo [ObjImm (ImmBool False)]
---         [cps|(λ (ktail) (continue ktail #f))|]
---   ]
-
--- tailCall = testGroup "tail call"
---   [ testCase "square" do
---       evalsTo [ObjImm (ImmInt 16)] [cps|
---         (λ (ktail0)
---           (letrec ((square (λ (x ktail)
---                              (prim (* x x)
---                                (κ (x0) (continue ktail x0))))))
---             (square 4 halt)))
---       |]
---   ]
-
--- prim = testGroup "prim"
---   [ testCase "multiply" do
---       evalsTo [ObjImm (ImmInt 20)]
---         [cps|(λ (ktail0)
---             (prim (* 4 5)
---                (κ (x) (continue ktail0 x))))|]
---   , testCase "add" do
---       evalsTo [ObjImm (ImmInt 9)]
---         [cps|(λ (ktail0)
---         (prim (+ 4 5)
---                (κ (x) (continue ktail0 x))))|]
---   -- , testGroup "call/cc"
---   --   [ testCase "trivial" do
---   --       evalsTo [ObjImm (ImmInt 123)]
---   --         [cps|(letrec ((f (λ (cc ktail) (continue cc 123))))
---   --                (prim (call/cc f)))|]
---   --   ]
---   ]
-
--- condition = testCase "if" do
---   evalsTo [ObjImm (ImmInt 123)]
---     [cps|(λ (ktail0)
---       (if #t (continue ktail0 123) (continue ktail0 456)))|]
---   evalsTo [ObjImm (ImmInt 456)]
---     [cps|(λ (ktail0)
---       (if #f (continue ktail0 123) (continue ktail0 456)))|]
-
--- procedure = testGroup "procedure"
---   [ testCase "factorial" do
---       evalsTo [ObjImm (ImmInt 720)]
---         [cps|(λ (ktail0)
---           (letrec ((fac (λ (n ktail)
---                              (prim (zero? n)
---                                (κ (x0)
---                                  (if x0
---                                    (continue ktail 1)
---                                    (prim (- n 1)
---                                      (κ (x1)
---                                        (letrec ((fac-k0
---                                                   (κ (x2)
---                                                     (prim (* n x2)
---                                                       (κ (x3)
---                                                         (continue ktail x3))))))
---                                          (fac x1 fac-k0))))))))))
---                (fac 6 halt)))|]
---   ]

test/Gyehoek/Test/Golden.hs

@@ -1,85 +0,0 @@
-module Gyehoek.Test.Golden where
-
-import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.Silver
-import Gyehoek.Driver qualified as Driver
-import System.FilePath
-import Data.List (List)
-import Data.Functor ((<&>))
-import System.Directory
-import Data.Function
-import System.Environment.Blank (getEnvDefault)
-import qualified System.Process.Text as PT
-import Control.Exception (SomeException (SomeException), Exception (..), catch)
-import Gyehoek.Stack.VM (writeObj)
-import Data.Text qualified as T
-import System.Exit (ExitCode(..))
-import Test.Tasty.ExpectedFailure (expectFail, ignoreTestBecause)
-import Control.DeepSeq (($!!))
-import Text.Pretty.Simple (pShow, pShowNoColor)
-import Control.Lens (strict, view)
-import Gyehoek.Sexp.Read qualified as Read
-import Effectful
-
-
-brokenWasmTests :: List String
-brokenWasmTests =
-  [
-  ]
-
-brokenStackifyTests :: List String
-brokenStackifyTests =
-  [
-  ]
-
-test_root :: IO TestTree
-test_root = do
-  all_cases <- listDirectory "golden/exec"
-  let tests = all_cases
-            & fmap ("golden/exec"</>)
-  testGroup "execution" <$> sequenceA
-    [ ignoreTestBecause "wasm codegen is on the backburner"
-      <$> wasmTests tests
-    , ignoreTestBecause "i'm killing myself"
-      <$> stackifyTests tests
-    ]
-
-maybeBroken name broken = applyWhen (name `elem` broken) expectFail
-
-wasmTests :: List FilePath -> IO TestTree
-wasmTests files = do
-  cmd <- getEnvDefault "GYEHOEK_WASM_RUNTIME"
-    "runtime/target/debug/gyehoek-wasm-runtime"
-  pure $ testGroup "wasm" $ files <&> \test ->
-    let testname = takeFileName test
-        scmfile = test </> "source.scm"
-        resultfile = test </> "exec"
-        action = do
-          t <- Driver.lower_e2e scmfile
-          PT.readProcessWithExitCode cmd ["-"] t
-    in maybeBroken testname brokenWasmTests $
-      goldenVsAction
-       testname
-       resultfile
-       action
-       printProcResult
-
-stackifyTests :: List FilePath -> IO TestTree
-stackifyTests files = do
-  pure $ testGroup "stackified" $ files <&> \test ->
-    let testname = takeFileName test
-        scmfile = test </> "source.scm"
-        resultfile = test </> "exec"
-        action =
-          catch @SomeException
-            (do rs <- Driver.eval_e2e scmfile
-                pure $!! ( ExitSuccess
-                     , T.unwords . fmap writeObj $ rs
-                     , "" ))
-            \e -> pure (ExitFailure 1, "", T.pack $ displayException e)
-    in maybeBroken testname brokenStackifyTests $
-     goldenVsAction
-       testname
-       resultfile
-       action
-       printProcResult

test/Gyehoek/Test/Stack/VM.hs

@@ -1,112 +0,0 @@
-{-# LANGUAGE OverloadedLists #-}
-module Gyehoek.Test.Stack.VM where
-
-import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.HUnit
-import Gyehoek.Stack.Syntax
-import Gyehoek.Stack.VM qualified as Sut
-import Data.List (List)
-import Gyehoek.Jalmot
-import Gyehoek.Prelude (i)
-import Test.Tasty.ExpectedFailure (expectFail, ignoreTestBecause)
-
-
-evalsTo :: List Obj -> Program -> Assertion
-evalsTo rs p = runJalmotUnsafe (Sut.eval p) @?= rs
-
-test_root = ignoreTestBecause "i'm super-killing myself" $ testGroup "stack machine"
-  [ testCase "immediate halt" do
-      evalsTo [] [stkP|
-        (define $start
-          (return 0))
-      |]
-  , testCase "lit int" do
-      evalsTo [ObjImm (ImmInt 3)] [stkP|
-        (define $start
-          (push! 3)
-          (return 1))
-      |]
-  , testCase "non-tail identity function" do
-      evalsTo [ObjImm (ImmInt 123)] [stkP|
-        (define $id
-          (return 1))
-        (define $c
-          (return 1))
-        (define $start
-          (push! $c)
-          (push! $id)
-          (push! 123)
-          (call 1))
-      |]
-  , testCase "tail identity function" do
-      evalsTo [ObjImm (ImmInt 123)] [stkP|
-        (define $id
-          (return 1))
-        (define $start
-          (push! $id)
-          (push! 123)
-          (tail-call 1))
-      |]
-  , testCase "return constant" do
-      evalsTo [ObjImm (ImmInt 123)] [stkP|
-        (define $start
-          (push! $silly)
-          (tail-call 1))
-        (define $silly
-          (push! 123)
-          (return 1))
-      |]
-  , testCase "return multiple" do
-      evalsTo [ObjImm (ImmInt n) | n <- [1,2,3]] [stkP|
-        (define $start
-          (push! 3)
-          (push! 2)
-          (push! 1)
-          (return 3))
-      |]
-  , testCase "return none" do
-      evalsTo [] [stkP|
-        (define $start
-          (return 0))
-      |]
-  , testCase "square" do
-      evalsTo [ObjImm (ImmInt 16)] [stkP|
-        (define $start
-          (push! $square)
-          (push! 4)
-          (tail-call 1))
-        (define $square
-          (pop! %x)
-          (prim (* %x %x))
-          (return 1))
-      |]
-  , testGroup "factorial"
-      let
-        hsfac (n :: Int) = foldr @List (*) 1 [1..n]
-        fac (n :: Int) = [stkP|
-          (define $start
-            (push! $fac)
-            (push! #{n})
-            (tail-call 1))
-          (define $fac
-            (load %n 0)
-            (prim (zero? %n))
-            (pop! %x0)
-            (if %x0
-                (then (push! 1)
-                      (return 1))
-                (else (push! $fac-c0)
-                      (push! $fac)
-                      (prim (- %n 1))
-                      (call 1))))
-          (define $fac-c0
-            (pop! %x2)
-            (pop! %n)
-            (prim (* %n %x2))
-            (return 1))
-      |]
-        mkcase n = testCase [i|#{n}|] do
-          evalsTo [ObjImm . ImmInt $ hsfac n] $ fac n
-      -- 20 is the greatest `n` for which n! ≤ maxBount @Int
-      in [ mkcase n | n <- [0,1,6,20] ]
-  ]