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

app/Gyehoek/Sexp.hs

@@ -10,6 +10,8 @@ module Gyehoek.Sexp
   , encode
   , decode
   , parseSexps
+  , prefixSugar
+  , todo
   )
 where
 
@@ -33,6 +35,7 @@ import GHC.IO.Unsafe (unsafePerformIO)
 import qualified Data.Text.IO as TIO
 import Control.Monad (join)
 import qualified Language.Sexp.Located as SexpLoc
+import Data.Void (absurd)
 
 
 sexp :: SexpIso a => Iso' a Text
@@ -80,6 +83,24 @@ dotlist x = list $ rest $ coproduct
   [ x >>> _
   ]
 
+-- | Define a sexp representation as either (⟨name⟩ ⟨e⟩) or '⟨e⟩.
+prefixSugar
+  :: Text -> Prefix
+  -> Grammar Position (Sexp :- t') a
+  -> Grammar Position (Sexp :- t') a
+prefixSugar name prefix e = coproduct
+  -- 'something
+  [ Sexp.prefixed prefix e
+  -- (quote something)
+  , list $ el (sym name) >>> el e
+  ]
+
+todo :: Grammar p (Sexp :- t) t'
+todo = (IGB.Flip $ IGB.PartialIso absurd f) >>> IGB.PartialIso absurd g
+  where
+    f _ = Left $ unexpected "todo"
+    g _ = Left $ unexpected "todo"
+
 lambda
   :: (forall t. Grammar Position (Sexp :- t) (a :- t))
   -> Grammar Position (Sexp :- List a :- t1) t2