From b5c823f5fe1f9f8ac595dbf536bc28e322718d66 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Mon, 24 Aug 2026 10:23:20 -0600 Subject: [PATCH] continue takes var --- src/Gyehoek/CPS/Convert.hs | 2 +- src/Gyehoek/CPS/Syntax.hs | 26 ++++---------------------- src/Gyehoek/Driver.hs | 16 ++++++++-------- src/Gyehoek/Sexp/Grammar/Base.hs | 9 ++++++++- test/Gyehoek/Test/CPS/Syntax.hs | 6 +++--- 5 files changed, 24 insertions(+), 35 deletions(-) diff --git a/src/Gyehoek/CPS/Convert.hs b/src/Gyehoek/CPS/Convert.hs index a08d466..697f80a 100644 --- a/src/Gyehoek/CPS/Convert.hs +++ b/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 diff --git a/src/Gyehoek/CPS/Syntax.hs b/src/Gyehoek/CPS/Syntax.hs index 6cbc227..28a18e1 100644 --- a/src/Gyehoek/CPS/Syntax.hs +++ b/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 diff --git a/src/Gyehoek/Driver.hs b/src/Gyehoek/Driver.hs index 33b98a0..834e68e 100644 --- a/src/Gyehoek/Driver.hs +++ b/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 diff --git a/src/Gyehoek/Sexp/Grammar/Base.hs b/src/Gyehoek/Sexp/Grammar/Base.hs index 4ca3bbe..2882d0e 100644 --- a/src/Gyehoek/Sexp/Grammar/Base.hs +++ b/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 diff --git a/test/Gyehoek/Test/CPS/Syntax.hs b/test/Gyehoek/Test/CPS/Syntax.hs index 5ecd917..f8a7b68 100644 --- a/test/Gyehoek/Test/CPS/Syntax.hs +++ b/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")