continue takes var

src/Gyehoek/CPS/Convert.hs

@@ -105,7 +105,7 @@ convertLambda
   => List Name -> Scm.Exp -> Eff es Lambda
 convertLambda bs m = do
   ktail <- gensym' "lambda-tail"
-  m' <- convert m $ pure . ExpContinue ktail . (:[])
+  m' <- convert m $ pure . ExpContinue (ValVar ktail) . (:[])
   pure [cps|(λ (##{bs} #{ktail}) #{m'})|]
 
 convertProgram :: forall es. (GenSym :> es) => Scm.Program -> Eff es Program

src/Gyehoek/CPS/Syntax.hs

@@ -102,7 +102,7 @@ pattern AbsLambda' xs e ktail = AbsLambda (MkLambda xs e ktail)
 data Exp
   = ExpPrim (Prim Val) Kappa
   | ExpLetRec { binders :: List (Name, Abs), body :: Exp }
-  | ExpContinue Name (List Val)
+  | ExpContinue Val (List Val)
   | ExpIf Val Exp Exp
   | ExpApply
     { op :: Val
@@ -112,10 +112,10 @@ data Exp
   deriving (Show, Generic, Data, Eq)
 
 pattern Halt :: List Val -> Exp
-pattern Halt xs = ExpContinue "halt" xs
+pattern Halt xs = ExpContinue (ValLabel "halt") xs
 
 pattern Halt1 :: Val -> Exp
-pattern Halt1 x = ExpContinue "halt" [x]
+pattern Halt1 x = ExpContinue (ValLabel "halt") [x]
 
 data Def = DefConstant Name Exp
   deriving (Show, Generic, Data)
@@ -315,7 +315,7 @@ instance Free Exp where
       foldMapOf (each . _2) (freeWithBound' bound') bs
       <> freeWithBound' bound' m
       where bound' = bound & insertFrom (bs ^.. each . _1)
-    ExpContinue k xs -> filter (`notElem` bound) (k : xs ^.. each . #ValVar)
+    ExpContinue k xs -> filter (`notElem` bound) ((k:xs) ^.. each . #ValVar)
     ExpIf c t f ->
       (c ^.. #ValVar . filtered (`notElem` bound))
       <> freeWithBound' bound t <> freeWithBound' bound f
@@ -330,21 +330,3 @@ instance Free Kappa where
 instance Free Lambda where
   freeWithBound' bound (MkLambda xs k m) =
     freeWithBound' (bound & insertFrom (k:xs)) m
-
-
-
-class Vars a where
-  -- | Traverse the immediate variables of an expression.
-  vars :: Traversal' a Name
-
-instance Vars Val where
-  vars k (ValVar x) = ValVar <$> k x
-  vars _ x = pure x
-
-instance Vars a => Vars (Prim a) where
-  vars k p = traverseOf (each . vars) k p
-
-instance Vars Exp where
-  vars k (ExpPrim p kap) = ExpPrim <$> vars k p <*> pure kap
-  vars k (ExpContinue kname xs) = ExpContinue <$> k kname <*> pure xs
-  vars _ e = pure e

src/Gyehoek/Driver.hs

@@ -1,7 +1,7 @@
 module Gyehoek.Driver
   (main, lower_e2e, convert_e2e, parse_e2e, readScm, eval_e2e)
   where
-
+
 import Gyehoek.Options
 import Prelude hiding (readFile)
 import Options.Applicative
@@ -17,7 +17,7 @@ import qualified Data.Text.Encoding as T
 import System.IO (Handle)
 import System.IO qualified as IO
 import Gyehoek.CPS.Convert
-import Gyehoek.CPS.Lower
+import Gyehoek.Stack.Lower
 import Gyehoek.CPS.Eval qualified as CPS
 import Control.Monad
 import Text.Pretty.Simple (pShowNoColor)
@@ -35,14 +35,14 @@ import Control.Arrow ((>>>))
 import Gyehoek.Prelude
 import Gyehoek.Jalmot
 import qualified Gyehoek.Sexp as S
-
+
 
 main :: IO ()
 main = do
   opts <- execParser $ info (helper <*> parser) fullDesc
   runJalmotIO . runFileSystem . runGenSym . driver $ opts
 
-
+
 
 -- hPutStr :: FileSystem :> es => Handle -> Text -> Eff es ()
 -- hPutStr h = FB.hPutStr h . T.encodeUtf8
@@ -135,10 +135,10 @@ driver opts = do
       & fmap writeObj
       & T.unwords
       & hPutStrLn FS.stdout
-  dumpOrRun opts.inspectWasm (rt_is #Wasm)
-    (lowerProgram cps)
-    inspectWasm
-    (\wat -> withFile opts.output FS.WriteMode \h -> hPutStrLn h wat)
+  -- dumpOrRun opts.inspectWasm (rt_is #Wasm)
+  --   (lowerProgram cps)
+  --   inspectWasm
+  --   (\wat -> withFile opts.output FS.WriteMode \h -> hPutStrLn h wat)
 
 parse_e2e :: FilePath -> IO Scm.Program
 parse_e2e = runJalmotIO . runFileSystem . readScm

src/Gyehoek/Sexp/Grammar/Base.hs

@@ -40,7 +40,7 @@ module Gyehoek.Sexp.Grammar.Base
   , lambdaLike
   , lambdaKeyword
   , kappaKeyword
-  , beginLike
+  , beginLike, headTagged2'
   ) where
 
 import Data.InvertibleGrammar
@@ -325,6 +325,13 @@ headTagged2
   -> G (Datum :- t) (b :- a :- t)
 headTagged2 s g1 g2 = list $ el (symProcedure s) >>> el g1 >>> el g2
 
+headTagged2'
+  :: Text
+  -> DatumGrammar a -> DatumGrammar b -> DatumGrammar c
+  -> G (Datum :- t) (List c :- b :- a :- t)
+headTagged2' s g1 g2 gt =
+  list $ el (symProcedure s) >>> el g1 >>> el g2 >>> rest gt
+
 ifLike
   -- | keyword
   :: Text

test/Gyehoek/Test/CPS/Syntax.hs

@@ -29,14 +29,14 @@ qq :: TestTree
 qq = testGroup "parser"
   [ testCase "lambda" do
       assertEqual "" (Sut.MkLambda ["x","y"] "ktail"
-               (Sut.ExpContinue "ktail" [Sut.ValVar "x"]))
+               (Sut.ExpContinue (Sut.ValLabel "ktail") [Sut.ValVar "x"]))
         [cps|(λ (x y ktail) (continue ktail x))|]
       assertEqual "" (Sut.MkLambda [] "ktail"
-               (Sut.ExpContinue "ktail" [Sut.ValVar "x"]))
+               (Sut.ExpContinue (Sut.ValLabel "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"]))
+               (Sut.ExpContinue (Sut.ValLabel "k123") [Sut.ValVar "x", Sut.ValVar "y"]))
         [cps|(κ (x y) (continue k123 x y))|]
   , testCase "application" do
       assertEqual "" (Sut.ExpApply (Sut.ValVar "f")