2026-05-15 15:27:20 -06:00
parent dc785ed8f3
commit d38e98d90f
8 changed files with 43 additions and 25 deletions
--- a/app/Gyehoek/Scheme/Syntax.hs
+++ b/app/Gyehoek/Scheme/Syntax.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+module Gyehoek.Scheme.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
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Gyehoek.Sexp qualified
+import Control.Lens (Each)
+
+
+type Name = Text
+
+data Prim e
+  = PrimAdd e e
+  | PrimSub e 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'
+
+data Lit
+  = LitInt Int
+  | LitNil
+  | LitBool Bool
+  deriving (Show, Generic)
+
+data Exp
+  = ExpLet (NonEmpty (Name, Exp)) Exp
+  | ExpPrim (Prim Exp)
+  | ExpBegin (List Exp)
+  | ExpLit Lit
+  | ExpApply Exp (List Exp)
+  | ExpLambda (List Name) Exp
+  | ExpVar Name
+  deriving (Show, Generic)
+
+
+
+instance SexpIso a => SexpIso (Prim a) where
+  sexpIso = match
+    $ 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
+      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
+    $ With (. sexpIso)
+    $ With (. sym "nil")
+    $ With (. sexpIso)
+    $ End
+
+instance SexpIso Exp where
+  sexpIso = match
+    $ With (. Gyehoek.Sexp.let_ symbol sexpIso sexpIso)
+    $ With (. sexpIso)
+    $ With (\bgn -> bgn . list (el (sym "begin") >>> rest sexpIso))
+    $ With (. sexpIso)
+    $ With (\app -> app . list (el sexpIso >>> rest sexpIso))
+    $ With (. lam)
+    $ With (. symbol)
+    $ End
+    where
+      lam = list
+        ( el (sym "lambda")
+          >>> el (sexpIso @(List Name))
+          >>> el sexpIso )