Copyright | © 2019 Vincent Archambault |
---|---|
License | 0BSD |
Maintainer | Vincent Archambault <archambault.v@gmail.com> |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
Module for parsing the Scheme R5RS language.
Scheme R5RS s-expressions are parsed as
. Such s-expressions can be converted into a Scheme
R5RS datum (see SExpr
SExprType
SchemeToken
Datum
) by the function sexpr2Datum
.
Synopsis
- data SExprType
- data SchemeToken
- tokenParser :: (MonadParsec e s m, Token s ~ Char) => m SchemeToken
- sexpr :: forall e s m. (MonadParsec e s m, Token s ~ Char) => SExprParser m SExprType SchemeToken
- data Datum
- sexpr2Datum :: [SExpr SExprType SchemeToken] -> Either String [Datum]
- whitespace :: (MonadParsec e s m, Token s ~ Char) => m ()
- comment :: (MonadParsec e s m, Token s ~ Char) => m ()
- interTokenSpace :: (MonadParsec e s m, Token s ~ Char) => m ()
- interTokenSpace1 :: (MonadParsec e s m, Token s ~ Char) => m ()
- identifier :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Text
- boolean :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Bool
- character :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Char
- stringParser :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Text
- quote :: (MonadParsec e s m, Token s ~ Char) => m Char
- quasiquote :: (MonadParsec e s m, Token s ~ Char) => m Char
- comma :: (MonadParsec e s m, Token s ~ Char) => m Char
- commaAt :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Text
- dot :: (MonadParsec e s m, Token s ~ Char) => m Char
- data SchemeNumber = SchemeNumber Exactness Complex
- data Exactness
- data Complex
- data SReal
- data Sign
- data UInteger
- type Pounds = Integer
- data Precision
- data Suffix = Suffix Precision Sign Integer
- number :: (MonadParsec e s m, Token s ~ Char) => m SchemeNumber
SchemeToken and Datum related data types and functions
Scheme R5RS defines two types of s-expressions. Standard list
beginning with '(' and vector beginning with '#('. The SExprType
data type indicates which one was parsed.
data SchemeToken Source #
The SchemeToken
data type defines the atoms of an Scheme R5RS
s-expression. An
object
containning the atoms SExpr
SExprType
SchemeToken
TQuote
, TQuasiquote
, TComma
, TCommaAt
and TDot
need futher processing in order to get what the R5RS
report calls a datum. See also Datum
.
TBoolean Bool | A boolean. |
TNumber SchemeNumber | A number. See |
TChar Char | A unicode character. |
TString Text | A string. |
TIdentifier Text | A valid R5RS identifier. |
TQuote | The quote (') symbol. |
TQuasiquote | The quasiquote (`) symbol. |
TComma | The comma (,) symbol. |
TCommaAt | The comma at (,@) symbol. |
TDot | The dot (.) symbol. |
Instances
Eq SchemeToken Source # | |
Defined in Data.SExpresso.Language.SchemeR5RS (==) :: SchemeToken -> SchemeToken -> Bool # (/=) :: SchemeToken -> SchemeToken -> Bool # | |
Show SchemeToken Source # | |
Defined in Data.SExpresso.Language.SchemeR5RS showsPrec :: Int -> SchemeToken -> ShowS # show :: SchemeToken -> String # showList :: [SchemeToken] -> ShowS # |
tokenParser :: (MonadParsec e s m, Token s ~ Char) => m SchemeToken Source #
The tokenParser
parses a SchemeToken
sexpr :: forall e s m. (MonadParsec e s m, Token s ~ Char) => SExprParser m SExprType SchemeToken Source #
The sexpr
defines a SExprParser
to parse a Scheme R5RS
s-expression as an
. If you also
want source position see the SExpr
SExprType
SchemeToken
withLocation
function.
Space is optional before and after the following tokens:
The Datum
data type implements the Scheme R5RS definition of a Datum. See also sexpr2Datum
.
sexpr2Datum :: [SExpr SExprType SchemeToken] -> Either String [Datum] Source #
The sexpr2Datum
function takes a list of SchemeToken
and
returns a list of Datum
. In case of failure it will report an
error, hence the Either
data type in the signature.
As defined in the Scheme R5RS report, the TQuote
, TQuasiquote
,
TComma
, TCommaAt
and TDot
tokens must be followed by another
token.
Scheme R5RS whitespace parsers
whitespace :: (MonadParsec e s m, Token s ~ Char) => m () Source #
The whitespace
parser parses one space, tab or end of line (\n and \r\n).
comment :: (MonadParsec e s m, Token s ~ Char) => m () Source #
The comment
parser parses a semi-colon (;) character and
everything until the end of line included.
interTokenSpace :: (MonadParsec e s m, Token s ~ Char) => m () Source #
The interTokenSpace
parser parses zero or more whitespace or comment.
interTokenSpace1 :: (MonadParsec e s m, Token s ~ Char) => m () Source #
The interTokenSpace1
parser parses one or more whitespace or comment.
Individual parser for each of the constructors of SchemeToken
identifier :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Text Source #
The identifier
parser parses a Scheme R5RS identifier.
boolean :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Bool Source #
The boolean
parser parses a Scheme R5RS boolean (#t or #f).
character :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Char Source #
The character
parser parses a Scheme R5RS character.
stringParser :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Text Source #
The stringParser
parser parses a Scheme R5RS character.
quote :: (MonadParsec e s m, Token s ~ Char) => m Char Source #
The quote
parser parses a quote character (').
quasiquote :: (MonadParsec e s m, Token s ~ Char) => m Char Source #
The quasiquote
parser parses a quasiquote character (`).
commaAt :: forall e s m. (MonadParsec e s m, Token s ~ Char) => m Text Source #
The commaAt
parser parses a comma followed by @ (,@).
dot :: (MonadParsec e s m, Token s ~ Char) => m Char Source #
The dot
parser parses a single dot character (.).
Scheme Number
Scheme R5RS numbers are quite exotic. They can have exactness prefix, radix prefix and the pound sign (#) can replace a digit. On top of that, you can define integer, rational, decimal and complex numbers of arbitrary precision. Decimal numbers can also have a suffix indicating the machine precision.
Since Haskell does not have native types to express this
complexity, this module defines the SchemeNumber
data type to
encode the parsed number. User of this module can then convert a
SchemeNumber
object to a more appropriate data type according
to their needs.
data SchemeNumber Source #
A Scheme R5RS number is an exact or inexact complex number.
Instances
Eq SchemeNumber Source # | |
Defined in Data.SExpresso.Language.SchemeR5RS (==) :: SchemeNumber -> SchemeNumber -> Bool # (/=) :: SchemeNumber -> SchemeNumber -> Bool # | |
Show SchemeNumber Source # | |
Defined in Data.SExpresso.Language.SchemeR5RS showsPrec :: Int -> SchemeNumber -> ShowS # show :: SchemeNumber -> String # showList :: [SchemeNumber] -> ShowS # |
A Scheme R5RS number is either exact or inexact. The paragraph 6.4.2 from the R5RS report should clarify the meaning of exact and inexact :
"""A numerical constant may be specified to be either exact or inexact by a prefix. The prefixes are #e for exact, and #i for inexact. An exactness prefix may appear before or after any radix prefix that is used. If the written representation of a number has no exactness prefix, the constant may be either inexact or exact. It is inexact if it contains a decimal point, an exponent, or a “#” character in the place of a digit, otherwise it is exact."""
The Complex
data type represents a Scheme R5RS complex number.
CReal SReal | A real number. |
CAngle SReal SReal | A complex number in angular notation. |
CAbsolute SReal SReal | A complex number in absolute notation. |
The SReal
data type represents a Scheme R5RS real number.
SInteger Sign UInteger | A signed integer. |
SRational Sign UInteger UInteger | A signed rational. The first number is the numerator and the second one the denominator. |
SDecimal Sign UInteger UInteger (Maybe Suffix) | A signed decimal number. The first number appears before the dot, the second one after the dot. |
A Scheme R5RS unsigned integer can be written in three ways.
- With digits only
- With digits and # signs
- With only # signs in some special context.
UInteger Integer | Integer made only of digits |
UIntPounds Integer Pounds | Integer made of digits and #. The first argument is the number
that was parsed and the second the number of # signs. For
example, 123## is represented as |
UPounds Pounds | Integer made only of #. It can only appear as the third argument in numbers of the form |
type Pounds = Integer Source #
A Scheme R5RS number can have many # signs at the end. This type alias indicates the number of # signs parsed.
Scheme R5RS defines 5 types of machine precision for a decimal
number. The machine precision is specified in the suffix (see
Suffix
).
PDefault | Suffix starting with e. |
PShort | Suffix starting with s. |
PSingle | Suffix starting with f. |
PDouble | Suffix starting with d. |
PLong | Suffix starting with l. |
The Suffix
data type represents the suffix for a Scheme R5RS
decimal number. It is a based 10 exponent.
number :: (MonadParsec e s m, Token s ~ Char) => m SchemeNumber Source #
The number
parser parses a Scheme R5RS number.