app/Gyehoek/Scheme/Syntax.hs

@@ -2,11 +2,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE PartialTypeSignatures #-}
-module Gyehoek.Scheme.Syntax where
+module Gyehoek.Scheme.Syntax
+  ( Name
+  , Prim(..)
+  , Lit(..)
+  , Prim(..)
+  , Define(..)
+  , Exp(..)
+  )
+  where
 
 import Data.Text (Text)
 import Data.List (List)
-import Language.SexpGrammar as Sexp hiding (List)
+import Language.SexpGrammar
+  ( SexpIso(..), list, el, (>>>), rest, sym, symbol )
+import Language.SexpGrammar qualified as Sexp
 import Language.SexpGrammar.Generic
 import GHC.Generics
 import Prelude hiding ((.), id)
@@ -39,6 +49,7 @@ data Lit
   | LitNil
   | LitBool Bool
   | LitString Text
+  | LitQuote Sexp
   deriving (Show, Generic)
 
 data Define
@@ -53,9 +64,15 @@ data Exp
   | ExpDefine Define
   | ExpIf Exp Exp Exp
   | ExpLit Lit
-  | ExpApply Exp (List Exp)
   | ExpLambda (List Name) Exp
   | ExpVar Name
+  | ExpApply Exp (List Exp)
+  deriving (Show, Generic)
+
+data Sexp
+  = SexpCons Sexp Sexp
+  | SexpSymbol Text
+  | SexpLit Lit
   deriving (Show, Generic)
 
 
@@ -85,6 +102,14 @@ instance SexpIso Lit where
     $ With (. sym "nil")
     $ With (. sexpIso)
     $ With (. sexpIso)
+    $ With (. Gyehoek.Sexp.prefixSugar "quote" Sexp.Quote sexpIso)
+    $ End
+
+instance SexpIso Sexp where
+  sexpIso = match
+    $ With (\cons -> cons . Gyehoek.Sexp.todo)
+    $ With (\s -> s . symbol)
+    $ With (\lit -> lit . sexpIso)
     $ End
 
 instance SexpIso Define where
@@ -105,9 +130,9 @@ instance SexpIso Exp where
     $ With (. sexpIso)
     $ With (. if_)
     $ With (. sexpIso)
-    $ With (\app -> app . list (el sexpIso >>> rest sexpIso))
     $ With (. lam)
     $ With (. symbol)
+    $ With (\app -> app . list (el sexpIso >>> rest sexpIso))
     $ End
     where
       if_ = list $ el (sym "if") >>> el sexpIso >>> el sexpIso >>> el sexpIso