src/Gyehoek/Stack/Syntax.hs

@@ -37,7 +37,17 @@ instance Each Block Block Instr Instr where
 data Instr
   = DefinePop Name
   | DefinePopCont Name
-  | PushCont (List Name) Block
+  | PushCont Cont
+  | Push Name
+  | Call Name
+  deriving stock (Show, Generic, Data)
+
+data Cont
+  = KVar Name
+  | Kappa Kappa
+  deriving stock (Show, Generic, Data)
+
+data Kappa = MkKappa (List Name) Block
   deriving stock (Show, Generic, Data)
 
 
@@ -57,6 +67,8 @@ instance SexpIso Instr where
     $ With (g_DefinePop >>>)
     $ With (g_DefinePopCont >>>)
     $ With (g_PushCont >>>)
+    $ With (g_Push >>>)
+    $ With (g_Call >>>)
     $ End
     where
       def :: Text -> S.SexpGrammar Name
@@ -68,11 +80,24 @@ instance SexpIso Instr where
       g_DefinePopCont = def "pop-cont!"
       g_PushCont = S.list $
         S.el (S.sym "push-cont!")
-        >>> S.el (S.list $
+        >>> S.el (S.sexpIso @Cont)
-                 S.el Gyehoek.Sexp.kappaKeyword
+      g_Push = S.list $ S.el (S.sym "push!") >>> S.el S.sexpIso
-                 >>> S.el (S.sexpIso @(List Name))
+      g_Call = S.list $ S.el (S.sym "call!") >>> S.el S.sexpIso
-                 >>> S.rest (S.sexpIso @Instr)
+
-                 >>> S.onTail (S.iso coerce coerce))
+instance SexpIso Cont where
+  sexpIso = match
+    $ With (S.sexpIso @Name >>>)
+    $ With (S.sexpIso @Kappa >>>)
+    $ End
+  
+instance SexpIso Kappa where
+  sexpIso = with \g_kappa ->
+    (S.list $
+      S.el Gyehoek.Sexp.kappaKeyword
+      >>> S.el (S.sexpIso @(List Name))
+      >>> S.rest (S.sexpIso @Instr)
+      >>> S.onTail (S.iso coerce coerce))
+    >>> g_kappa
 
 programFromSexps :: Foldable f => f S.Sexp -> Program
 programFromSexps = MkProgram . foldMap f