|
@@ -1,8 +1,15 @@
|
|
-module Data.SCargot.Common ( number
|
|
|
|
|
|
+module Data.SCargot.Common ( -- * Numeric Literal Parsers
|
|
|
|
+ binNumber
|
|
|
|
+ , signedBinNumber
|
|
|
|
+ , octNumber
|
|
|
|
+ , signedOctNumber
|
|
, decNumber
|
|
, decNumber
|
|
|
|
+ , signedDecNumber
|
|
|
|
+ , dozNumber
|
|
|
|
+ , signedDozNumber
|
|
, hexNumber
|
|
, hexNumber
|
|
- , octNumber
|
|
|
|
- , sign
|
|
|
|
|
|
+ , signedHexNumber
|
|
|
|
+ , signed
|
|
-- * Lisp Identifier Syntaxes
|
|
-- * Lisp Identifier Syntaxes
|
|
, parseR5RSIdent
|
|
, parseR5RSIdent
|
|
, parseR6RSIdent
|
|
, parseR6RSIdent
|
|
@@ -34,7 +41,7 @@ hasCategory c cs = generalCategory c `elem` cs
|
|
|
|
|
|
-- | Parse an identifier according to the R6RS Scheme standard. An
|
|
-- | Parse an identifier according to the R6RS Scheme standard. An
|
|
-- R6RS identifier may include inline hexadecimal escape sequences
|
|
-- R6RS identifier may include inline hexadecimal escape sequences
|
|
|
|
+-- so that, for example, @foo@ is equivalent to @f\x6f;o@, and is
|
|
-- more liberal than R5RS as to which Unicode characters it may
|
|
-- more liberal than R5RS as to which Unicode characters it may
|
|
-- accept.
|
|
-- accept.
|
|
parseR6RSIdent :: Parser Text
|
|
parseR6RSIdent :: Parser Text
|
|
@@ -69,8 +76,8 @@ parseR6RSIdent =
|
|
-- R7RS identifier, in addition to a typical identifier format,
|
|
-- R7RS identifier, in addition to a typical identifier format,
|
|
-- can also be a chunk of text surrounded by vertical bars that
|
|
-- can also be a chunk of text surrounded by vertical bars that
|
|
-- can contain spaces and other characters. Unlike R6RS, it does
|
|
-- can contain spaces and other characters. Unlike R6RS, it does
|
|
|
|
+-- not allow escapes to be included in identifiers unless those
|
|
|
|
+-- identifiers are surrounded by vertical bars.
|
|
parseR7RSIdent :: Parser Text
|
|
parseR7RSIdent :: Parser Text
|
|
parseR7RSIdent = T.pack <$>
|
|
parseR7RSIdent = T.pack <$>
|
|
( (:) <$> initial <*> many subsequent
|
|
( (:) <$> initial <*> many subsequent
|
|
@@ -118,33 +125,62 @@ number base digits = foldl go 0 <$> many1 digits
|
|
| c == 'e' || c == 'E' = 0xe
|
|
| c == 'e' || c == 'E' = 0xe
|
|
| c == 'f' || c == 'F' = 0xf
|
|
| c == 'f' || c == 'F' = 0xf
|
|
| c >= '0' && c <= '9' = fromEnum c - fromEnum '0'
|
|
| c >= '0' && c <= '9' = fromEnum c - fromEnum '0'
|
|
|
|
+ | c == '\x218a' = 0xa
|
|
|
|
+ | c == '\x218b' = 0xb
|
|
| otherwise = error ("Unknown letter in number: " ++ show c)
|
|
| otherwise = error ("Unknown letter in number: " ++ show c)
|
|
|
|
|
|
|
|
+sign :: Num a => Parser (a -> a)
|
|
|
|
+sign = (pure id <* char '+')
|
|
|
|
+ <|> (pure negate <* char '-')
|
|
|
|
+ <|> pure id
|
|
|
|
+
|
|
|
|
+-- | Given a parser for some kind of numeric literal, this will attempt to
|
|
|
|
+-- parse a leading @+@ or a leading @-@ and, in the latter case, negate
|
|
|
|
+-- the parsed number.
|
|
|
|
+signed :: Num a => Parser a -> Parser a
|
|
|
|
+signed p = ($) <$> sign <*> p
|
|
|
|
+
|
|
|
|
+-- | A parser for non-signed binary numbers
|
|
binNumber :: Parser Integer
|
|
binNumber :: Parser Integer
|
|
binNumber = number 2 (char '0' <|> char '1')
|
|
binNumber = number 2 (char '0' <|> char '1')
|
|
|
|
|
|
|
|
+-- | A parser for signed binary numbers, with an optional leading @+@ or @-@.
|
|
|
|
+signedBinNumber :: Parser Integer
|
|
|
|
+signedBinNumber = ($) <$> sign <*> binNumber
|
|
|
|
+
|
|
|
|
+-- | A parser for non-signed octal numbers
|
|
octNumber :: Parser Integer
|
|
octNumber :: Parser Integer
|
|
-octNumber = number 8 digit
|
|
|
|
|
|
+octNumber = number 8 (oneOf "01234567")
|
|
|
|
+
|
|
|
|
+-- | A parser for signed octal numbers, with an optional leading @+@ or @-@.
|
|
|
|
+signedOctNumber :: Parser Integer
|
|
|
|
+signedOctNumber = ($) <$> sign <*> octNumber
|
|
|
|
|
|
|
|
+-- | A parser for non-signed decimal numbers
|
|
decNumber :: Parser Integer
|
|
decNumber :: Parser Integer
|
|
decNumber = number 10 digit
|
|
decNumber = number 10 digit
|
|
|
|
|
|
|
|
+-- | A parser for signed decimal numbers, with an optional leading @+@ or @-@.
|
|
|
|
+signedDecNumber :: Parser Integer
|
|
|
|
+signedDecNumber = ($) <$> sign <*> decNumber
|
|
|
|
+
|
|
|
|
+dozDigit = digit <|> oneOf "AaBb\x218a\x218b"
|
|
|
|
+
|
|
|
|
+-- | A parser for non-signed duodecimal (dozenal) numbers. This understands both
|
|
|
|
+-- the ASCII characters @'a'@ and @'b'@ and the Unicode characters @'\x218a'@ (↊)
|
|
|
|
+-- and @'\x218b'@ (↋) as digits with the decimal values @11@ and @12@
|
|
|
|
+-- respectively.
|
|
|
|
+dozNumber :: Parser Integer
|
|
|
|
+dozNumber = number 16 dozDigit
|
|
|
|
+
|
|
|
|
+-- | A parser for signed hexadecimal numbers, with an optional leading @+@ or @-@.
|
|
|
|
+signedDozNumber :: Parser Integer
|
|
|
|
+signedDozNumber = ($) <$> sign <*> dozNumber
|
|
|
|
+
|
|
|
|
+-- | A parser for non-signed hexadecimal numbers
|
|
hexNumber :: Parser Integer
|
|
hexNumber :: Parser Integer
|
|
hexNumber = number 16 hexDigit
|
|
hexNumber = number 16 hexDigit
|
|
|
|
|
|
---
|
|
|
|
-sign :: Num a => Parser (a -> a)
|
|
|
|
-sign = (pure id <* char '+')
|
|
|
|
- <|> (pure negate <* char '-')
|
|
|
|
- <|> pure id
|
|
|
|
|
|
+-- | A parser for signed hexadecimal numbers, with an optional leading @+@ or @-@.
|
|
|
|
+signedHexNumber :: Parser Integer
|
|
|
|
+signedHexNumber = ($) <$> sign <*> hexNumber
|