ughhh evaluate cps

golden/exec/lit-int/exec

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

golden/exec/lit-int/source.scm

@@ -0,0 +1 @@
+123

src/Gyehoek/CPS/Eval.hs

@@ -1,33 +1,147 @@
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DeriveAnyClass #-}
 module Gyehoek.CPS.Eval
   ( evalProgram
   , module Gyehoek.CPS.Syntax
   , evalExp
   ) where
 
-import Gyehoek.CPS.Syntax
+import Gyehoek.CPS.Syntax hiding (Hob(..), Obj(..))
 import Control.Lens
 import Data.Maybe (fromMaybe)
 import Text.Show.Functions ()
 import qualified Data.HashMap.Strict as H
 import Gyehoek.Prelude
 import Debug.Pretty.Simple
+import Gyehoek.Jalmot
+import Control.Monad.Cont qualified as Cont
+import Gyehoek.Sexp qualified as S
+import GHC.Generics (Generically(..))
+import Gyehoek.Sexp ((:-)(..))
 
 
 data Env = MkEnv
-  { vars :: HashMap Name Obj
+  { store :: HashMap Name Obj
-  , labels :: HashMap Name (Env, Abs)
   }
-  deriving (Show, Generic)
+  deriving stock (Show, Generic, Data, Eq)
+  deriving (Semigroup, Monoid)
+    via Generically Env
 
-eval :: Env -> Exp -> List Obj
+emptyEnv = MkEnv
-eval = _
+  { store = mempty
+  }
 
-evalExp :: Exp -> List Obj
+
-evalExp = _
 
-evalProgram :: Program -> List Obj
+data Obj
-evalProgram (MkProgram lam) = eval emptyEnv [cps|
+  = ObjImm Imm
+  | ObjHob Hob
+  deriving stock (Show, Generic, Data, Eq)
+
+-- | a heap object.
+data Hob
+  = HobClosure { code :: Abs, env :: Env}
+  -- should a continuation have a label, or an Obj?
+  | HobPair Obj Obj
+  deriving stock (Show, Generic, Data, Eq)
+
+instance S.DatumIso Obj where
+  datumIso = S.match
+    $ S.With (S.datumIso @Imm >>>)
+    $ S.With (S.datumIso @Hob >>>)
+    $ S.End
+
+instance S.DatumIso Hob where
+  datumIso = S.match
+    $ S.With (closure >>>)
+    $ S.With (conspair >>>)
+    $ S.End
+    where
+      conspair = S.dottedList (S.el S.datumIso) S.datumIso
+      -- closures can be printed, but not parsed.
+      closure :: S.G (S.Datum :- t) (Env :- Abs :- t)
+      closure = S.Flip $ S.PartialIso
+        (\(_:-_:-t) -> S.Unreadable [i|\#<procedure>|] :- t)
+        (const . Left $ mempty)
+
+
+
+err :: Jalmot :> es => Text -> Eff es a
+err = throwError . VMError
+
+eval1 :: Jalmot :> es => Env -> Exp -> Eff es Obj
+eval1 g e = eval g e >>= \case
+  [r] -> pure r
+  rs -> err [i|expected one value, but got #{rs}|]
+
+pure1 :: Applicative f => a -> f (List a)
+pure1 = pure . (:[])
+
+eval
+  :: Jalmot :> es
+  => Env -> Exp
+  -> Eff es (List Obj)
+
+eval g (ExpLetRec bs e) = eval g' e
+  where
+    g' = g <> foldMap
+      (\(f,ab) -> mempty & #store . at f ?~
+        ObjHob (HobClosure ab g'))
+      bs
+
+eval g (Halt rs) = traverse (evalVal g) rs
+
+eval g (ExpContinue k xs) = evalVal g k >>= \case
+  ObjImm (ImmLabel "halt") -> traverse (evalVal g) xs
+
+eval g (ExpApply f xs ktail) = do
+  f' <- evalVal g f
+  xs' <- traverse (evalVal g) xs
+  ktail' <- evalKexp g ktail
+  case f' of
+    ObjHob (HobClosure {code,env}) -> eval env' e
+      where
+        MkAbs bxs bktail e = code
+        env' = env
+          & #store <>~ H.fromList (zip bxs xs')
+          & maybe id (\b -> #store . at b ?~ ktail') bktail
+
+eval g e = err [i|unimplemented exp: #{S.encodeOrShow' @Text S.datumIso e}|]
+
+evalKexp :: Jalmot :> es => Env -> Kexp -> Eff es Obj
+evalKexp g = \case
+  KexpVar x -> var g x
+  KexpKappa kap -> _
+
+evalVal
+  :: Jalmot :> es
+  => Env -> Val
+  -> Eff es Obj
+evalVal g (ValImm imm) = pure $ ObjImm imm
+evalVal g (ValVar x) = var g x
+
+var :: Jalmot :> es => Env -> Name -> Eff es Obj
+var _ "halt" = pure . ObjImm . ImmLabel $ "halt"
+var g x = case g ^. #store . at x of
+  Just o -> pure o
+  Nothing -> err [i|unbound var #{x}|]
+
+evalExp :: Jalmot :> es => Exp -> Eff es (List Obj)
+evalExp e = eval emptyEnv e
+
+evalProgram :: Jalmot :> es => Program -> Eff es (List Obj)
+evalProgram (MkProgram lam) = evalExp [cps|
   (letrec ((start #{lam}))
     (start halt))
 |]
+
+p :: Program
+p = [cps|
+  (λ (ktail)
+    (continue ktail 123))
+|]
+
+e1 :: Exp
+e1 = [cps|
+  (continue $halt 123)
+|]

src/Gyehoek/CPS/Syntax.hs

@@ -44,6 +44,7 @@ module Gyehoek.CPS.Syntax
   , absBody
   , pattern MkAbs
   , _MkAbs
+  , unhoist
   )
   where
 
@@ -64,6 +65,7 @@ import Data.String (IsString)
 import Control.Applicative
 import qualified Data.HashMap.Strict as H
 import GHC.Records (HasField (..))
+import Data.Bifunctor
 
 -- Data types
 
@@ -139,8 +141,8 @@ _MkAbs = iso
     Nothing -> AbsKappa' xs e)
 
 pattern MkAbs :: List Name -> Maybe Name -> Exp -> Abs
-pattern MkAbs xs ktail body <- (view _Abs' -> (xs,ktail,body))
+pattern MkAbs xs ktail body <- (view _MkAbs -> (xs,ktail,body))
-  where MkAbs xs ktail body = review _Abs' (xs,ktail,body)
+  where MkAbs xs ktail body = review _MkAbs (xs,ktail,body)
 
 {-# COMPLETE MkAbs #-}
 
@@ -223,6 +225,12 @@ absBody = lens
     (AbsLambda lam) b -> AbsLambda $ lam & #body .~ b
     (AbsKappa kap) b -> AbsKappa $ kap & #body .~ b)
 
+unhoist :: HoistedProgram -> Program
+unhoist p =
+  MkProgram $ p.body & body %~ ExpLetRec
+    (p ^.. #bindings . itraversed . withIndex
+      . to (\(MkLabel l, ab) -> (l,ab)))
+
 
 -- DatumIso instances
 

src/Gyehoek/Driver.hs

@@ -1,5 +1,5 @@
 module Gyehoek.Driver
-  (main, lower_e2e, convert_e2e, parse_e2e, readScm, eval_e2e)
+  (main, lower_e2e, convert_e2e, parse_e2e, readScm, eval_e2e, eval_cps_e2e)
   where
 
 import Gyehoek.Options
@@ -120,13 +120,13 @@ driver opts = do
     hPutStrLn FS.stdout . view strict . pShowNoColor $ scm
   cps <- convertProgram scm
   when opts.dumpCPS do
-     hPutStrLn FS.stdout =<< S.encodeWith S.datumIso cps
+     S.writeDatum cps
   closedCps <- closeProgram cps
   when opts.dumpClosed do
-    hPutStrLn FS.stdout =<< S.encodeWith S.datumIso closedCps
+    S.writeData closedCps
   hoistedCps <- hoistProgram closedCps
   when opts.dumpHoisted do
-    hPutStrLn FS.stdout =<< S.encodeWith S.datumIso hoistedCps
+    S.writeData hoistedCps
   -- contifiedCps <- contifyProgram hoistedCps
   -- when opts.dumpContified do
   --   hPutStrLn FS.stdout =<< S.encodeWith S.datumIso contifiedCps
@@ -138,10 +138,8 @@ driver opts = do
          >>> T.unwords
          >>> hPutStrLn FS.stdout)
   when (rt_is #CPS) do
-    closedCps
+    CPS.evalProgram closedCps
-      & CPS.evalProgram
+      >>= S.writeData
-      & S.encodeDataWith S.dataIso
-      & hPutStrLn FS.stdout
   -- dumpOrRun opts.inspectWasm (rt_is #Wasm)
   --   (lowerProgram cps)
   --   inspectWasm
@@ -165,3 +163,11 @@ eval_e2e :: FilePath -> IO (List Obj)
 eval_e2e fp = runJalmotIO . runFileSystem . runGenSym $ do
   stk <- stackifyProgram <=< closeProgram <=< convertProgram <=< readScm $ fp
   eval stk
+
+eval_cps_e2e :: FilePath -> IO Text
+eval_cps_e2e fp = runJalmotIO . runFileSystem . runGenSym $
+  readScm fp
+   >>= convertProgram
+   -- >>= closeProgram
+   >>= CPS.evalProgram
+   >>= pure . S.encodeOrShowData' S.dataIso

src/Gyehoek/Options.hs

@@ -32,6 +32,7 @@ data Options = MkOptions
   , dumpHoisted :: Bool
   , dumpContified :: Bool
   , traceStackified :: Bool
+  , noColour :: Bool
   , runtime :: Maybe Runtime
   , inspectWasm :: Bool
   , output :: FilePath
@@ -66,6 +67,10 @@ parser = do
   dumpHoisted <- switch (long "dump-hoisted")
   dumpContified <- switch (long "dump-contified")
   traceStackified <- switch (long "trace-stackified")
+  noColour <- switch . fold $
+    [ long "no-colour"
+    , long "no-color"
+    ]
   inspectWasm <- switch $ long "inspect-wasm" <> short 'p'
   runtime <- option runtimeReader . fold $
     [ long "runtime"

src/Gyehoek/Sexp/Grammar.hs

@@ -15,6 +15,7 @@ module Gyehoek.Sexp.Grammar
   , encodeDataTest
   , encodeDataTestColour
   , encodeOrShow'
+  , encodeOrShowData'
   , decodeDataWith
   , encodeDataWith'
   , decodeTest
@@ -28,6 +29,8 @@ module Gyehoek.Sexp.Grammar
   , fromDatumUnsafe
   , Control.Category.id
   , fromDataUnsafe
+  , writeDatum
+  , writeData
   )
   where
 
@@ -45,6 +48,7 @@ import qualified Control.Category
 import qualified Data.Vector as V
 import Data.String (IsString (fromString))
 import qualified Data.Text as T
+import System.Environment (lookupEnv)
 
 
 toDatum :: Jalmot :> es => DatumGrammar a -> a -> Eff es Datum
@@ -126,6 +130,39 @@ encodeOrShow' g x = fromString $
     Left _ -> show x
     Right t -> T.unpack t
 
+encodeOrShow :: (IsString s, Show a) => DatumGrammar a -> a -> s
+encodeOrShow g x = fromString $
+  case runPureEff . runJalmot . encodeWith' g $ x of
+    Left _ -> show x
+    Right t -> T.unpack t
+
+encodeOrShowData' :: (IsString s, Show a) => DataGrammar a -> a -> s
+encodeOrShowData' g x = fromString $
+  case runPureEff . runJalmot . encodeDataWith' g $ x of
+    Left _ -> show x
+    Right t -> T.unpack t
+
+encodeOrShowData :: (IsString s, Show a) => DataGrammar a -> a -> s
+encodeOrShowData g x = fromString $
+  case runPureEff . runJalmot . encodeDataWith g $ x of
+    Left _ -> show x
+    Right t -> T.unpack t
+
+useColour :: IO Bool
+useColour = maybe True (const False) <$> lookupEnv "NO_COLOR"
+
+writeDatum :: (Show a, DatumIso a, MonadIO m) => a -> m ()
+writeDatum x = do
+  c <- liftIO useColour 
+  let f = if c then encodeOrShow else encodeOrShow'
+  liftIO . TIO.putStrLn . f datumIso $ x
+
+writeData :: (Show a, DataIso a, MonadIO m) => a -> m ()
+writeData x = do
+  c <- liftIO useColour 
+  let f = if c then encodeOrShowData else encodeOrShowData'
+  liftIO . TIO.putStrLn . f dataIso $ x
+
 class DatumIso a where
   datumIso :: DatumGrammar a
 

test/Gyehoek/Test/CPS/Eval.hs

@@ -5,53 +5,72 @@ import Test.Tasty.HUnit
 import Gyehoek.CPS.Syntax (cps, Obj(..), Hob(..), Imm(..))
 import Gyehoek.CPS.Eval qualified as Sut
 import Data.List (List)
-import Test.Tasty.ExpectedFailure (ignoreTestBecause)
+import Test.Tasty.ExpectedFailure (ignoreTestBecause, expectFail)
+import System.Directory (listDirectory)
+import Test.Tasty.Silver
+import System.FilePath
+import Control.Exception
+import qualified Gyehoek.Driver as Driver
+import Control.DeepSeq (($!!))
+import System.Exit (ExitCode(..))
+import qualified Data.Text as T
+import Data.Function (applyWhen)
+import Gyehoek.Prelude
 
 
-test_cpsInterpreter =
+brokenEvalTests :: List String
-  ignoreTestBecause "i forgorrrr" $
+brokenEvalTests =
-  testGroup "cps interpreter" $
+  []
-  [ primitives
+  -- [ "adder"
-  , testCase "halt with constant" do
+  -- , "apply2"
-      evalsTo [ObjImm (ImmInt 123)] [cps|
+  -- , "apply-twice"
-        (continue halt 123)
+  -- , "arith"
-      |]
+  -- , "begin-1"
-  , testCase "identity cont" do
+  -- , "callcc-constant"
-      evalsTo [ObjImm (ImmInt 154)] [cps|
+  -- , "callcc-discard"
-        (letrec ((id (κ (x)
+  -- , "callcc-early-exit-1"
-                       (continue halt x))))
+  -- , "callcc-early-exit-2"
-          (continue id 154))
+  -- , "callcc-early-exit-3"
-      |]
+  -- , "callcc-early-exit-4"
-  , testCase "identity function" do
+  -- , "callcc-early-exit-5"
-      evalsTo [ObjImm (ImmInt 456)] [cps|
+  -- , "callcc-early-exit-6"
-        (letrec ((id (λ (x ktail)
+  -- , "callcc-nested-1"
-                       (continue ktail x))))
+  -- , "callcc-nested-2"
-          (id 456 halt))
+  -- , "complicated-1"
-      |]
+  -- , "cons-1"
-  , testCase "square" do
+  -- , "factorial"
-      evalsTo [ObjImm (ImmInt 81)] [cps|
+  -- , "false"
-        (letrec ((square (λ (x ktail)
+  -- , "fn-of-fn"
-                           (prim (* x x)
+  -- , "if-false"
-                             (κ (r) (continue ktail r))))))
+  -- , "if-number"
-          (square 9 halt))
+  -- , "if-true"
-      |]
+  -- , "lambda"
-  ]
+  -- , "letrec-fn"
+  -- , "let-fn"
+  -- , "lit-int"
+  -- , "square"
+  -- , "true"
+  -- ]
 
-evalsTo :: HasCallStack => List Obj -> Sut.Exp -> Assertion
+test_eval :: IO TestTree
-evalsTo rs e = Sut.evalExp e @?= rs
+test_eval = do
+  cs <- listDirectory "golden/exec"
+      <&> fmap ("golden/exec" </>)
+  pure $ testGroup "cps interpreter" $ cpsCase <$> cs
 
-primitives = testGroup "primitives"
+maybeBroken name broken = applyWhen (name `elem` broken) expectFail
-  [ testGroup "arith"
+
-    [ testCase "basic 1" do
+cpsCase :: FilePath -> TestTree
-        evalsTo [ObjImm (ImmInt 20)] [cps|
+cpsCase test =
-          (prim (* 4 5)
+  maybeBroken testName brokenEvalTests $
-            (κ (x) (continue halt x)))
+    goldenVsAction testName resultFile action printProcResult
-          |]
+  where
-    , testCase "basic 2" do
+    testName = takeFileName test
-        evalsTo [ObjImm (ImmInt 35)] [cps|
+    resultFile = test </> "exec"
-          (prim (* 2 16)
+    sourceFile = test </> "source.scm"
-            (κ (x) (prim (+ x 3)
+    action = catch @SomeException
-                      (κ (r) (continue halt r)))))
+      (do r <- Driver.eval_cps_e2e sourceFile
-          |]
+          pure $!! ( ExitSuccess
-    ]
+                   , r
-  ]
+                   , "" ))
+      \e -> pure (ExitFailure 1, "", T.pack $ displayException e)

test/Gyehoek/Test/CPS/Stackify.hs

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

test/Gyehoek/Test/CPS/Syntax.hs

@@ -46,9 +46,9 @@ qq = testGroup "parser"
   , testCase "application" do
       assertEqual "" (Sut.ExpApply (Sut.ValVar "f")
                      [Sut.ValVar "x",Sut.ValVar "y"]
-                     "k")
+                     (Sut.KexpVar "k"))
         [cps|(f x y k)|]
       assertEqual "" (Sut.ExpApply (Sut.ValVar "f")
-                     [] "k")
+                     [] (Sut.KexpVar "k"))
         [cps|(f k)|]
   ]

test/Gyehoek/Test/Golden.hs

@@ -40,7 +40,8 @@ test_root = do
   testGroup "execution" <$> sequenceA
     [ ignoreTestBecause "wasm codegen is on the backburner"
       <$> wasmTests tests
-    , stackifyTests tests
+    , ignoreTestBecause "i'm killing myself"
+      <$> stackifyTests tests
     ]
 
 maybeBroken name broken = applyWhen (name `elem` broken) expectFail

test/Gyehoek/Test/Stack/VM.hs

@@ -8,12 +8,13 @@ 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 = testGroup "stack machine"
+test_root = ignoreTestBecause "i'm super-killing myself" $ testGroup "stack machine"
   [ testCase "immediate halt" do
       evalsTo [] [stkP|
         (define $start