Browse Source

Beginnings of Scheme support

Getty Ritter 9 years ago
parent
commit
37214c787c

+ 9 - 0
Data/SCargot/Scheme/Common.hs

@@ -0,0 +1,9 @@
+module Data.SCargot.Scheme.Common where
+
+-- Schemes are actually kind of complicated! The goal is to support
+-- R[34567]RS pretty fully, and I'm actually 100% happy to try to
+-- add R[12]RS support, as well, but that might actually involve
+-- hunting down physical copies of the relevant reports.
+
+-- R3RS is dedicated to the memory of Algol-60, so I might have
+-- to dedicate this to the memory of R(<6)RS.

+ 0 - 0
Data/SCargot/Scheme/R3RS.hs


+ 0 - 0
Data/SCargot/Scheme/R4RS.hs


+ 0 - 0
Data/SCargot/Scheme/R5RS.hs


+ 0 - 0
Data/SCargot/Scheme/R6RS.hs


+ 45 - 0
Data/SCargot/Scheme/R7RS.hs

@@ -0,0 +1,45 @@
+module Data.SCargot.Scheme.R7RS where
+
+-- | A Scheme value type. This is strictly larger than just
+--   'atoms', as they may include things like vectors or
+--   labeled data, which must be able to refer to yet other
+--   s-expressions. Thus, the SchemeAtom type must be able
+--   to itself refer to the carrier type in which it is
+--   contained.
+data SchemeAtom carrier
+  = ScmIdent Text
+  | ScmBool Bool
+  | ScmString Text
+  | ScmNum Integer
+  | ScmChar Char
+  | ScmVec [carrier (SchemeAtom carrier)]
+  | ScmByteVec [Word8]
+  | ScmLabeledDatum Int (carrier (SchemeAtom carrier))
+  | ScmLabelReference Int
+    deriving (Eq, Show)
+
+withQuasiQuote :: SExprSpec (SchemeAtom SExpr) (SExpr (SchemeAtom Sexpr))
+               -> SExprSpec (SchemeAtom SExpr) (SExpr (SchemeAtom SExpr))
+withQuasiQuote spec = addReader '`' (fmap (go "quasiquote"))
+                    $ addReader ',' unquote
+                    $ spec
+   where go name s = name ::: s ::: Nil
+         unquote p = char '@' *> fmap (go "unquote-splicing")
+                  <|> fmap (go "unquote")
+
+octoReader :: Reader (SExpr (SchemeAtom SExpr))
+octoReader pSexpr =
+      string "true"  *> pure (ScmBool True)
+  <|> string "false" *> pure (ScmBool False)
+  <|> char 't' *> pure (ScmBool True)
+  <|> char 'f' *> pure (ScmBool False)
+  <|> char '\\' *> characterConstant
+  <|> char '(' *> fmap ScmVec (vector pSexpr)
+  <|> string "u8(" *> bytevec
+  <|> do n <- read <$> many1 digit
+         (char '#' *> ScmLabelReference n <|>
+          char '=' *> fmap (ScmLabeledDatum n) pSexpr)
+
+vector :: Parser (SExpr (SchemeAtom SExpr)) -> Parser [SExpr (SchemeAtom SExpr)]
+vector pSexpr =
+  (char ')' *> pure []) <|> ((:) <$> pSExpr <*> vector pSexpr)