parse meta vars

src/Gyehoek/CPS/Syntax.hs

@@ -18,7 +18,6 @@ module Gyehoek.CPS.Syntax
   , Imm(..)
   , Obj(..)
   , Hob(..)
-  , pattern Void
   , pattern Halt
   , pattern Halt1
   , _MkKappa
@@ -43,7 +42,7 @@ module Gyehoek.CPS.Syntax
 
 import Language.SexpGrammar qualified as S
 import Gyehoek.Sexp qualified
-import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primSexpIso, Lit(..), pattern Void)
+import Gyehoek.Scheme.Syntax (Name (..), Prim(..), primDatumIso, Lit(..))
 import Language.SexpGrammar.Generic
 import Control.Category
 import Prelude hiding ((.), id)

src/Gyehoek/Jalmot.hs

@@ -2,6 +2,7 @@ module Gyehoek.Jalmot
   ( Jalmot
   , Exception(..)
   , AJalmot(..)
+  , AJalmotCS(..)
   , module Effectful.Error.Static
   , runJalmot
   , runJalmotIO
@@ -12,7 +13,7 @@ module Gyehoek.Jalmot
 import Gyehoek.Prelude
 import Text.Megaparsec.Error (ParseErrorBundle, errorBundlePretty)
 import Data.Void (Void)
-import Control.Exception.Base (Exception(..), throwIO)
+import Effectful.Exception
 import Effectful.Error.Static
 import qualified Data.InvertibleGrammar as Grammar
 import Gyehoek.Sexp.Syntax (Ann)
@@ -28,7 +29,7 @@ data AJalmot
   | GrammarError (Grammar.ErrorMessage Ann)
   deriving (Show, Generic, Data)
 
-data AJalmotWithCallStack = MkAJalmotWithCallStack !CallStack !AJalmot
+data AJalmotCS = MkAJalmotCS !CallStack !AJalmot
   deriving (Show)
 
 type Jalmot = Error AJalmot
@@ -40,7 +41,7 @@ runJalmotIOE :: IOE :> es => Eff (Jalmot : es) a -> Eff es a
 runJalmotIOE eff =
   runJalmot eff >>= \case
     Right a -> pure a
-    Left (cs,jm) -> liftIO . throwIO $ MkAJalmotWithCallStack cs jm
+    Left (cs,jm) -> throwIO $ MkAJalmotCS cs jm
 
 runJalmotIO :: Eff '[Jalmot, IOE] a -> IO a
 runJalmotIO = runEff . runJalmotIOE
@@ -53,7 +54,7 @@ instance Exception AJalmot where
         & layoutPretty defaultLayoutOptions
         & renderString
 
-instance Exception AJalmotWithCallStack where
+instance Exception AJalmotCS where
   backtraceDesired = const False
-  displayException (MkAJalmotWithCallStack cs jm) =
+  displayException (MkAJalmotCS cs jm) =
     "\n" <> displayException jm <> "\n\n" <> prettyCallStack cs

src/Gyehoek/Sexp/Read.hs

@@ -11,23 +11,14 @@ import Data.Void (Void)
 import Gyehoek.Sexp.Syntax
 import Gyehoek.Prelude hiding (Simple, (:<))
 import qualified Data.Text.IO as T
-import System.IO (stderr, hPutStrLn)
 import Prelude hiding (readFile)
-import Data.Functor (($>), void)
+import Data.Functor (($>))
 import qualified Data.Text as T
 import Data.Char (GeneralCategory(..), generalCategory)
-import Control.Exception hiding (try)
 import Data.Scientific (Scientific)
 import Gyehoek.Jalmot
 
 
--- i'm lazy
-newtype ReaderError = MkReaderError String
-  deriving (Show)
-
-instance Exception ReaderError where
-  displayException (MkReaderError x) = x
-
 readFile :: (Jalmot :> es, IOE :> es) => FilePath -> Eff es (List Datum)
 readFile f = do
   s <- liftIO . T.readFile $ f
@@ -52,7 +43,9 @@ type P = Parsec Void Text
 
 --- lexer helpers
 
--- TODO: check R⁷RS
+-- TODO: check R⁷RS's definition of ⟨atmosphere⟩.
+-- TODO: datum comments.
+-- | whitespace consumer.
 sc :: P ()
 sc = L.space space1
   (L.skipLineComment ";")
@@ -61,6 +54,7 @@ sc = L.space space1
 lexeme :: P a -> P a
 lexeme = L.lexeme sc
 
+-- | verbatim text.
 verb :: Text -> P Text
 verb = L.symbol sc
 
@@ -92,6 +86,7 @@ identifier = label "identifier" . lexeme . choice $
       , ModifierSymbol, OtherSymbol, PrivateUse ]
       || c == '\x200c' || c == '\x200d')
       && c /= ';' && c /= '|' && c /= '"' && c /= '.'
+      && c /= ',' && c /= '#'
 
 boolean :: P Bool
 boolean = label "boolean" . lexeme $ choice
@@ -137,6 +132,14 @@ string = label "string" . lexeme $
       , "\\\\" $> '\\'
       ]
 
+metaSplice :: P Text
+metaSplice = label "splicing meta" . lexeme . between "##{" "}" $
+  takeWhileP Nothing (/= '}')
+
+meta :: P Text
+meta = label "meta" . lexeme . between "#{" "}" $
+  takeWhileP Nothing (/= '}')
+
 
 
 file :: P (List Datum)
@@ -160,6 +163,8 @@ simpleDatum = choice
   , SimpleString <$> string
   , SimpleSymbol <$> symbol
   -- , SimpleBytevector <$> bytevector
+  , SimpleMetaSplice <$> metaSplice
+  , SimpleMeta <$> meta
   ]
 
 compoundDatum :: P Compound