app/Gyehoek/Syntax.hs

@@ -1,13 +1,22 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE PartialTypeSignatures #-}
 module Gyehoek.Syntax where
 
 import Data.Text (Text)
 import Data.List (List)
+import Language.SexpGrammar as Sexp hiding (List)
+import Language.SexpGrammar.Generic
+import GHC.Generics
+import Prelude hiding ((.), id)
+import Control.Category
 
 
 type Name = Text
 
 data Prim = PrimAdd | PrimSub | PrimMul | PrimDiv
-  deriving (Show)
+  deriving (Show, Generic)
 
 data Val
   = ValInt Int
@@ -15,11 +24,55 @@ data Val
   | ValPrim Prim
   | ValLambda (List Name) Exp
   | ValVar Name
-  deriving (Show)
+  deriving (Show, Generic)
 
 data Exp
   = ExpLet (List (Name, Exp)) Exp
   | ExpApply Exp (List Exp)
-  | ExpProgn (List Exp)
+  | ExpBegin (List Exp)
   | ExpVal Val
-  deriving (Show)
+  deriving (Show, Generic)
+
+
+
+letIso
+  :: (forall t. Grammar Position (Sexp :- t) (a :- t))
+  -> (forall t. Grammar Position (Sexp :- t) (b :- t))
+  -> Grammar Position (Sexp :- (List (a, b) :- t1)) t2
+  -> Grammar Position (Sexp :- t1) t2
+letIso name rhs e = list (el (sym "let") >>> el bindings >>> el e)
+  where
+    -- bindings :: Grammar Position (Sexp :- _) (List (_, _) :- _)
+    bindings = list $ rest binding
+    binding :: forall t. Grammar Position (Sexp :- t) ((_, _) :- t)
+    binding = list (el name >>> el rhs) >>> pair
+
+instance SexpIso Prim where
+  sexpIso = match
+    $ With (. sym "+")
+    $ With (. sym "-")
+    $ With (. sym "*")
+    $ With (. sym "/")
+    $ End
+
+instance SexpIso Val where
+  sexpIso = match
+    $ With (. sexpIso)
+    $ With (. sym "nil")
+    $ With (. sexpIso)
+    $ With lam
+    $ With (\var -> var . symbol)
+    $ End
+    where
+      lam q = q . list
+        ( el (sym "lambda")
+          >>> el (sexpIso @(List Name))
+          >>> el sexpIso )
+
+instance SexpIso Exp where
+  sexpIso = match
+    $ With (. letIso symbol sexpIso sexpIso)
+    $ With (\app -> app . list (el sexpIso >>> rest sexpIso))
+    $ With (\bgn -> bgn . list (el (sym "begin") >>> rest sexpIso))
+    $ With (<<< sexpIso)
+    $ End