app/Gyehoek/ANF.hs

@@ -53,6 +53,9 @@ blah' = go [] where
   go acc []     k = k (reverse acc)
   go acc (f:fs) k = f \a -> go (a:acc) fs k
 
+telescope :: Traversable t => t ((a -> r) -> r) -> (t a -> r) -> r
+telescope = runCont . traverse cont
+
 -- 뻘짓이어라
 blah :: forall t a r. Foldable t => t ((a -> r) -> r) -> (List a -> r) -> r
 blah xs k =
@@ -67,14 +70,9 @@ toANF'
 toANF' (Lam.ExpVal v) k = k v
 
 toANF' (Lam.ExpApply f xs) k =
-  blah (toANF' <$> (f:|xs)) \(f':xs') -> do
+  telescope (toANF' <$> (f:|xs)) \(f':|xs') -> do
     r <- gensym
     ExpLetApply r f' xs' <$> k (ValVar r)
-  where
-    allToANF' es k = traverse (\e -> toANF' e k) es
-    -- blah = traverse g (f :| xs)
-    -- g :: Lam.Exp -> Eff es Val
-    -- g = ContT . toANF'
 
 toANF' e k = _
 

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

gyehoek.cabal

@@ -52,6 +52,7 @@ executable gyehoek
     , text
     , vector
     , generic-lens
+    , sexp-grammar
 
   hs-source-dirs:   app
   default-language: GHC2024