gdritter repos s-cargot / 37214c7
Beginnings of Scheme support Getty Ritter 9 years ago
6 changed file(s) with 54 addition(s) and 0 deletion(s). Collapse all Expand all
1 module Data.SCargot.Scheme.Common where
2
3 -- Schemes are actually kind of complicated! The goal is to support
4 -- R[34567]RS pretty fully, and I'm actually 100% happy to try to
5 -- add R[12]RS support, as well, but that might actually involve
6 -- hunting down physical copies of the relevant reports.
7
8 -- R3RS is dedicated to the memory of Algol-60, so I might have
9 -- to dedicate this to the memory of R(<6)RS.
(New empty file)
(New empty file)
(New empty file)
(New empty file)
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)