allow multiple values in cps conversion

src/Gyehoek/Scheme/Syntax.hs

@@ -51,7 +51,7 @@ import qualified Effectful.FileSystem.IO.ByteString as FB
 import qualified Data.Set.Ordered as O
 import Gyehoek.Sexp.Grammar qualified as Sexp
 import Gyehoek.Sexp.Grammar qualified as S
-import Gyehoek.Sexp.Grammar (DatumIso, DataIso)
+import Gyehoek.Sexp.Grammar (DatumIso, G, DataIso, (:-)((:-)))
 import Gyehoek.Prelude
 
 
@@ -84,6 +84,8 @@ data Prim e
   | PrimEnvRef e Int
   | PrimEnvCode e
   | PrimCallCC e
+  | PrimValues (List e)
+  | PrimCallWithValues e e
   deriving stock (Show, Generic, Functor, Foldable, Traversable, Data, Eq)
   deriving anyclass (NFData)
 
@@ -106,7 +108,7 @@ data Exp
   = ExpLet (List (Name, Exp)) Exp
   | ExpLetRec (List (Name, Exp)) Exp
   | ExpPrim (Prim Exp)
-  | ExpBegin (List Exp)
+  | ExpBegin (NonEmpty Exp)
   | ExpIf Exp Exp Exp
   | ExpLit Lit
   | ExpLambda (List Name) Exp
@@ -167,6 +169,8 @@ primDatumIso namefn a = S.match
     $ S.With (. S.headTagged2 (namefn "env-ref") a S.int)
     $ S.With (. ht1 "env-code")
     $ S.With (. ht1 "call/cc")
+    $ S.With (. ht0' "values")
+    $ S.With (. ht2 "call-with-values")
     $ S.End
     where
       idn = S.el . S.sym . namefn
@@ -174,6 +178,7 @@ primDatumIso namefn a = S.match
       ht1 s = S.headTagged1 (namefn s) a
       ht2 s = S.headTagged2 (namefn s) a a
       ht1' s = S.headTagged1' (namefn s) a a
+      ht0' s = S.headTagged0' (namefn s) a
 
 instance DatumIso a => DatumIso (Prim a) where
   -- datumIso = primDatumIso ("prim:"<>) datumIso
@@ -203,7 +208,7 @@ instance DatumIso Exp where
     $ S.With (. S.letLike "let" S.datumIso S.datumIso S.datumIso)
     $ S.With (. S.letLike "letrec" S.datumIso S.datumIso S.datumIso)
     $ S.With (. S.datumIso)
-    $ S.With (. S.beginLike "begin" S.datumIso)
+    $ S.With (. begin)
     $ S.With (. S.ifLike "if" S.datumIso S.datumIso S.datumIso)
     $ S.With (. S.datumIso)
     $ S.With (. lam)
@@ -212,12 +217,18 @@ instance DatumIso Exp where
     $ S.End
     where
       lam = S.lambdaLike S.lambdaKeyword S.datumIso (S.el S.datumIso)
+      begin :: forall t. G (S.Datum :- t) (NonEmpty Exp :- t)
+      begin = S.beginLike "begin" $
+        S.el (S.datumIso @Exp) >>> S.rest (S.datumIso @Exp)
+        >>> S.onTail (S.Iso
+          (\(xs:-x:-t) -> (x:|xs):-t)
+          (\((x:|xs):-t) -> xs:-x:-t))
 
 instance DatumIso CommandOrDef where
   datumIso = S.match
     $ S.With (\_Command -> _Command . S.datumIso)
     $ S.With (\_Definition -> _Definition . S.datumIso)
-    $ S.With (\_Begin -> _Begin . S.beginLike "begin" S.datumIso)
+    $ S.With (\_Begin -> _Begin . S.beginLike "begin" (S.rest S.datumIso))
     $ S.End
 
 instance DataIso Program where