Safe Haskell | None |
---|---|
Language | GHC2021 |
Source text
Keeping Source Text for source to source conversions
Synopsis
- data SourceText
- pprWithSourceText :: SourceText -> SDoc -> SDoc
- data IntegralLit = IL {}
- data FractionalLit = FL {}
- data StringLiteral = StringLiteral {}
- negateIntegralLit :: IntegralLit -> IntegralLit
- negateFractionalLit :: FractionalLit -> FractionalLit
- mkIntegralLit :: Integral a => a -> IntegralLit
- mkTHFractionalLit :: Rational -> FractionalLit
- rationalFromFractionalLit :: FractionalLit -> Rational
- integralFractionalLit :: Bool -> Integer -> FractionalLit
- mkSourceFractionalLit :: String -> Bool -> Integer -> Integer -> FractionalExponentBase -> FractionalLit
- data FractionalExponentBase
- fractionalLitFromRational :: Rational -> FractionalLit
- mkFractionalLit :: SourceText -> Bool -> Rational -> Integer -> FractionalExponentBase -> FractionalLit
Documentation
data SourceText Source #
SourceText FastString | |
NoSourceText | For when code is generated, e.g. TH, deriving. The pretty printer will then make its own representation of the item. |
Instances
pprWithSourceText :: SourceText -> SDoc -> SDoc Source #
Special combinator for showing string literals.
Literals
data IntegralLit Source #
Integral Literal
Used (instead of Integer) to represent negative zegative zero which is required for NegativeLiterals extension to correctly parse `-0::Double` as negative zero. See also #13211.
Instances
data FractionalLit Source #
Fractional Literal
Used (instead of Rational) to represent exactly the floating point literal that we encountered in the user's source program. This allows us to pretty-print exactly what the user wrote, which is important e.g. for floating point numbers that can't represented as Doubles (we used to via Double for pretty-printing). See also #2245. Note [FractionalLit representation] in GHC.HsToCore.Match.Literal The actual value then is: sign * fl_signi * (fl_exp_base^fl_exp) where sign = if fl_neg then (-1) else 1
For example FL { fl_neg = True, fl_signi = 5.3, fl_exp = 4, fl_exp_base = Base10 } denotes -5300
FL | |
|
Instances
Outputable FractionalLit Source # | |
Defined in GHC.Types.SourceText ppr :: FractionalLit -> SDoc Source # | |
Data FractionalLit Source # | |
Defined in GHC.Types.SourceText gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> FractionalLit -> c FractionalLit # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c FractionalLit # toConstr :: FractionalLit -> Constr # dataTypeOf :: FractionalLit -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c FractionalLit) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FractionalLit) # gmapT :: (forall b. Data b => b -> b) -> FractionalLit -> FractionalLit # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FractionalLit -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FractionalLit -> r # gmapQ :: (forall d. Data d => d -> u) -> FractionalLit -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> FractionalLit -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit # | |
Show FractionalLit Source # | |
Defined in GHC.Types.SourceText showsPrec :: Int -> FractionalLit -> ShowS # show :: FractionalLit -> String # showList :: [FractionalLit] -> ShowS # | |
Eq FractionalLit Source # | Be wary of using this instance to compare for equal *values* when exponents are large. The same value expressed in different syntactic form won't compare as equal when any of the exponents is >= 100. |
Defined in GHC.Types.SourceText (==) :: FractionalLit -> FractionalLit -> Bool # (/=) :: FractionalLit -> FractionalLit -> Bool # | |
Ord FractionalLit Source # | Be wary of using this instance to compare for equal *values* when exponents are large. The same value expressed in different syntactic form won't compare as equal when any of the exponents is >= 100. |
Defined in GHC.Types.SourceText compare :: FractionalLit -> FractionalLit -> Ordering # (<) :: FractionalLit -> FractionalLit -> Bool # (<=) :: FractionalLit -> FractionalLit -> Bool # (>) :: FractionalLit -> FractionalLit -> Bool # (>=) :: FractionalLit -> FractionalLit -> Bool # max :: FractionalLit -> FractionalLit -> FractionalLit # min :: FractionalLit -> FractionalLit -> FractionalLit # |
data StringLiteral Source #
A String Literal in the source, including its original raw format for use by source to source manipulation tools.
Instances
Outputable StringLiteral Source # | |
Defined in GHC.Types.SourceText ppr :: StringLiteral -> SDoc Source # | |
Data StringLiteral Source # | |
Defined in GHC.Types.SourceText gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> StringLiteral -> c StringLiteral # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c StringLiteral # toConstr :: StringLiteral -> Constr # dataTypeOf :: StringLiteral -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c StringLiteral) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StringLiteral) # gmapT :: (forall b. Data b => b -> b) -> StringLiteral -> StringLiteral # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> StringLiteral -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> StringLiteral -> r # gmapQ :: (forall d. Data d => d -> u) -> StringLiteral -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> StringLiteral -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral # | |
Eq StringLiteral Source # | |
Defined in GHC.Types.SourceText (==) :: StringLiteral -> StringLiteral -> Bool # (/=) :: StringLiteral -> StringLiteral -> Bool # | |
type Anno StringLiteral Source # | |
Defined in GHC.Hs.Binds |
mkIntegralLit :: Integral a => a -> IntegralLit Source #
integralFractionalLit :: Bool -> Integer -> FractionalLit Source #
The integer should already be negated if it's negative.
mkSourceFractionalLit :: String -> Bool -> Integer -> Integer -> FractionalExponentBase -> FractionalLit Source #
The arguments should already be negated if they are negative.
data FractionalExponentBase Source #
Instances
mkFractionalLit :: SourceText -> Bool -> Rational -> Integer -> FractionalExponentBase -> FractionalLit Source #