| 1 |
module Data.SCargot.Scheme.R7RS where
|
| 2 |
|
| 3 |
-- | A Scheme value type. This is strictly larger than just
|
| 4 |
-- 'atoms', as they may include things like vectors or
|
| 5 |
-- labeled data, which must be able to refer to yet other
|
| 6 |
-- s-expressions. Thus, the SchemeAtom type must be able
|
| 7 |
-- to itself refer to the carrier type in which it is
|
| 8 |
-- contained.
|
| 9 |
data SchemeAtom carrier
|
| 10 |
= ScmIdent Text
|
| 11 |
| ScmBool Bool
|
| 12 |
| ScmString Text
|
| 13 |
| ScmNum Integer
|
| 14 |
| ScmChar Char
|
| 15 |
| ScmVec [carrier (SchemeAtom carrier)]
|
| 16 |
| ScmByteVec [Word8]
|
| 17 |
| ScmLabeledDatum Int (carrier (SchemeAtom carrier))
|
| 18 |
| ScmLabelReference Int
|
| 19 |
deriving (Eq, Show)
|
| 20 |
|
| 21 |
withQuasiQuote :: SExprSpec (SchemeAtom SExpr) (SExpr (SchemeAtom Sexpr))
|
| 22 |
-> SExprSpec (SchemeAtom SExpr) (SExpr (SchemeAtom SExpr))
|
| 23 |
withQuasiQuote spec = addReader '`' (fmap (go "quasiquote"))
|
| 24 |
$ addReader ',' unquote
|
| 25 |
$ spec
|
| 26 |
where go name s = name ::: s ::: Nil
|
| 27 |
unquote p = char '@' *> fmap (go "unquote-splicing")
|
| 28 |
<|> fmap (go "unquote")
|
| 29 |
|
| 30 |
octoReader :: Reader (SExpr (SchemeAtom SExpr))
|
| 31 |
octoReader pSexpr =
|
| 32 |
string "true" *> pure (ScmBool True)
|
| 33 |
<|> string "false" *> pure (ScmBool False)
|
| 34 |
<|> char 't' *> pure (ScmBool True)
|
| 35 |
<|> char 'f' *> pure (ScmBool False)
|
| 36 |
<|> char '\\' *> characterConstant
|
| 37 |
<|> char '(' *> fmap ScmVec (vector pSexpr)
|
| 38 |
<|> string "u8(" *> bytevec
|
| 39 |
<|> do n <- read <$> many1 digit
|
| 40 |
(char '#' *> ScmLabelReference n <|>
|
| 41 |
char '=' *> fmap (ScmLabeledDatum n) pSexpr)
|
| 42 |
|
| 43 |
vector :: Parser (SExpr (SchemeAtom SExpr)) -> Parser [SExpr (SchemeAtom SExpr)]
|
| 44 |
vector pSexpr =
|
| 45 |
(char ')' *> pure []) <|> ((:) <$> pSExpr <*> vector pSexpr)
|