big

app/Gyehoek/Syntax.hs

@@ -24,6 +24,12 @@ data Prim e
   | PrimMul e e
   | PrimDiv e e
   | PrimCons e e
+  | PrimCar e
+  | PrimCdr e
+  | PrimImmediateP e
+  | PrimConsP e
+  | PrimIntegerP e
+  | PrimWrite e
   deriving (Show, Generic, Functor, Foldable, Traversable)
 
 instance Each (Prim e) (Prim e') e e'
@@ -36,10 +42,10 @@ data Lit
 
 data Exp
   = ExpLet (NonEmpty (Name, Exp)) Exp
-  | ExpApply Exp (List Exp)
+  | ExpPrim (Prim Exp)
   | ExpBegin (List Exp)
   | ExpLit Lit
-  | ExpPrim (Prim Exp)
+  | ExpApply Exp (List Exp)
   | ExpLambda (List Name) Exp
   | ExpVar Name
   deriving (Show, Generic)
@@ -48,14 +54,22 @@ data Exp
 
 instance SexpIso a => SexpIso (Prim a) where
   sexpIso = match
-    $ With (. binop "prim:+")
-    $ With (. binop "prim:-")
-    $ With (. binop "prim:*")
-    $ With (. binop "prim:/")
-    $ With (. binop "prim:cons")
+    $ With (. binop "+")
+    $ With (. binop "-")
+    $ With (. binop "*")
+    $ With (. binop "/")
+    $ With (. binop "cons")
+    $ With (. unop "car")
+    $ With (. unop "cdr")
+    $ With (. unop "immediate?")
+    $ With (. unop "cons?")
+    $ With (. unop "integer?")
+    $ With (. unop "write")
     $ End
     where
-      binop s = list $ el (sym s) >>> el sexpIso >>> el sexpIso
+      primname = ("prim:" <>)
+      unop s = list $ el (sym (primname s)) >>> el sexpIso
+      binop s = list $ el (sym (primname s)) >>> el sexpIso >>> el sexpIso
 
 instance SexpIso Lit where
   sexpIso = match
@@ -67,10 +81,10 @@ instance SexpIso Lit where
 instance SexpIso Exp where
   sexpIso = match
     $ With (. Gyehoek.Sexp.let_ symbol sexpIso sexpIso)
-    $ With (\app -> app . list (el sexpIso >>> rest sexpIso))
+    $ With (. sexpIso)
     $ With (\bgn -> bgn . list (el (sym "begin") >>> rest sexpIso))
     $ With (. sexpIso)
-    $ With (. sexpIso)
+    $ With (\app -> app . list (el sexpIso >>> rest sexpIso))
     $ With (. lam)
     $ With (. symbol)
     $ End