-- |
-- Module      :  Data.SExpresso.Language.SchemeR5RS
-- Copyright   :  © 2019 Vincent Archambault
-- License     :  0BSD
--
-- Maintainer  :  Vincent Archambault <archambault.v@gmail.com>
-- Stability   :  experimental
--
-- Module for parsing the Scheme R5RS language.
--
-- Scheme R5RS s-expressions are parsed as @'SExpr' 'SExprType'
-- 'SchemeToken'@.  Such s-expressions can be converted into a Scheme
-- R5RS datum (see 'Datum') by the function 'sexpr2Datum'.


{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- Parsing library for some parts of the Scheme R5RS language
-- as defined in section 7 of the report
-- The library does parse tab and \r\n and whitespace
module Data.SExpresso.Language.SchemeR5RS (
  -- * SchemeToken and Datum related data types and functions
  SExprType(..),
  SchemeToken(..),
  tokenParser,
  sexpr,

  Datum(..),
  sexpr2Datum,

  -- * Scheme R5RS whitespace parsers
  whitespace,
  comment,
  interTokenSpace,
  interTokenSpace1,

  -- * Individual parser for each of the constructors of SchemeToken
  identifier,
  boolean,
  character,
  stringParser,
  quote,
  quasiquote,
  comma,
  commaAt,
  dot,

  -- ** 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.
  SchemeNumber(..),
  Exactness(..),
  Complex(..),
  SReal(..),
  Sign(..),
  UInteger(..),
  Pounds,
  Precision(..),
  Suffix(..),
  number,


  ) where

import Control.Monad (mzero)
import Data.Data
import Data.Maybe
import Data.Proxy
import Data.List
import qualified Data.Char as C
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Builder as B
import Data.Foldable
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as ML
import Data.SExpresso.SExpr
import Data.SExpresso.Parse

-- | The 'SchemeToken' data type defines the atoms of an Scheme R5RS
-- s-expression. An @'SExpr' 'SExprType' 'SchemeToken'@ object
-- containning the atoms 'TQuote', 'TQuasiquote', 'TComma', 'TCommaAt'
-- and 'TDot' need futher processing in order to get what the R5RS
-- report calls a datum. See also 'Datum'.
data SchemeToken =
  -- | A boolean.
  TBoolean Bool
  -- | A number. See 'SchemeNumber'.
  | TNumber SchemeNumber
  -- | A unicode character.
  | TChar Char
  -- | A string.
  | TString T.Text
  -- | A valid R5RS identifier.
  | TIdentifier T.Text
  -- | The quote (') symbol.
  | TQuote
  -- | The quasiquote (`) symbol.
  | TQuasiquote
  -- | The comma (,) symbol.
  | TComma
  -- | The comma at (,\@) symbol.
  | TCommaAt
  -- | The dot (.) symbol.
  | TDot
  deriving (SchemeToken -> SchemeToken -> Bool
(SchemeToken -> SchemeToken -> Bool)
-> (SchemeToken -> SchemeToken -> Bool) -> Eq SchemeToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemeToken -> SchemeToken -> Bool
$c/= :: SchemeToken -> SchemeToken -> Bool
== :: SchemeToken -> SchemeToken -> Bool
$c== :: SchemeToken -> SchemeToken -> Bool
Eq, Int -> SchemeToken -> ShowS
[SchemeToken] -> ShowS
SchemeToken -> String
(Int -> SchemeToken -> ShowS)
-> (SchemeToken -> String)
-> ([SchemeToken] -> ShowS)
-> Show SchemeToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemeToken] -> ShowS
$cshowList :: [SchemeToken] -> ShowS
show :: SchemeToken -> String
$cshow :: SchemeToken -> String
showsPrec :: Int -> SchemeToken -> ShowS
$cshowsPrec :: Int -> SchemeToken -> ShowS
Show, Typeable SchemeToken
DataType
Constr
Typeable SchemeToken
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SchemeToken -> c SchemeToken)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SchemeToken)
-> (SchemeToken -> Constr)
-> (SchemeToken -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SchemeToken))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SchemeToken))
-> ((forall b. Data b => b -> b) -> SchemeToken -> SchemeToken)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SchemeToken -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SchemeToken -> r)
-> (forall u. (forall d. Data d => d -> u) -> SchemeToken -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SchemeToken -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken)
-> Data SchemeToken
SchemeToken -> DataType
SchemeToken -> Constr
(forall b. Data b => b -> b) -> SchemeToken -> SchemeToken
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemeToken -> c SchemeToken
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemeToken
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SchemeToken -> u
forall u. (forall d. Data d => d -> u) -> SchemeToken -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeToken -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeToken -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemeToken
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemeToken -> c SchemeToken
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemeToken)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SchemeToken)
$cTDot :: Constr
$cTCommaAt :: Constr
$cTComma :: Constr
$cTQuasiquote :: Constr
$cTQuote :: Constr
$cTIdentifier :: Constr
$cTString :: Constr
$cTChar :: Constr
$cTNumber :: Constr
$cTBoolean :: Constr
$tSchemeToken :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken
gmapMp :: (forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken
gmapM :: (forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemeToken -> m SchemeToken
gmapQi :: Int -> (forall d. Data d => d -> u) -> SchemeToken -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SchemeToken -> u
gmapQ :: (forall d. Data d => d -> u) -> SchemeToken -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SchemeToken -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeToken -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeToken -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeToken -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeToken -> r
gmapT :: (forall b. Data b => b -> b) -> SchemeToken -> SchemeToken
$cgmapT :: (forall b. Data b => b -> b) -> SchemeToken -> SchemeToken
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SchemeToken)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SchemeToken)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SchemeToken)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemeToken)
dataTypeOf :: SchemeToken -> DataType
$cdataTypeOf :: SchemeToken -> DataType
toConstr :: SchemeToken -> Constr
$ctoConstr :: SchemeToken -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemeToken
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemeToken
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemeToken -> c SchemeToken
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemeToken -> c SchemeToken
$cp1Data :: Typeable SchemeToken
Data)

-- | The 'tokenParser' parses a 'SchemeToken'
tokenParser :: (MonadParsec e s m, Token s ~ Char) => m SchemeToken
tokenParser :: m SchemeToken
tokenParser = (m Bool
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Bool
boolean m Bool -> (Bool -> m SchemeToken) -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemeToken -> m SchemeToken)
-> (Bool -> SchemeToken) -> Bool -> m SchemeToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> SchemeToken
TBoolean) m SchemeToken -> m SchemeToken -> m SchemeToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              -- character must come before number
              (m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
character m Char -> (Char -> m SchemeToken) -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemeToken -> m SchemeToken)
-> (Char -> SchemeToken) -> Char -> m SchemeToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> SchemeToken
TChar) m SchemeToken -> m SchemeToken -> m SchemeToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              (m Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Text
stringParser m Text -> (Text -> m SchemeToken) -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemeToken -> m SchemeToken)
-> (Text -> SchemeToken) -> Text -> m SchemeToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SchemeToken
TString) m SchemeToken -> m SchemeToken -> m SchemeToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              -- We must try number because it can conflict with
              -- the dot ex : .2 and (a . b)
              -- and identifier ex : - and -1
              (m SchemeNumber -> m SchemeNumber
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m SchemeNumber
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m SchemeNumber
number m SchemeNumber -> (SchemeNumber -> m SchemeToken) -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemeToken -> m SchemeToken)
-> (SchemeNumber -> SchemeToken) -> SchemeNumber -> m SchemeToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemeNumber -> SchemeToken
TNumber) m SchemeToken -> m SchemeToken -> m SchemeToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              (m Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Text
identifier m Text -> (Text -> m SchemeToken) -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemeToken -> m SchemeToken)
-> (Text -> SchemeToken) -> Text -> m SchemeToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SchemeToken
TIdentifier) m SchemeToken -> m SchemeToken -> m SchemeToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              (m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
quote m Char -> m SchemeToken -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return SchemeToken
TQuote) m SchemeToken -> m SchemeToken -> m SchemeToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              (m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
quasiquote m Char -> m SchemeToken -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return SchemeToken
TQuasiquote) m SchemeToken -> m SchemeToken -> m SchemeToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              -- commaAt must come before comma
              (m Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Text
commaAt m Text -> m SchemeToken -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return SchemeToken
TCommaAt) m SchemeToken -> m SchemeToken -> m SchemeToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              (m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
comma m Char -> m SchemeToken -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return SchemeToken
TComma) m SchemeToken -> m SchemeToken -> m SchemeToken
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
              (m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
dot m Char -> m SchemeToken -> m SchemeToken
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SchemeToken -> m SchemeToken
forall (m :: * -> *) a. Monad m => a -> m a
return SchemeToken
TDot)


spacingRule :: SchemeToken -> SpacingRule
spacingRule :: SchemeToken -> SpacingRule
spacingRule (TString Text
_) = SpacingRule
SOptional
spacingRule SchemeToken
TQuote = SpacingRule
SOptional
spacingRule SchemeToken
TQuasiquote  = SpacingRule
SOptional
spacingRule SchemeToken
TComma = SpacingRule
SOptional
spacingRule SchemeToken
TCommaAt = SpacingRule
SOptional
spacingRule SchemeToken
_ = SpacingRule
SMandatory

-- | 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 SExprType =
  -- | A standard list
  STList
  -- | A vector
  | STVector
  deriving (SExprType -> SExprType -> Bool
(SExprType -> SExprType -> Bool)
-> (SExprType -> SExprType -> Bool) -> Eq SExprType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SExprType -> SExprType -> Bool
$c/= :: SExprType -> SExprType -> Bool
== :: SExprType -> SExprType -> Bool
$c== :: SExprType -> SExprType -> Bool
Eq, Int -> SExprType -> ShowS
[SExprType] -> ShowS
SExprType -> String
(Int -> SExprType -> ShowS)
-> (SExprType -> String)
-> ([SExprType] -> ShowS)
-> Show SExprType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SExprType] -> ShowS
$cshowList :: [SExprType] -> ShowS
show :: SExprType -> String
$cshow :: SExprType -> String
showsPrec :: Int -> SExprType -> ShowS
$cshowsPrec :: Int -> SExprType -> ShowS
Show, Typeable SExprType
DataType
Constr
Typeable SExprType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SExprType -> c SExprType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SExprType)
-> (SExprType -> Constr)
-> (SExprType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SExprType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SExprType))
-> ((forall b. Data b => b -> b) -> SExprType -> SExprType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SExprType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SExprType -> r)
-> (forall u. (forall d. Data d => d -> u) -> SExprType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SExprType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SExprType -> m SExprType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SExprType -> m SExprType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SExprType -> m SExprType)
-> Data SExprType
SExprType -> DataType
SExprType -> Constr
(forall b. Data b => b -> b) -> SExprType -> SExprType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SExprType -> c SExprType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SExprType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SExprType -> u
forall u. (forall d. Data d => d -> u) -> SExprType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SExprType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SExprType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SExprType -> m SExprType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SExprType -> m SExprType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SExprType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SExprType -> c SExprType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SExprType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SExprType)
$cSTVector :: Constr
$cSTList :: Constr
$tSExprType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SExprType -> m SExprType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SExprType -> m SExprType
gmapMp :: (forall d. Data d => d -> m d) -> SExprType -> m SExprType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SExprType -> m SExprType
gmapM :: (forall d. Data d => d -> m d) -> SExprType -> m SExprType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SExprType -> m SExprType
gmapQi :: Int -> (forall d. Data d => d -> u) -> SExprType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SExprType -> u
gmapQ :: (forall d. Data d => d -> u) -> SExprType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SExprType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SExprType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SExprType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SExprType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SExprType -> r
gmapT :: (forall b. Data b => b -> b) -> SExprType -> SExprType
$cgmapT :: (forall b. Data b => b -> b) -> SExprType -> SExprType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SExprType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SExprType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SExprType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SExprType)
dataTypeOf :: SExprType -> DataType
$cdataTypeOf :: SExprType -> DataType
toConstr :: SExprType -> Constr
$ctoConstr :: SExprType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SExprType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SExprType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SExprType -> c SExprType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SExprType -> c SExprType
$cp1Data :: Typeable SExprType
Data)

-- | The 'sexpr' defines a 'SExprParser' to parse a Scheme R5RS
-- s-expression as an @'SExpr' 'SExprType' 'SchemeToken'@. If you also
-- want source position see the 'withLocation' function.
--
-- Space is optional before and after the following tokens:
--
-- * 'TString'
-- * 'TQuote'
-- * 'TQuasiquote'
-- * 'TComma'
-- * 'TCommaAt'
sexpr :: forall e s m . (MonadParsec e s m, Token s ~ Char) => SExprParser m SExprType SchemeToken
sexpr :: SExprParser m SExprType SchemeToken
sexpr =
  let sTag :: m SExprType
sTag = (Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
'(' m Char -> m SExprType -> m SExprType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SExprType -> m SExprType
forall (m :: * -> *) a. Monad m => a -> m a
return SExprType
STList) m SExprType -> m SExprType -> m SExprType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#(") m (Tokens s) -> m SExprType -> m SExprType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SExprType -> m SExprType
forall (m :: * -> *) a. Monad m => a -> m a
return SExprType
STVector)
      eTag :: b -> m b
eTag = \b
t -> Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
')' m Char -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
t
  in m SExprType
-> (SExprType -> m SExprType)
-> m SchemeToken
-> m ()
-> (SchemeToken -> SchemeToken -> SpacingRule)
-> SExprParser m SExprType SchemeToken
forall (m :: * -> *) b a c.
m c
-> (c -> m b)
-> m a
-> m ()
-> (a -> a -> SpacingRule)
-> SExprParser m b a
SExprParser m SExprType
sTag SExprType -> m SExprType
forall b. b -> m b
eTag m SchemeToken
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m SchemeToken
tokenParser m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
interTokenSpace1 ((SchemeToken -> SpacingRule)
-> SchemeToken -> SchemeToken -> SpacingRule
forall a. (a -> SpacingRule) -> a -> a -> SpacingRule
mkSpacingRule SchemeToken -> SpacingRule
spacingRule)

-- | The 'Datum' data type implements the Scheme R5RS definition of a Datum. See also 'sexpr2Datum'.
data Datum = DBoolean Bool
           | DNumber SchemeNumber
           | DChar Char
           | DString T.Text
           | DIdentifier T.Text
           | DList [Datum]
           | DDotList [Datum] Datum
           | DQuote Datum
           | DQuasiquote Datum
           | DComma Datum
           | DCommaAt Datum
           | DVector [Datum]
           deriving (Datum -> Datum -> Bool
(Datum -> Datum -> Bool) -> (Datum -> Datum -> Bool) -> Eq Datum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Datum -> Datum -> Bool
$c/= :: Datum -> Datum -> Bool
== :: Datum -> Datum -> Bool
$c== :: Datum -> Datum -> Bool
Eq, Int -> Datum -> ShowS
[Datum] -> ShowS
Datum -> String
(Int -> Datum -> ShowS)
-> (Datum -> String) -> ([Datum] -> ShowS) -> Show Datum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Datum] -> ShowS
$cshowList :: [Datum] -> ShowS
show :: Datum -> String
$cshow :: Datum -> String
showsPrec :: Int -> Datum -> ShowS
$cshowsPrec :: Int -> Datum -> ShowS
Show, Typeable Datum
DataType
Constr
Typeable Datum
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Datum -> c Datum)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Datum)
-> (Datum -> Constr)
-> (Datum -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Datum))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Datum))
-> ((forall b. Data b => b -> b) -> Datum -> Datum)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Datum -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Datum -> r)
-> (forall u. (forall d. Data d => d -> u) -> Datum -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Datum -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Datum -> m Datum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Datum -> m Datum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Datum -> m Datum)
-> Data Datum
Datum -> DataType
Datum -> Constr
(forall b. Data b => b -> b) -> Datum -> Datum
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Datum -> c Datum
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Datum
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Datum -> u
forall u. (forall d. Data d => d -> u) -> Datum -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Datum -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Datum -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Datum -> m Datum
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Datum -> m Datum
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Datum
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Datum -> c Datum
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Datum)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Datum)
$cDVector :: Constr
$cDCommaAt :: Constr
$cDComma :: Constr
$cDQuasiquote :: Constr
$cDQuote :: Constr
$cDDotList :: Constr
$cDList :: Constr
$cDIdentifier :: Constr
$cDString :: Constr
$cDChar :: Constr
$cDNumber :: Constr
$cDBoolean :: Constr
$tDatum :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Datum -> m Datum
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Datum -> m Datum
gmapMp :: (forall d. Data d => d -> m d) -> Datum -> m Datum
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Datum -> m Datum
gmapM :: (forall d. Data d => d -> m d) -> Datum -> m Datum
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Datum -> m Datum
gmapQi :: Int -> (forall d. Data d => d -> u) -> Datum -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Datum -> u
gmapQ :: (forall d. Data d => d -> u) -> Datum -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Datum -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Datum -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Datum -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Datum -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Datum -> r
gmapT :: (forall b. Data b => b -> b) -> Datum -> Datum
$cgmapT :: (forall b. Data b => b -> b) -> Datum -> Datum
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Datum)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Datum)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Datum)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Datum)
dataTypeOf :: Datum -> DataType
$cdataTypeOf :: Datum -> DataType
toConstr :: Datum -> Constr
$ctoConstr :: Datum -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Datum
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Datum
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Datum -> c Datum
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Datum -> c Datum
$cp1Data :: Typeable Datum
Data)

-- | 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.
sexpr2Datum :: [SExpr SExprType SchemeToken] -> Either String [Datum]
sexpr2Datum :: [SExpr SExprType SchemeToken] -> Either String [Datum]
sexpr2Datum = (SExpr SExprType SchemeToken -> [Datum] -> Either String [Datum])
-> [Datum]
-> [SExpr SExprType SchemeToken]
-> Either String [Datum]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM SExpr SExprType SchemeToken -> [Datum] -> Either String [Datum]
vectorFold []
  where vectorFold :: SExpr SExprType SchemeToken -> [Datum] -> Either String [Datum]
        vectorFold :: SExpr SExprType SchemeToken -> [Datum] -> Either String [Datum]
vectorFold (SAtom SchemeToken
TQuote) [] = String -> Either String [Datum]
forall a b. a -> Either a b
Left (String -> Either String [Datum])
-> String -> Either String [Datum]
forall a b. (a -> b) -> a -> b
$ String
"Expecting a datum after a quote"
        vectorFold (SAtom SchemeToken
TQuote) (Datum
x : [Datum]
xs) = [Datum] -> Either String [Datum]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Datum] -> Either String [Datum])
-> [Datum] -> Either String [Datum]
forall a b. (a -> b) -> a -> b
$ Datum -> Datum
DQuote Datum
x Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: [Datum]
xs
        vectorFold (SAtom SchemeToken
TQuasiquote) [] = String -> Either String [Datum]
forall a b. a -> Either a b
Left (String -> Either String [Datum])
-> String -> Either String [Datum]
forall a b. (a -> b) -> a -> b
$ String
"Expecting a datum after a quasiquote"
        vectorFold (SAtom SchemeToken
TQuasiquote) (Datum
x : [Datum]
xs) = [Datum] -> Either String [Datum]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Datum] -> Either String [Datum])
-> [Datum] -> Either String [Datum]
forall a b. (a -> b) -> a -> b
$ Datum -> Datum
DQuasiquote Datum
x Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: [Datum]
xs
        vectorFold (SAtom SchemeToken
TComma) [] = String -> Either String [Datum]
forall a b. a -> Either a b
Left (String -> Either String [Datum])
-> String -> Either String [Datum]
forall a b. (a -> b) -> a -> b
$ String
"Expecting a datum after a comma"
        vectorFold (SAtom SchemeToken
TComma) (Datum
x : [Datum]
xs) = [Datum] -> Either String [Datum]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Datum] -> Either String [Datum])
-> [Datum] -> Either String [Datum]
forall a b. (a -> b) -> a -> b
$ Datum -> Datum
DComma Datum
x Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: [Datum]
xs
        vectorFold (SAtom SchemeToken
TCommaAt) [] = String -> Either String [Datum]
forall a b. a -> Either a b
Left (String -> Either String [Datum])
-> String -> Either String [Datum]
forall a b. (a -> b) -> a -> b
$ String
"Expecting a datum after a commaAt"
        vectorFold (SAtom SchemeToken
TCommaAt) (Datum
x : [Datum]
xs) = [Datum] -> Either String [Datum]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Datum] -> Either String [Datum])
-> [Datum] -> Either String [Datum]
forall a b. (a -> b) -> a -> b
$ Datum -> Datum
DCommaAt Datum
x Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: [Datum]
xs
        vectorFold (SAtom SchemeToken
TDot) [Datum]
_ = String -> Either String [Datum]
forall a b. a -> Either a b
Left String
"Unexpected dot"
        vectorFold (SList SExprType
STVector [SExpr SExprType SchemeToken]
xs) [Datum]
acc = ((:) (Datum -> [Datum] -> [Datum])
-> ([Datum] -> Datum) -> [Datum] -> [Datum] -> [Datum]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Datum] -> Datum
DVector) ([Datum] -> [Datum] -> [Datum])
-> Either String [Datum] -> Either String ([Datum] -> [Datum])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SExpr SExprType SchemeToken] -> Either String [Datum]
sexpr2Datum [SExpr SExprType SchemeToken]
xs Either String ([Datum] -> [Datum])
-> Either String [Datum] -> Either String [Datum]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Datum] -> Either String [Datum]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Datum]
acc
        vectorFold (SList SExprType
STList [SExpr SExprType SchemeToken]
xs) [Datum]
acc =
          let chooseConstructor :: (Bool, [Datum]) -> [Datum] -> [Datum]
chooseConstructor (Bool
isDotList, [Datum]
ls) = (:) (if Bool
isDotList
                                                       then [Datum] -> Datum -> Datum
DDotList ([Datum] -> [Datum]
forall a. [a] -> [a]
init [Datum]
ls) ([Datum] -> Datum
forall a. [a] -> a
last [Datum]
ls)
                                                       else [Datum] -> Datum
DList [Datum]
ls)
          in (Bool, [Datum]) -> [Datum] -> [Datum]
chooseConstructor ((Bool, [Datum]) -> [Datum] -> [Datum])
-> Either String (Bool, [Datum])
-> Either String ([Datum] -> [Datum])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((SExpr SExprType SchemeToken
 -> (Bool, [Datum]) -> Either String (Bool, [Datum]))
-> (Bool, [Datum])
-> [SExpr SExprType SchemeToken]
-> Either String (Bool, [Datum])
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM SExpr SExprType SchemeToken
-> (Bool, [Datum]) -> Either String (Bool, [Datum])
listFold (Bool
False, []) [SExpr SExprType SchemeToken]
xs) Either String ([Datum] -> [Datum])
-> Either String [Datum] -> Either String [Datum]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Datum] -> Either String [Datum]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Datum]
acc
        vectorFold (SAtom SchemeToken
x) [Datum]
acc = [Datum] -> Either String [Datum]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Datum] -> Either String [Datum])
-> [Datum] -> Either String [Datum]
forall a b. (a -> b) -> a -> b
$ SchemeToken -> Datum
simpleToken SchemeToken
x Datum -> [Datum] -> [Datum]
forall a. a -> [a] -> [a]
: [Datum]
acc

        simpleToken :: SchemeToken -> Datum
        simpleToken :: SchemeToken -> Datum
simpleToken (TBoolean Bool
x) = Bool -> Datum
DBoolean Bool
x
        simpleToken (TNumber SchemeNumber
x) = SchemeNumber -> Datum
DNumber SchemeNumber
x
        simpleToken (TChar Char
x) = Char -> Datum
DChar Char
x
        simpleToken (TString Text
x) = Text -> Datum
DString Text
x
        simpleToken (TIdentifier Text
x) = Text -> Datum
DIdentifier Text
x
        simpleToken SchemeToken
_ = String -> Datum
forall a. HasCallStack => String -> a
error String
"simpleToken only handles a subset of SchemeToken constructors"

        listFold :: SExpr SExprType SchemeToken -> (Bool, [Datum]) -> Either String (Bool, [Datum])
        listFold :: SExpr SExprType SchemeToken
-> (Bool, [Datum]) -> Either String (Bool, [Datum])
listFold (SAtom SchemeToken
TDot) (Bool
_, [Datum
x]) = (Bool, [Datum]) -> Either String (Bool, [Datum])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, [Datum
x])
        listFold SExpr SExprType SchemeToken
x (Bool
d, [Datum]
acc) = (,) Bool
d ([Datum] -> (Bool, [Datum]))
-> Either String [Datum] -> Either String (Bool, [Datum])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SExpr SExprType SchemeToken -> [Datum] -> Either String [Datum]
vectorFold SExpr SExprType SchemeToken
x [Datum]
acc

------------------------- Whitespace and comments -------------------------
-- | The 'whitespace' parser  parses one space, tab or end of line (\\n and \\r\\n).
whitespace :: (MonadParsec e s m, Token s ~ Char) => m ()
whitespace :: m ()
whitespace = (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
' ' m Char -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
             (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'\t' m Char -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
             (m (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol m (Tokens s) -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | The 'comment' parser parses a semi-colon (;) character and
-- everything until the end of line included.
comment :: (MonadParsec e s m, Token s ~ Char) => m ()
comment :: m ()
comment = Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
';' m Char -> m (Tokens s) -> m (Tokens s)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (\Token s
c -> Char
Token s
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
Token s
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') m (Tokens s) -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          ((m (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol m (Tokens s) -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

atmosphere :: (MonadParsec e s m, Token s ~ Char) => m ()
atmosphere :: m ()
atmosphere = m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
whitespace m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
comment

-- | The 'interTokenSpace' parser parses zero or more whitespace or comment.
interTokenSpace :: (MonadParsec e s m, Token s ~ Char) => m ()
interTokenSpace :: m ()
interTokenSpace = m () -> m [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
atmosphere m [()] -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | The 'interTokenSpace1' parser parses one or more whitespace or comment.
interTokenSpace1 :: (MonadParsec e s m, Token s ~ Char) => m ()
interTokenSpace1 :: m ()
interTokenSpace1 = m () -> m [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
atmosphere m [()] -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

------------------------- Identifier -------------------------

-- | The 'identifier' parser parses a Scheme R5RS identifier.
identifier :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m T.Text
identifier :: m Text
identifier = m Text
standardIdentifier m Text -> m Text -> m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Text
peculiarIdentifier
  where standardIdentifier :: m Text
standardIdentifier = do
          Char
i <- [Token s] -> m (Token s)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token s]
initialList
          Tokens s
is <- Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (\Token s
c -> Char
Token s
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
subsequentList)
          Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Char
i Char -> ShowS
forall a. a -> [a] -> [a]
: Proxy s -> Tokens s -> [Token s]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) Tokens s
is)

initialList :: String
initialList :: String
initialList = [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"!$%&*/:<=>?^_~"

subsequentList :: String
subsequentList :: String
subsequentList = String
initialList String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+-.@"

peculiarIdentifier :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m T.Text
peculiarIdentifier :: m Text
peculiarIdentifier = (Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
'+' m Char -> m Text -> m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"+") m Text -> m Text -> m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     (Token s -> m (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
single Char
Token s
'-' m Char -> m Text -> m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"-") m Text -> m Text -> m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"...") m (Tokens s) -> m Text -> m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"...")

------------------------- Booleans -------------------------
-- | The 'boolean' parser parses a Scheme R5RS boolean (\#t or \#f).
boolean :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m Bool
boolean :: m Bool
boolean = (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#t") m (Tokens s) -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) m Bool -> m Bool -> m Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#f") m (Tokens s) -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)


------------------------- Character -------------------------
-- | The 'character' parser parses a Scheme R5RS character.
character :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m Char
character :: m Char
character = do
  Tokens s
_ <- Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#\\")
  (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"newline") m (Tokens s) -> m Char -> m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n') m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"space") m (Tokens s) -> m Char -> m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
' ') m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle

------------------------- String -------------------------
-- | The 'stringParser' parser parses a Scheme R5RS character.
stringParser :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m T.Text
stringParser :: m Text
stringParser = do
  Char
_ <- Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'"'
  Builder
xs <- m Builder
(MonadParsec e s m, Token s ~ Char) => m Builder
consume
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
L.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
B.toLazyText Builder
xs

  where consume :: (MonadParsec e s m, Token s ~ Char) => m B.Builder
        consume :: m Builder
consume = do
          Tokens s
x <- Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (\Token s
c -> Char
Token s
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Char
Token s
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"')
          Char
c <- Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'\\' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'"'
          let xB :: Builder
xB = String -> Builder
B.fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Proxy s -> Tokens s -> [Token s]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) Tokens s
x
          case Char
c of
            Char
'"' -> Builder -> m Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> m Builder) -> Builder -> m Builder
forall a b. (a -> b) -> a -> b
$ Builder
xB
            Char
_ -> do
               Char
c1 <- Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'\\' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'"'
               Builder
x2 <- m Builder
(MonadParsec e s m, Token s ~ Char) => m Builder
consume
               Builder -> m Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> m Builder) -> Builder -> m Builder
forall a b. (a -> b) -> a -> b
$ Builder
xB Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
B.fromString [Char
c1] Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x2


------------------------- Numbers -------------------------
data Radix = R2 | R8 | R10 | R16
           deriving (Radix -> Radix -> Bool
(Radix -> Radix -> Bool) -> (Radix -> Radix -> Bool) -> Eq Radix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Radix -> Radix -> Bool
$c/= :: Radix -> Radix -> Bool
== :: Radix -> Radix -> Bool
$c== :: Radix -> Radix -> Bool
Eq, Int -> Radix -> ShowS
[Radix] -> ShowS
Radix -> String
(Int -> Radix -> ShowS)
-> (Radix -> String) -> ([Radix] -> ShowS) -> Show Radix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Radix] -> ShowS
$cshowList :: [Radix] -> ShowS
show :: Radix -> String
$cshow :: Radix -> String
showsPrec :: Int -> Radix -> ShowS
$cshowsPrec :: Int -> Radix -> ShowS
Show, Typeable Radix
DataType
Constr
Typeable Radix
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Radix -> c Radix)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Radix)
-> (Radix -> Constr)
-> (Radix -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Radix))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Radix))
-> ((forall b. Data b => b -> b) -> Radix -> Radix)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Radix -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Radix -> r)
-> (forall u. (forall d. Data d => d -> u) -> Radix -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Radix -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Radix -> m Radix)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Radix -> m Radix)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Radix -> m Radix)
-> Data Radix
Radix -> DataType
Radix -> Constr
(forall b. Data b => b -> b) -> Radix -> Radix
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Radix -> c Radix
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Radix
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Radix -> u
forall u. (forall d. Data d => d -> u) -> Radix -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Radix -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Radix -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Radix -> m Radix
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Radix -> m Radix
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Radix
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Radix -> c Radix
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Radix)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Radix)
$cR16 :: Constr
$cR10 :: Constr
$cR8 :: Constr
$cR2 :: Constr
$tRadix :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Radix -> m Radix
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Radix -> m Radix
gmapMp :: (forall d. Data d => d -> m d) -> Radix -> m Radix
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Radix -> m Radix
gmapM :: (forall d. Data d => d -> m d) -> Radix -> m Radix
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Radix -> m Radix
gmapQi :: Int -> (forall d. Data d => d -> u) -> Radix -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Radix -> u
gmapQ :: (forall d. Data d => d -> u) -> Radix -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Radix -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Radix -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Radix -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Radix -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Radix -> r
gmapT :: (forall b. Data b => b -> b) -> Radix -> Radix
$cgmapT :: (forall b. Data b => b -> b) -> Radix -> Radix
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Radix)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Radix)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Radix)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Radix)
dataTypeOf :: Radix -> DataType
$cdataTypeOf :: Radix -> DataType
toConstr :: Radix -> Constr
$ctoConstr :: Radix -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Radix
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Radix
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Radix -> c Radix
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Radix -> c Radix
$cp1Data :: Typeable Radix
Data)

-- | 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.\"\"\"
data Exactness = Exact | Inexact
               deriving (Exactness -> Exactness -> Bool
(Exactness -> Exactness -> Bool)
-> (Exactness -> Exactness -> Bool) -> Eq Exactness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exactness -> Exactness -> Bool
$c/= :: Exactness -> Exactness -> Bool
== :: Exactness -> Exactness -> Bool
$c== :: Exactness -> Exactness -> Bool
Eq, Int -> Exactness -> ShowS
[Exactness] -> ShowS
Exactness -> String
(Int -> Exactness -> ShowS)
-> (Exactness -> String)
-> ([Exactness] -> ShowS)
-> Show Exactness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exactness] -> ShowS
$cshowList :: [Exactness] -> ShowS
show :: Exactness -> String
$cshow :: Exactness -> String
showsPrec :: Int -> Exactness -> ShowS
$cshowsPrec :: Int -> Exactness -> ShowS
Show, Typeable Exactness
DataType
Constr
Typeable Exactness
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Exactness -> c Exactness)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Exactness)
-> (Exactness -> Constr)
-> (Exactness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Exactness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exactness))
-> ((forall b. Data b => b -> b) -> Exactness -> Exactness)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Exactness -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Exactness -> r)
-> (forall u. (forall d. Data d => d -> u) -> Exactness -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Exactness -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Exactness -> m Exactness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Exactness -> m Exactness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Exactness -> m Exactness)
-> Data Exactness
Exactness -> DataType
Exactness -> Constr
(forall b. Data b => b -> b) -> Exactness -> Exactness
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exactness -> c Exactness
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exactness
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Exactness -> u
forall u. (forall d. Data d => d -> u) -> Exactness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Exactness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Exactness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Exactness -> m Exactness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exactness -> m Exactness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exactness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exactness -> c Exactness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Exactness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exactness)
$cInexact :: Constr
$cExact :: Constr
$tExactness :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Exactness -> m Exactness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exactness -> m Exactness
gmapMp :: (forall d. Data d => d -> m d) -> Exactness -> m Exactness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exactness -> m Exactness
gmapM :: (forall d. Data d => d -> m d) -> Exactness -> m Exactness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Exactness -> m Exactness
gmapQi :: Int -> (forall d. Data d => d -> u) -> Exactness -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Exactness -> u
gmapQ :: (forall d. Data d => d -> u) -> Exactness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Exactness -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Exactness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Exactness -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Exactness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Exactness -> r
gmapT :: (forall b. Data b => b -> b) -> Exactness -> Exactness
$cgmapT :: (forall b. Data b => b -> b) -> Exactness -> Exactness
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exactness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exactness)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Exactness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Exactness)
dataTypeOf :: Exactness -> DataType
$cdataTypeOf :: Exactness -> DataType
toConstr :: Exactness -> Constr
$ctoConstr :: Exactness -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exactness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exactness
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exactness -> c Exactness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exactness -> c Exactness
$cp1Data :: Typeable Exactness
Data)

-- | The 'Sign' datatype indicates if a number is positive ('Plus') or negative ('Minus')
data Sign = Plus | Minus
          deriving (Sign -> Sign -> Bool
(Sign -> Sign -> Bool) -> (Sign -> Sign -> Bool) -> Eq Sign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sign -> Sign -> Bool
$c/= :: Sign -> Sign -> Bool
== :: Sign -> Sign -> Bool
$c== :: Sign -> Sign -> Bool
Eq, Int -> Sign -> ShowS
[Sign] -> ShowS
Sign -> String
(Int -> Sign -> ShowS)
-> (Sign -> String) -> ([Sign] -> ShowS) -> Show Sign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sign] -> ShowS
$cshowList :: [Sign] -> ShowS
show :: Sign -> String
$cshow :: Sign -> String
showsPrec :: Int -> Sign -> ShowS
$cshowsPrec :: Int -> Sign -> ShowS
Show, Typeable Sign
DataType
Constr
Typeable Sign
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Sign -> c Sign)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Sign)
-> (Sign -> Constr)
-> (Sign -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Sign))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sign))
-> ((forall b. Data b => b -> b) -> Sign -> Sign)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Sign -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Sign -> r)
-> (forall u. (forall d. Data d => d -> u) -> Sign -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Sign -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Sign -> m Sign)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Sign -> m Sign)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Sign -> m Sign)
-> Data Sign
Sign -> DataType
Sign -> Constr
(forall b. Data b => b -> b) -> Sign -> Sign
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sign -> c Sign
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sign
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Sign -> u
forall u. (forall d. Data d => d -> u) -> Sign -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Sign -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Sign -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Sign -> m Sign
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sign -> m Sign
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sign
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sign -> c Sign
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Sign)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sign)
$cMinus :: Constr
$cPlus :: Constr
$tSign :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Sign -> m Sign
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sign -> m Sign
gmapMp :: (forall d. Data d => d -> m d) -> Sign -> m Sign
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sign -> m Sign
gmapM :: (forall d. Data d => d -> m d) -> Sign -> m Sign
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Sign -> m Sign
gmapQi :: Int -> (forall d. Data d => d -> u) -> Sign -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Sign -> u
gmapQ :: (forall d. Data d => d -> u) -> Sign -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Sign -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Sign -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Sign -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Sign -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Sign -> r
gmapT :: (forall b. Data b => b -> b) -> Sign -> Sign
$cgmapT :: (forall b. Data b => b -> b) -> Sign -> Sign
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sign)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sign)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Sign)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Sign)
dataTypeOf :: Sign -> DataType
$cdataTypeOf :: Sign -> DataType
toConstr :: Sign -> Constr
$ctoConstr :: Sign -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sign
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sign
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sign -> c Sign
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sign -> c Sign
$cp1Data :: Typeable Sign
Data)

-- | A Scheme R5RS number can have many # signs at the end. This type alias
-- indicates the number of # signs parsed.
type Pounds = Integer

-- | 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.
data UInteger =
  -- | Integer made only of digits
  UInteger Integer
  -- | 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 @UIntPounds 123 2@. Do not take
  -- the first argument as a good approximation of the number. It
  -- needs to be shifted by the number of pounds.
  | UIntPounds Integer Pounds
  -- | Integer made only of #. It can only appear as the third argument in numbers of the form @'SDecimal' _ _ _ _@.
  | UPounds Pounds
  deriving (UInteger -> UInteger -> Bool
(UInteger -> UInteger -> Bool)
-> (UInteger -> UInteger -> Bool) -> Eq UInteger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UInteger -> UInteger -> Bool
$c/= :: UInteger -> UInteger -> Bool
== :: UInteger -> UInteger -> Bool
$c== :: UInteger -> UInteger -> Bool
Eq, Int -> UInteger -> ShowS
[UInteger] -> ShowS
UInteger -> String
(Int -> UInteger -> ShowS)
-> (UInteger -> String) -> ([UInteger] -> ShowS) -> Show UInteger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UInteger] -> ShowS
$cshowList :: [UInteger] -> ShowS
show :: UInteger -> String
$cshow :: UInteger -> String
showsPrec :: Int -> UInteger -> ShowS
$cshowsPrec :: Int -> UInteger -> ShowS
Show, Typeable UInteger
DataType
Constr
Typeable UInteger
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UInteger -> c UInteger)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UInteger)
-> (UInteger -> Constr)
-> (UInteger -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UInteger))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInteger))
-> ((forall b. Data b => b -> b) -> UInteger -> UInteger)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UInteger -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UInteger -> r)
-> (forall u. (forall d. Data d => d -> u) -> UInteger -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UInteger -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UInteger -> m UInteger)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UInteger -> m UInteger)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UInteger -> m UInteger)
-> Data UInteger
UInteger -> DataType
UInteger -> Constr
(forall b. Data b => b -> b) -> UInteger -> UInteger
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInteger -> c UInteger
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInteger
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UInteger -> u
forall u. (forall d. Data d => d -> u) -> UInteger -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UInteger -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UInteger -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UInteger -> m UInteger
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UInteger -> m UInteger
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInteger
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInteger -> c UInteger
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UInteger)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInteger)
$cUPounds :: Constr
$cUIntPounds :: Constr
$cUInteger :: Constr
$tUInteger :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UInteger -> m UInteger
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UInteger -> m UInteger
gmapMp :: (forall d. Data d => d -> m d) -> UInteger -> m UInteger
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UInteger -> m UInteger
gmapM :: (forall d. Data d => d -> m d) -> UInteger -> m UInteger
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UInteger -> m UInteger
gmapQi :: Int -> (forall d. Data d => d -> u) -> UInteger -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UInteger -> u
gmapQ :: (forall d. Data d => d -> u) -> UInteger -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UInteger -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UInteger -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UInteger -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UInteger -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UInteger -> r
gmapT :: (forall b. Data b => b -> b) -> UInteger -> UInteger
$cgmapT :: (forall b. Data b => b -> b) -> UInteger -> UInteger
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInteger)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UInteger)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UInteger)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UInteger)
dataTypeOf :: UInteger -> DataType
$cdataTypeOf :: UInteger -> DataType
toConstr :: UInteger -> Constr
$ctoConstr :: UInteger -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInteger
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UInteger
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInteger -> c UInteger
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UInteger -> c UInteger
$cp1Data :: Typeable UInteger
Data)

hasPounds :: UInteger -> Bool
hasPounds :: UInteger -> Bool
hasPounds (UInteger Integer
_) = Bool
False
hasPounds UInteger
_ = Bool
True

isInexactI :: UInteger -> Bool
isInexactI :: UInteger -> Bool
isInexactI = UInteger -> Bool
hasPounds

-- | Scheme R5RS defines 5 types of machine precision for a decimal
-- number. The machine precision is specified in the suffix (see
-- 'Suffix').
data Precision =
  -- | Suffix starting with e.
  PDefault |
  -- | Suffix starting with s.
  PShort |
  -- | Suffix starting with f.
  PSingle |
  -- | Suffix starting with d.
  PDouble |
  -- | Suffix starting with l.
  PLong
  deriving (Precision -> Precision -> Bool
(Precision -> Precision -> Bool)
-> (Precision -> Precision -> Bool) -> Eq Precision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Precision -> Precision -> Bool
$c/= :: Precision -> Precision -> Bool
== :: Precision -> Precision -> Bool
$c== :: Precision -> Precision -> Bool
Eq, Int -> Precision -> ShowS
[Precision] -> ShowS
Precision -> String
(Int -> Precision -> ShowS)
-> (Precision -> String)
-> ([Precision] -> ShowS)
-> Show Precision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Precision] -> ShowS
$cshowList :: [Precision] -> ShowS
show :: Precision -> String
$cshow :: Precision -> String
showsPrec :: Int -> Precision -> ShowS
$cshowsPrec :: Int -> Precision -> ShowS
Show, Typeable Precision
DataType
Constr
Typeable Precision
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Precision -> c Precision)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Precision)
-> (Precision -> Constr)
-> (Precision -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Precision))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Precision))
-> ((forall b. Data b => b -> b) -> Precision -> Precision)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Precision -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Precision -> r)
-> (forall u. (forall d. Data d => d -> u) -> Precision -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Precision -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Precision -> m Precision)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Precision -> m Precision)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Precision -> m Precision)
-> Data Precision
Precision -> DataType
Precision -> Constr
(forall b. Data b => b -> b) -> Precision -> Precision
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Precision -> c Precision
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Precision
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Precision -> u
forall u. (forall d. Data d => d -> u) -> Precision -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Precision
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Precision -> c Precision
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Precision)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Precision)
$cPLong :: Constr
$cPDouble :: Constr
$cPSingle :: Constr
$cPShort :: Constr
$cPDefault :: Constr
$tPrecision :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Precision -> m Precision
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
gmapMp :: (forall d. Data d => d -> m d) -> Precision -> m Precision
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
gmapM :: (forall d. Data d => d -> m d) -> Precision -> m Precision
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Precision -> m Precision
gmapQi :: Int -> (forall d. Data d => d -> u) -> Precision -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Precision -> u
gmapQ :: (forall d. Data d => d -> u) -> Precision -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Precision -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Precision -> r
gmapT :: (forall b. Data b => b -> b) -> Precision -> Precision
$cgmapT :: (forall b. Data b => b -> b) -> Precision -> Precision
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Precision)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Precision)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Precision)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Precision)
dataTypeOf :: Precision -> DataType
$cdataTypeOf :: Precision -> DataType
toConstr :: Precision -> Constr
$ctoConstr :: Precision -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Precision
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Precision
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Precision -> c Precision
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Precision -> c Precision
$cp1Data :: Typeable Precision
Data)

-- | The 'Suffix' data type represents the suffix for a Scheme R5RS
-- decimal number. It is a based 10 exponent.
data Suffix = Suffix Precision Sign Integer
            deriving (Suffix -> Suffix -> Bool
(Suffix -> Suffix -> Bool)
-> (Suffix -> Suffix -> Bool) -> Eq Suffix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Suffix -> Suffix -> Bool
$c/= :: Suffix -> Suffix -> Bool
== :: Suffix -> Suffix -> Bool
$c== :: Suffix -> Suffix -> Bool
Eq, Int -> Suffix -> ShowS
[Suffix] -> ShowS
Suffix -> String
(Int -> Suffix -> ShowS)
-> (Suffix -> String) -> ([Suffix] -> ShowS) -> Show Suffix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Suffix] -> ShowS
$cshowList :: [Suffix] -> ShowS
show :: Suffix -> String
$cshow :: Suffix -> String
showsPrec :: Int -> Suffix -> ShowS
$cshowsPrec :: Int -> Suffix -> ShowS
Show, Typeable Suffix
DataType
Constr
Typeable Suffix
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Suffix -> c Suffix)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Suffix)
-> (Suffix -> Constr)
-> (Suffix -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Suffix))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Suffix))
-> ((forall b. Data b => b -> b) -> Suffix -> Suffix)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Suffix -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Suffix -> r)
-> (forall u. (forall d. Data d => d -> u) -> Suffix -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Suffix -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Suffix -> m Suffix)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Suffix -> m Suffix)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Suffix -> m Suffix)
-> Data Suffix
Suffix -> DataType
Suffix -> Constr
(forall b. Data b => b -> b) -> Suffix -> Suffix
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Suffix -> c Suffix
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Suffix
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Suffix -> u
forall u. (forall d. Data d => d -> u) -> Suffix -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Suffix -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Suffix -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Suffix -> m Suffix
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Suffix -> m Suffix
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Suffix
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Suffix -> c Suffix
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Suffix)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Suffix)
$cSuffix :: Constr
$tSuffix :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Suffix -> m Suffix
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Suffix -> m Suffix
gmapMp :: (forall d. Data d => d -> m d) -> Suffix -> m Suffix
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Suffix -> m Suffix
gmapM :: (forall d. Data d => d -> m d) -> Suffix -> m Suffix
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Suffix -> m Suffix
gmapQi :: Int -> (forall d. Data d => d -> u) -> Suffix -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Suffix -> u
gmapQ :: (forall d. Data d => d -> u) -> Suffix -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Suffix -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Suffix -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Suffix -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Suffix -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Suffix -> r
gmapT :: (forall b. Data b => b -> b) -> Suffix -> Suffix
$cgmapT :: (forall b. Data b => b -> b) -> Suffix -> Suffix
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Suffix)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Suffix)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Suffix)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Suffix)
dataTypeOf :: Suffix -> DataType
$cdataTypeOf :: Suffix -> DataType
toConstr :: Suffix -> Constr
$ctoConstr :: Suffix -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Suffix
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Suffix
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Suffix -> c Suffix
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Suffix -> c Suffix
$cp1Data :: Typeable Suffix
Data)

-- | The 'SReal' data type represents a Scheme R5RS real number.
data SReal =
  -- | A signed integer.
  SInteger Sign UInteger
  -- | A signed rational. The first number is the numerator and the
  -- second one the denominator.
  | SRational Sign UInteger UInteger
  -- | A signed decimal number. The first number appears before the
  -- dot, the second one after the dot.
  | SDecimal Sign UInteger UInteger (Maybe Suffix)
  deriving (SReal -> SReal -> Bool
(SReal -> SReal -> Bool) -> (SReal -> SReal -> Bool) -> Eq SReal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SReal -> SReal -> Bool
$c/= :: SReal -> SReal -> Bool
== :: SReal -> SReal -> Bool
$c== :: SReal -> SReal -> Bool
Eq, Int -> SReal -> ShowS
[SReal] -> ShowS
SReal -> String
(Int -> SReal -> ShowS)
-> (SReal -> String) -> ([SReal] -> ShowS) -> Show SReal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SReal] -> ShowS
$cshowList :: [SReal] -> ShowS
show :: SReal -> String
$cshow :: SReal -> String
showsPrec :: Int -> SReal -> ShowS
$cshowsPrec :: Int -> SReal -> ShowS
Show, Typeable SReal
DataType
Constr
Typeable SReal
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SReal -> c SReal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SReal)
-> (SReal -> Constr)
-> (SReal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SReal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SReal))
-> ((forall b. Data b => b -> b) -> SReal -> SReal)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SReal -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SReal -> r)
-> (forall u. (forall d. Data d => d -> u) -> SReal -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SReal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SReal -> m SReal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SReal -> m SReal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SReal -> m SReal)
-> Data SReal
SReal -> DataType
SReal -> Constr
(forall b. Data b => b -> b) -> SReal -> SReal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SReal -> c SReal
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SReal
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SReal -> u
forall u. (forall d. Data d => d -> u) -> SReal -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SReal -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SReal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SReal -> m SReal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SReal -> m SReal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SReal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SReal -> c SReal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SReal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SReal)
$cSDecimal :: Constr
$cSRational :: Constr
$cSInteger :: Constr
$tSReal :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SReal -> m SReal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SReal -> m SReal
gmapMp :: (forall d. Data d => d -> m d) -> SReal -> m SReal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SReal -> m SReal
gmapM :: (forall d. Data d => d -> m d) -> SReal -> m SReal
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SReal -> m SReal
gmapQi :: Int -> (forall d. Data d => d -> u) -> SReal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SReal -> u
gmapQ :: (forall d. Data d => d -> u) -> SReal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SReal -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SReal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SReal -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SReal -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SReal -> r
gmapT :: (forall b. Data b => b -> b) -> SReal -> SReal
$cgmapT :: (forall b. Data b => b -> b) -> SReal -> SReal
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SReal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SReal)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SReal)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SReal)
dataTypeOf :: SReal -> DataType
$cdataTypeOf :: SReal -> DataType
toConstr :: SReal -> Constr
$ctoConstr :: SReal -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SReal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SReal
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SReal -> c SReal
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SReal -> c SReal
$cp1Data :: Typeable SReal
Data)

isInexactR :: SReal -> Bool
isInexactR :: SReal -> Bool
isInexactR (SInteger Sign
_ UInteger
i) = UInteger -> Bool
isInexactI UInteger
i
isInexactR (SRational Sign
_ UInteger
i1 UInteger
i2) = UInteger -> Bool
isInexactI UInteger
i1 Bool -> Bool -> Bool
|| UInteger -> Bool
isInexactI UInteger
i2
isInexactR (SDecimal Sign
_ UInteger
_ UInteger
_ Maybe Suffix
_) = Bool
True

-- | The 'Complex' data type represents a Scheme R5RS complex number.
data Complex =
  -- | A real number.
  CReal SReal
  -- | A complex number in angular notation.
  | CAngle SReal SReal
  -- | A complex number in absolute notation.
  | CAbsolute SReal SReal
  deriving (Complex -> Complex -> Bool
(Complex -> Complex -> Bool)
-> (Complex -> Complex -> Bool) -> Eq Complex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Complex -> Complex -> Bool
$c/= :: Complex -> Complex -> Bool
== :: Complex -> Complex -> Bool
$c== :: Complex -> Complex -> Bool
Eq, Int -> Complex -> ShowS
[Complex] -> ShowS
Complex -> String
(Int -> Complex -> ShowS)
-> (Complex -> String) -> ([Complex] -> ShowS) -> Show Complex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Complex] -> ShowS
$cshowList :: [Complex] -> ShowS
show :: Complex -> String
$cshow :: Complex -> String
showsPrec :: Int -> Complex -> ShowS
$cshowsPrec :: Int -> Complex -> ShowS
Show, Typeable Complex
DataType
Constr
Typeable Complex
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Complex -> c Complex)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Complex)
-> (Complex -> Constr)
-> (Complex -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Complex))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Complex))
-> ((forall b. Data b => b -> b) -> Complex -> Complex)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Complex -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Complex -> r)
-> (forall u. (forall d. Data d => d -> u) -> Complex -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Complex -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Complex -> m Complex)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Complex -> m Complex)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Complex -> m Complex)
-> Data Complex
Complex -> DataType
Complex -> Constr
(forall b. Data b => b -> b) -> Complex -> Complex
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Complex -> c Complex
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Complex
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Complex -> u
forall u. (forall d. Data d => d -> u) -> Complex -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Complex -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Complex -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Complex -> m Complex
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Complex -> m Complex
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Complex
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Complex -> c Complex
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Complex)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Complex)
$cCAbsolute :: Constr
$cCAngle :: Constr
$cCReal :: Constr
$tComplex :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Complex -> m Complex
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Complex -> m Complex
gmapMp :: (forall d. Data d => d -> m d) -> Complex -> m Complex
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Complex -> m Complex
gmapM :: (forall d. Data d => d -> m d) -> Complex -> m Complex
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Complex -> m Complex
gmapQi :: Int -> (forall d. Data d => d -> u) -> Complex -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Complex -> u
gmapQ :: (forall d. Data d => d -> u) -> Complex -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Complex -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Complex -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Complex -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Complex -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Complex -> r
gmapT :: (forall b. Data b => b -> b) -> Complex -> Complex
$cgmapT :: (forall b. Data b => b -> b) -> Complex -> Complex
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Complex)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Complex)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Complex)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Complex)
dataTypeOf :: Complex -> DataType
$cdataTypeOf :: Complex -> DataType
toConstr :: Complex -> Constr
$ctoConstr :: Complex -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Complex
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Complex
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Complex -> c Complex
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Complex -> c Complex
$cp1Data :: Typeable Complex
Data)

isInexact :: Complex -> Bool
isInexact :: Complex -> Bool
isInexact (CReal SReal
s) = SReal -> Bool
isInexactR SReal
s
isInexact (CAngle SReal
s1 SReal
s2) = SReal -> Bool
isInexactR SReal
s1 Bool -> Bool -> Bool
|| SReal -> Bool
isInexactR SReal
s2
isInexact (CAbsolute SReal
s1 SReal
s2) = SReal -> Bool
isInexactR SReal
s1 Bool -> Bool -> Bool
|| SReal -> Bool
isInexactR SReal
s2

-- | A Scheme R5RS number is an exact or inexact complex number.
data SchemeNumber = SchemeNumber Exactness Complex
                  deriving (SchemeNumber -> SchemeNumber -> Bool
(SchemeNumber -> SchemeNumber -> Bool)
-> (SchemeNumber -> SchemeNumber -> Bool) -> Eq SchemeNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemeNumber -> SchemeNumber -> Bool
$c/= :: SchemeNumber -> SchemeNumber -> Bool
== :: SchemeNumber -> SchemeNumber -> Bool
$c== :: SchemeNumber -> SchemeNumber -> Bool
Eq, Int -> SchemeNumber -> ShowS
[SchemeNumber] -> ShowS
SchemeNumber -> String
(Int -> SchemeNumber -> ShowS)
-> (SchemeNumber -> String)
-> ([SchemeNumber] -> ShowS)
-> Show SchemeNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemeNumber] -> ShowS
$cshowList :: [SchemeNumber] -> ShowS
show :: SchemeNumber -> String
$cshow :: SchemeNumber -> String
showsPrec :: Int -> SchemeNumber -> ShowS
$cshowsPrec :: Int -> SchemeNumber -> ShowS
Show, Typeable SchemeNumber
DataType
Constr
Typeable SchemeNumber
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SchemeNumber -> c SchemeNumber)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SchemeNumber)
-> (SchemeNumber -> Constr)
-> (SchemeNumber -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SchemeNumber))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SchemeNumber))
-> ((forall b. Data b => b -> b) -> SchemeNumber -> SchemeNumber)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SchemeNumber -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SchemeNumber -> r)
-> (forall u. (forall d. Data d => d -> u) -> SchemeNumber -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SchemeNumber -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber)
-> Data SchemeNumber
SchemeNumber -> DataType
SchemeNumber -> Constr
(forall b. Data b => b -> b) -> SchemeNumber -> SchemeNumber
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemeNumber -> c SchemeNumber
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemeNumber
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SchemeNumber -> u
forall u. (forall d. Data d => d -> u) -> SchemeNumber -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeNumber -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeNumber -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemeNumber
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemeNumber -> c SchemeNumber
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemeNumber)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SchemeNumber)
$cSchemeNumber :: Constr
$tSchemeNumber :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber
gmapMp :: (forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber
gmapM :: (forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SchemeNumber -> m SchemeNumber
gmapQi :: Int -> (forall d. Data d => d -> u) -> SchemeNumber -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SchemeNumber -> u
gmapQ :: (forall d. Data d => d -> u) -> SchemeNumber -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SchemeNumber -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeNumber -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeNumber -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeNumber -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SchemeNumber -> r
gmapT :: (forall b. Data b => b -> b) -> SchemeNumber -> SchemeNumber
$cgmapT :: (forall b. Data b => b -> b) -> SchemeNumber -> SchemeNumber
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SchemeNumber)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SchemeNumber)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SchemeNumber)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SchemeNumber)
dataTypeOf :: SchemeNumber -> DataType
$cdataTypeOf :: SchemeNumber -> DataType
toConstr :: SchemeNumber -> Constr
$ctoConstr :: SchemeNumber -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemeNumber
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SchemeNumber
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemeNumber -> c SchemeNumber
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SchemeNumber -> c SchemeNumber
$cp1Data :: Typeable SchemeNumber
Data)

-- | The 'number' parser parses a Scheme R5RS number.
number :: (MonadParsec e s m, Token s ~ Char) => m SchemeNumber
number :: m SchemeNumber
number = do
  (Maybe Radix
r, Maybe Exactness
e) <- m (Maybe Radix, Maybe Exactness)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Maybe Radix, Maybe Exactness)
prefix
  Complex
c <- Radix -> m Complex
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Radix -> m Complex
complex (Radix -> Maybe Radix -> Radix
forall a. a -> Maybe a -> a
fromMaybe Radix
R10 Maybe Radix
r)
  let e' :: Exactness
e' = Exactness -> Maybe Exactness -> Exactness
forall a. a -> Maybe a -> a
fromMaybe (if Complex -> Bool
isInexact Complex
c then Exactness
Inexact else Exactness
Exact) Maybe Exactness
e
  SchemeNumber -> m SchemeNumber
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemeNumber -> m SchemeNumber) -> SchemeNumber -> m SchemeNumber
forall a b. (a -> b) -> a -> b
$ Exactness -> Complex -> SchemeNumber
SchemeNumber Exactness
e'  Complex
c

complex :: forall e s m . (MonadParsec e s m, Token s ~ Char) => Radix -> m Complex
complex :: Radix -> m Complex
complex Radix
r = do
  Maybe Sign
ms <- m Sign -> m (Maybe Sign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Sign
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Sign
sign
  case Maybe Sign
ms of
    Maybe Sign
Nothing -> Sign -> m Complex
complex' Sign
Plus
    Just Sign
s -> Sign -> m Complex
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
Sign -> m Complex
i Sign
s m Complex -> m Complex -> m Complex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sign -> m Complex
complex' Sign
s

  where
    -- Parser for +i and -i
    i :: Sign -> m Complex
i Sign
s = Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'i' m Char -> m Complex -> m Complex
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Complex -> m Complex
forall (m :: * -> *) a. Monad m => a -> m a
return (Complex -> m Complex) -> Complex -> m Complex
forall a b. (a -> b) -> a -> b
$ SReal -> SReal -> Complex
CAbsolute (Sign -> UInteger -> SReal
SInteger Sign
Plus (Integer -> UInteger
UInteger Integer
0)) (Sign -> UInteger -> SReal
SInteger Sign
s (Integer -> UInteger
UInteger Integer
1)))

    -- Parser for complex except +i and -i
    complex' :: Sign -> m Complex
complex' Sign
sr = do
      -- First parse a number
      SReal
n1 <- Radix -> Sign -> m SReal
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Radix -> Sign -> m SReal
ureal Radix
r Sign
sr
      -- Check if the number is followed by any of these characters
      Maybe Char
c <- m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'@' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'+' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'-' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'i')
      case Maybe Char
c of
          -- Plain real number
          Maybe Char
Nothing -> Complex -> m Complex
forall (m :: * -> *) a. Monad m => a -> m a
return (Complex -> m Complex) -> Complex -> m Complex
forall a b. (a -> b) -> a -> b
$ SReal -> Complex
CReal SReal
n1
          -- Complex angular number
          Just Char
'@' -> do
            SReal
n2 <- Radix -> m SReal
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Radix -> m SReal
real Radix
r
            Complex -> m Complex
forall (m :: * -> *) a. Monad m => a -> m a
return (Complex -> m Complex) -> Complex -> m Complex
forall a b. (a -> b) -> a -> b
$ SReal -> SReal -> Complex
CAngle SReal
n1 SReal
n2
          -- Pure imaginary number
          Just Char
'i' -> Complex -> m Complex
forall (m :: * -> *) a. Monad m => a -> m a
return (Complex -> m Complex) -> Complex -> m Complex
forall a b. (a -> b) -> a -> b
$ SReal -> SReal -> Complex
CAbsolute (Sign -> UInteger -> SReal
SInteger Sign
Plus (Integer -> UInteger
UInteger Integer
0)) SReal
n1
          -- Real +/- Imaginary number
          Just Char
'+' -> SReal -> Sign -> m Complex
imaginaryPart SReal
n1 Sign
Plus
          Just Char
_ -> SReal -> Sign -> m Complex
imaginaryPart SReal
n1 Sign
Minus

    imaginaryPart :: SReal -> Sign -> m Complex
imaginaryPart SReal
realN Sign
si = do
      Maybe SReal
u <- m SReal -> m (Maybe SReal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Radix -> Sign -> m SReal
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Radix -> Sign -> m SReal
ureal Radix
r Sign
si)
      Char
_ <- Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'i'
      case Maybe SReal
u of
        Maybe SReal
Nothing -> Complex -> m Complex
forall (m :: * -> *) a. Monad m => a -> m a
return (Complex -> m Complex) -> Complex -> m Complex
forall a b. (a -> b) -> a -> b
$ SReal -> SReal -> Complex
CAbsolute SReal
realN (Sign -> UInteger -> SReal
SInteger Sign
si (Integer -> UInteger
UInteger Integer
1))
        Just SReal
n2 -> Complex -> m Complex
forall (m :: * -> *) a. Monad m => a -> m a
return (Complex -> m Complex) -> Complex -> m Complex
forall a b. (a -> b) -> a -> b
$ SReal -> SReal -> Complex
CAbsolute SReal
realN SReal
n2

real :: (MonadParsec e s m, Token s ~ Char) => Radix -> m SReal
real :: Radix -> m SReal
real Radix
r = do
  Sign
s <- Sign -> m Sign -> m Sign
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Sign
Plus m Sign
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Sign
sign
  Radix -> Sign -> m SReal
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Radix -> Sign -> m SReal
ureal Radix
r Sign
s

ureal :: forall e s m . (MonadParsec e s m, Token s ~ Char) => Radix -> Sign -> m SReal
ureal :: Radix -> Sign -> m SReal
ureal Radix
r Sign
s = m SReal
dotN m SReal -> m SReal -> m SReal
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m SReal
ureal'

  where dotN :: m SReal
dotN =  do
          Char
_ <- Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'.'
          if Radix
r Radix -> Radix -> Bool
forall a. Eq a => a -> a -> Bool
/= Radix
R10
          then String -> m SReal -> m SReal
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Numbers containing decimal point must be in decimal radix" m SReal
forall (m :: * -> *) a. MonadPlus m => m a
mzero
          else do
             UInteger
n <- Radix -> m UInteger
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Radix -> m UInteger
uinteger Radix
R10
             Maybe Suffix
sf <- m Suffix -> m (Maybe Suffix)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Suffix
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Suffix
suffix
             SReal -> m SReal
forall (m :: * -> *) a. Monad m => a -> m a
return (SReal -> m SReal) -> SReal -> m SReal
forall a b. (a -> b) -> a -> b
$ Sign -> UInteger -> UInteger -> Maybe Suffix -> SReal
SDecimal Sign
s (Integer -> UInteger
UInteger Integer
0) UInteger
n Maybe Suffix
sf

        ureal' :: m SReal
ureal' = do
          -- First parse an integer
          UInteger
u1 <- Radix -> m UInteger
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Radix -> m UInteger
uinteger Radix
r
          -- Check if the integer is followed by these characters
          Maybe Char
mc <- m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'/' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'.')
          case Maybe Char
mc of
            -- Integer with or without suffix
            Maybe Char
Nothing -> UInteger -> m SReal
plainInteger UInteger
u1
            -- Rational
            Just Char
'/' -> UInteger -> m SReal
rational UInteger
u1
            -- Decimal
            Just Char
_ -> UInteger -> m SReal
decimal UInteger
u1

        plainInteger :: UInteger -> m SReal
plainInteger UInteger
u1 = do
            Maybe Suffix
sf <- m Suffix -> m (Maybe Suffix)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Suffix
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Suffix
suffix
            case Maybe Suffix
sf of
              Just Suffix
_ -> SReal -> m SReal
forall (m :: * -> *) a. Monad m => a -> m a
return (SReal -> m SReal) -> SReal -> m SReal
forall a b. (a -> b) -> a -> b
$ Sign -> UInteger -> UInteger -> Maybe Suffix -> SReal
SDecimal Sign
s UInteger
u1 (Integer -> UInteger
UInteger Integer
0) Maybe Suffix
sf
              Maybe Suffix
Nothing -> SReal -> m SReal
forall (m :: * -> *) a. Monad m => a -> m a
return (SReal -> m SReal) -> SReal -> m SReal
forall a b. (a -> b) -> a -> b
$ Sign -> UInteger -> SReal
SInteger Sign
s UInteger
u1

        rational :: UInteger -> m SReal
rational UInteger
u1 = do
          UInteger
u2 <- Radix -> m UInteger
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Radix -> m UInteger
uinteger Radix
r
          SReal -> m SReal
forall (m :: * -> *) a. Monad m => a -> m a
return (SReal -> m SReal) -> SReal -> m SReal
forall a b. (a -> b) -> a -> b
$ Sign -> UInteger -> UInteger -> SReal
SRational Sign
s UInteger
u1 UInteger
u2

        decimal :: UInteger -> m SReal
decimal UInteger
u1 = do
          if Radix
r Radix -> Radix -> Bool
forall a. Eq a => a -> a -> Bool
/= Radix
R10
          then String -> m SReal -> m SReal
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Numbers containing decimal point must be in decimal radix" m SReal
forall (m :: * -> *) a. MonadPlus m => m a
mzero
          else do
             -- If u1 has # character, only other # are
             -- allowed. Otherwise a number may be present
             Maybe Integer
n <- if UInteger -> Bool
hasPounds UInteger
u1 then Maybe Integer -> m (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing else m Integer -> m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Radix -> m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Integral a) =>
Radix -> m a
udigit Radix
R10) :: m (Maybe Integer)
             Tokens s
pounds <- Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
             Maybe Suffix
sf <- m Suffix -> m (Maybe Suffix)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Suffix
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Suffix
suffix
             let nbPounds :: Integer
nbPounds = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy s -> Tokens s -> Int
forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) Tokens s
pounds
             let u2 :: UInteger
u2 = case (UInteger -> Bool
hasPounds UInteger
u1, Integer
nbPounds, Maybe Integer
n) of
                         (Bool
True, Integer
p, Maybe Integer
_) -> Integer -> UInteger
UPounds Integer
p
                         (Bool
False, Integer
0, Maybe Integer
Nothing) -> Integer -> UInteger
UInteger Integer
0
                         (Bool
False, Integer
0, (Just Integer
x)) -> Integer -> UInteger
UInteger Integer
x
                         (Bool
False, Integer
p, Maybe Integer
Nothing) -> Integer -> UInteger
UPounds Integer
p
                         (Bool
False, Integer
p, (Just Integer
x)) -> Integer -> Integer -> UInteger
UIntPounds Integer
x Integer
p
             SReal -> m SReal
forall (m :: * -> *) a. Monad m => a -> m a
return (SReal -> m SReal) -> SReal -> m SReal
forall a b. (a -> b) -> a -> b
$ Sign -> UInteger -> UInteger -> Maybe Suffix -> SReal
SDecimal Sign
s UInteger
u1 UInteger
u2 Maybe Suffix
sf

uinteger :: forall e s m . (MonadParsec e s m, Token s ~ Char) => Radix -> m UInteger
uinteger :: Radix -> m UInteger
uinteger Radix
r = do
  Integer
n <- Radix -> m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Integral a) =>
Radix -> m a
udigit Radix
r
  Tokens s
pounds <- Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
  let nbPounds :: Integer
nbPounds = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy s -> Tokens s -> Int
forall s. Stream s => Proxy s -> Tokens s -> Int
chunkLength (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) Tokens s
pounds
  if Integer
nbPounds Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0
  then UInteger -> m UInteger
forall (m :: * -> *) a. Monad m => a -> m a
return (UInteger -> m UInteger) -> UInteger -> m UInteger
forall a b. (a -> b) -> a -> b
$ Integer -> UInteger
UInteger Integer
n
  else UInteger -> m UInteger
forall (m :: * -> *) a. Monad m => a -> m a
return (UInteger -> m UInteger) -> UInteger -> m UInteger
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> UInteger
UIntPounds Integer
n Integer
nbPounds


prefix :: (MonadParsec e s m, Token s ~ Char) => m (Maybe Radix, Maybe Exactness)
prefix :: m (Maybe Radix, Maybe Exactness)
prefix = do
  Maybe Char
x <- m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Char -> m (Maybe Char)) -> m Char -> m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'#'
  case Maybe Char
x of
    Maybe Char
Nothing -> (Maybe Radix, Maybe Exactness) -> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Radix
forall a. Maybe a
Nothing, Maybe Exactness
forall a. Maybe a
Nothing)
    Maybe Char
_ -> do
      Char
c <- Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'i' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'e' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'b' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
           Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'o' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'd' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'x'
      case Char
c of
        Char
'i' -> m Radix -> m (Maybe Radix)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Radix
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Radix
radix m (Maybe Radix)
-> (Maybe Radix -> m (Maybe Radix, Maybe Exactness))
-> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Radix
r -> (Maybe Radix, Maybe Exactness) -> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Radix
r, Exactness -> Maybe Exactness
forall a. a -> Maybe a
Just Exactness
Inexact)
        Char
'e' -> m Radix -> m (Maybe Radix)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Radix
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Radix
radix m (Maybe Radix)
-> (Maybe Radix -> m (Maybe Radix, Maybe Exactness))
-> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Radix
r -> (Maybe Radix, Maybe Exactness) -> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Radix
r, Exactness -> Maybe Exactness
forall a. a -> Maybe a
Just Exactness
Exact)
        Char
'b' -> m Exactness -> m (Maybe Exactness)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Exactness
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Exactness
exactness m (Maybe Exactness)
-> (Maybe Exactness -> m (Maybe Radix, Maybe Exactness))
-> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Exactness
e -> (Maybe Radix, Maybe Exactness) -> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a. Monad m => a -> m a
return (Radix -> Maybe Radix
forall a. a -> Maybe a
Just Radix
R2, Maybe Exactness
e)
        Char
'o' -> m Exactness -> m (Maybe Exactness)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Exactness
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Exactness
exactness m (Maybe Exactness)
-> (Maybe Exactness -> m (Maybe Radix, Maybe Exactness))
-> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Exactness
e -> (Maybe Radix, Maybe Exactness) -> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a. Monad m => a -> m a
return (Radix -> Maybe Radix
forall a. a -> Maybe a
Just Radix
R8, Maybe Exactness
e)
        Char
'd' -> m Exactness -> m (Maybe Exactness)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Exactness
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Exactness
exactness m (Maybe Exactness)
-> (Maybe Exactness -> m (Maybe Radix, Maybe Exactness))
-> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Exactness
e -> (Maybe Radix, Maybe Exactness) -> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a. Monad m => a -> m a
return (Radix -> Maybe Radix
forall a. a -> Maybe a
Just Radix
R10, Maybe Exactness
e)
        Char
_ -> m Exactness -> m (Maybe Exactness)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Exactness
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Exactness
exactness m (Maybe Exactness)
-> (Maybe Exactness -> m (Maybe Radix, Maybe Exactness))
-> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Exactness
e -> (Maybe Radix, Maybe Exactness) -> m (Maybe Radix, Maybe Exactness)
forall (m :: * -> *) a. Monad m => a -> m a
return (Radix -> Maybe Radix
forall a. a -> Maybe a
Just Radix
R16, Maybe Exactness
e)

exactness :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m Exactness
exactness :: m Exactness
exactness = (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#e") m (Tokens s) -> m Exactness -> m Exactness
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exactness -> m Exactness
forall (m :: * -> *) a. Monad m => a -> m a
return Exactness
Exact) m Exactness -> m Exactness -> m Exactness
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
            (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#i") m (Tokens s) -> m Exactness -> m Exactness
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exactness -> m Exactness
forall (m :: * -> *) a. Monad m => a -> m a
return Exactness
Inexact)

radix :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m  Radix
radix :: m Radix
radix =
  (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#b") m (Tokens s) -> m Radix -> m Radix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Radix -> m Radix
forall (m :: * -> *) a. Monad m => a -> m a
return Radix
R2) m Radix -> m Radix -> m Radix
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#o") m (Tokens s) -> m Radix -> m Radix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Radix -> m Radix
forall (m :: * -> *) a. Monad m => a -> m a
return Radix
R8) m Radix -> m Radix -> m Radix
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#d") m (Tokens s) -> m Radix -> m Radix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Radix -> m Radix
forall (m :: * -> *) a. Monad m => a -> m a
return Radix
R10) m Radix -> m Radix -> m Radix
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
"#x") m (Tokens s) -> m Radix -> m Radix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Radix -> m Radix
forall (m :: * -> *) a. Monad m => a -> m a
return Radix
R16)

udigit :: forall e s m a . (MonadParsec e s m, Token s ~ Char, Integral a) => Radix -> m a
udigit :: Radix -> m a
udigit Radix
r = do
  case Radix
r of
    Radix
R2 -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
ML.binary
    Radix
R8 -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
ML.octal
    Radix
R10 -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
ML.decimal
    Radix
R16 -> m a
hexadecimal -- ML.hexadecimal also parses uppercase "ABCDEF"
  where hexadecimal :: m a
hexadecimal = Tokens s -> a
mkNum
                      (Tokens s -> a) -> m (Tokens s) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> (Token s -> Bool) -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token s
c -> Char
Token s
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"0123456789abcdef" :: String))
                      m a -> String -> m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"hexadecimal integer"

        mkNum :: Tokens s -> a
mkNum    = (a -> Char -> a) -> a -> String -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> Char -> a
forall a. Num a => a -> Char -> a
step a
0 (String -> a) -> (Tokens s -> String) -> Tokens s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> Tokens s -> [Token s]
forall s. Stream s => Proxy s -> Tokens s -> [Token s]
chunkToTokens (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)
        step :: a -> Char -> a
step a
a Char
c = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
16 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
C.digitToInt Char
c)

sign :: (MonadParsec e s m, Token s ~ Char) => m  Sign
sign :: m Sign
sign = (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'-' m Char -> m Sign -> m Sign
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sign -> m Sign
forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Minus) m Sign -> m Sign -> m Sign
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'+' m Char -> m Sign -> m Sign
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sign -> m Sign
forall (m :: * -> *) a. Monad m => a -> m a
return Sign
Plus)

suffix :: (MonadParsec e s m, Token s ~ Char) => m Suffix
suffix :: m Suffix
suffix = do
  Precision
p <- (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'e' m Char -> m Precision -> m Precision
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Precision -> m Precision
forall (m :: * -> *) a. Monad m => a -> m a
return Precision
PDefault)  m Precision -> m Precision -> m Precision
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
's' m Char -> m Precision -> m Precision
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Precision -> m Precision
forall (m :: * -> *) a. Monad m => a -> m a
return Precision
PShort)  m Precision -> m Precision -> m Precision
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'f' m Char -> m Precision -> m Precision
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Precision -> m Precision
forall (m :: * -> *) a. Monad m => a -> m a
return Precision
PSingle) m Precision -> m Precision -> m Precision
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'd' m Char -> m Precision -> m Precision
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Precision -> m Precision
forall (m :: * -> *) a. Monad m => a -> m a
return Precision
PDouble) m Precision -> m Precision -> m Precision
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'l' m Char -> m Precision -> m Precision
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Precision -> m Precision
forall (m :: * -> *) a. Monad m => a -> m a
return Precision
PLong)
  Sign
s <- Sign -> m Sign -> m Sign
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Sign
Plus m Sign
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Sign
sign
  Integer
n <- Radix -> m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Integral a) =>
Radix -> m a
udigit Radix
R10
  Suffix -> m Suffix
forall (m :: * -> *) a. Monad m => a -> m a
return (Suffix -> m Suffix) -> Suffix -> m Suffix
forall a b. (a -> b) -> a -> b
$ Precision -> Sign -> Integer -> Suffix
Suffix Precision
p Sign
s Integer
n

------------------------- Other tokens -------------------------
-- | The 'quote' parser parses a quote character (').
quote :: (MonadParsec e s m, Token s ~ Char) => m Char
quote :: m Char
quote = Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'\''

-- | The 'quasiquote' parser parses a quasiquote character (`).
quasiquote :: (MonadParsec e s m, Token s ~ Char) => m Char
quasiquote :: m Char
quasiquote = Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'`'

-- | The 'comma' parser parses a comma (,).
comma :: (MonadParsec e s m, Token s ~ Char) => m Char
comma :: m Char
comma = Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
','

-- | The 'commaAt' parser parses a comma followed by \@ (,\@).
commaAt :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m T.Text
commaAt :: m Text
commaAt = Tokens s -> m (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk (Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) [Token s]
",@") m (Tokens s) -> m Text -> m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
",@"

-- | The 'dot' parser parses a single dot character (.).
dot :: (MonadParsec e s m, Token s ~ Char) => m Char
dot :: m Char
dot = Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'.'