diff --git a/app/Gyehoek/Scheme/Syntax.hs b/app/Gyehoek/Scheme/Syntax.hs index 61aa494..5f49128 100644 --- a/app/Gyehoek/Scheme/Syntax.hs +++ b/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 diff --git a/app/Gyehoek/Sexp.hs b/app/Gyehoek/Sexp.hs index 0ff2ba8..57864d7 100644 --- a/app/Gyehoek/Sexp.hs +++ b/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