{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Language.Haskell.Syntax.Lit where
import GHC.Prelude
import GHC.Types.Basic (PprPrec(..), topPrec )
import GHC.Types.SourceText
import GHC.Core.Type
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.FastString
import Language.Haskell.Syntax.Extension
import Data.ByteString (ByteString)
import Data.Data hiding ( Fixity )
data HsLit x
= HsChar (XHsChar x) Char
| HsCharPrim (XHsCharPrim x) Char
| HsString (XHsString x) FastString
| HsStringPrim (XHsStringPrim x) !ByteString
| HsInt (XHsInt x) IntegralLit
| HsIntPrim (XHsIntPrim x) Integer
| HsWordPrim (XHsWordPrim x) Integer
| HsInt64Prim (XHsInt64Prim x) Integer
| HsWord64Prim (XHsWord64Prim x) Integer
| HsInteger (XHsInteger x) Integer Type
| HsRat (XHsRat x) FractionalLit Type
| HsFloatPrim (XHsFloatPrim x) FractionalLit
| HsDoublePrim (XHsDoublePrim x) FractionalLit
| XLit !(XXLit x)
instance Eq (HsLit x) where
(HsChar XHsChar x
_ Char
x1) == :: HsLit x -> HsLit x -> Bool
== (HsChar XHsChar x
_ Char
x2) = Char
x1Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
x2
(HsCharPrim XHsCharPrim x
_ Char
x1) == (HsCharPrim XHsCharPrim x
_ Char
x2) = Char
x1Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
x2
(HsString XHsString x
_ FastString
x1) == (HsString XHsString x
_ FastString
x2) = FastString
x1FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
==FastString
x2
(HsStringPrim XHsStringPrim x
_ ByteString
x1) == (HsStringPrim XHsStringPrim x
_ ByteString
x2) = ByteString
x1ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==ByteString
x2
(HsInt XHsInt x
_ IntegralLit
x1) == (HsInt XHsInt x
_ IntegralLit
x2) = IntegralLit
x1IntegralLit -> IntegralLit -> Bool
forall a. Eq a => a -> a -> Bool
==IntegralLit
x2
(HsIntPrim XHsIntPrim x
_ Integer
x1) == (HsIntPrim XHsIntPrim x
_ Integer
x2) = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
(HsWordPrim XHsWordPrim x
_ Integer
x1) == (HsWordPrim XHsWordPrim x
_ Integer
x2) = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
(HsInt64Prim XHsInt64Prim x
_ Integer
x1) == (HsInt64Prim XHsInt64Prim x
_ Integer
x2) = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
(HsWord64Prim XHsWord64Prim x
_ Integer
x1) == (HsWord64Prim XHsWord64Prim x
_ Integer
x2) = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
(HsInteger XHsInteger x
_ Integer
x1 Type
_) == (HsInteger XHsInteger x
_ Integer
x2 Type
_) = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
(HsRat XHsRat x
_ FractionalLit
x1 Type
_) == (HsRat XHsRat x
_ FractionalLit
x2 Type
_) = FractionalLit
x1FractionalLit -> FractionalLit -> Bool
forall a. Eq a => a -> a -> Bool
==FractionalLit
x2
(HsFloatPrim XHsFloatPrim x
_ FractionalLit
x1) == (HsFloatPrim XHsFloatPrim x
_ FractionalLit
x2) = FractionalLit
x1FractionalLit -> FractionalLit -> Bool
forall a. Eq a => a -> a -> Bool
==FractionalLit
x2
(HsDoublePrim XHsDoublePrim x
_ FractionalLit
x1) == (HsDoublePrim XHsDoublePrim x
_ FractionalLit
x2) = FractionalLit
x1FractionalLit -> FractionalLit -> Bool
forall a. Eq a => a -> a -> Bool
==FractionalLit
x2
HsLit x
_ == HsLit x
_ = Bool
False
data HsOverLit p
= OverLit {
HsOverLit p -> XOverLit p
ol_ext :: (XOverLit p),
HsOverLit p -> OverLitVal
ol_val :: OverLitVal}
| XOverLit
!(XXOverLit p)
data OverLitVal
= HsIntegral !IntegralLit
| HsFractional !FractionalLit
| HsIsString !SourceText !FastString
deriving Typeable OverLitVal
DataType
Constr
Typeable OverLitVal
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverLitVal -> c OverLitVal)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverLitVal)
-> (OverLitVal -> Constr)
-> (OverLitVal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverLitVal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OverLitVal))
-> ((forall b. Data b => b -> b) -> OverLitVal -> OverLitVal)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r)
-> (forall u. (forall d. Data d => d -> u) -> OverLitVal -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> OverLitVal -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal)
-> Data OverLitVal
OverLitVal -> DataType
OverLitVal -> Constr
(forall b. Data b => b -> b) -> OverLitVal -> OverLitVal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverLitVal -> c OverLitVal
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverLitVal
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) -> OverLitVal -> u
forall u. (forall d. Data d => d -> u) -> OverLitVal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverLitVal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverLitVal -> c OverLitVal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverLitVal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OverLitVal)
$cHsIsString :: Constr
$cHsFractional :: Constr
$cHsIntegral :: Constr
$tOverLitVal :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
gmapMp :: (forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
gmapM :: (forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
gmapQi :: Int -> (forall d. Data d => d -> u) -> OverLitVal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OverLitVal -> u
gmapQ :: (forall d. Data d => d -> u) -> OverLitVal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OverLitVal -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
gmapT :: (forall b. Data b => b -> b) -> OverLitVal -> OverLitVal
$cgmapT :: (forall b. Data b => b -> b) -> OverLitVal -> OverLitVal
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OverLitVal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OverLitVal)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OverLitVal)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverLitVal)
dataTypeOf :: OverLitVal -> DataType
$cdataTypeOf :: OverLitVal -> DataType
toConstr :: OverLitVal -> Constr
$ctoConstr :: OverLitVal -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverLitVal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverLitVal
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverLitVal -> c OverLitVal
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverLitVal -> c OverLitVal
$cp1Data :: Typeable OverLitVal
Data
negateOverLitVal :: OverLitVal -> OverLitVal
negateOverLitVal :: OverLitVal -> OverLitVal
negateOverLitVal (HsIntegral IntegralLit
i) = IntegralLit -> OverLitVal
HsIntegral (IntegralLit -> IntegralLit
negateIntegralLit IntegralLit
i)
negateOverLitVal (HsFractional FractionalLit
f) = FractionalLit -> OverLitVal
HsFractional (FractionalLit -> FractionalLit
negateFractionalLit FractionalLit
f)
negateOverLitVal OverLitVal
_ = String -> OverLitVal
forall a. String -> a
panic String
"negateOverLitVal: argument is not a number"
instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
(OverLit XOverLit p
_ OverLitVal
val1) == :: HsOverLit p -> HsOverLit p -> Bool
== (OverLit XOverLit p
_ OverLitVal
val2) = OverLitVal
val1 OverLitVal -> OverLitVal -> Bool
forall a. Eq a => a -> a -> Bool
== OverLitVal
val2
(XOverLit XXOverLit p
val1) == (XOverLit XXOverLit p
val2) = XXOverLit p
val1 XXOverLit p -> XXOverLit p -> Bool
forall a. Eq a => a -> a -> Bool
== XXOverLit p
val2
HsOverLit p
_ == HsOverLit p
_ = String -> Bool
forall a. String -> a
panic String
"Eq HsOverLit"
instance Eq OverLitVal where
(HsIntegral IntegralLit
i1) == :: OverLitVal -> OverLitVal -> Bool
== (HsIntegral IntegralLit
i2) = IntegralLit
i1 IntegralLit -> IntegralLit -> Bool
forall a. Eq a => a -> a -> Bool
== IntegralLit
i2
(HsFractional FractionalLit
f1) == (HsFractional FractionalLit
f2) = FractionalLit
f1 FractionalLit -> FractionalLit -> Bool
forall a. Eq a => a -> a -> Bool
== FractionalLit
f2
(HsIsString SourceText
_ FastString
s1) == (HsIsString SourceText
_ FastString
s2) = FastString
s1 FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
s2
OverLitVal
_ == OverLitVal
_ = Bool
False
instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where
compare :: HsOverLit p -> HsOverLit p -> Ordering
compare (OverLit XOverLit p
_ OverLitVal
val1) (OverLit XOverLit p
_ OverLitVal
val2) = OverLitVal
val1 OverLitVal -> OverLitVal -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` OverLitVal
val2
compare (XOverLit XXOverLit p
val1) (XOverLit XXOverLit p
val2) = XXOverLit p
val1 XXOverLit p -> XXOverLit p -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` XXOverLit p
val2
compare HsOverLit p
_ HsOverLit p
_ = String -> Ordering
forall a. String -> a
panic String
"Ord HsOverLit"
instance Ord OverLitVal where
compare :: OverLitVal -> OverLitVal -> Ordering
compare (HsIntegral IntegralLit
i1) (HsIntegral IntegralLit
i2) = IntegralLit
i1 IntegralLit -> IntegralLit -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` IntegralLit
i2
compare (HsIntegral IntegralLit
_) (HsFractional FractionalLit
_) = Ordering
LT
compare (HsIntegral IntegralLit
_) (HsIsString SourceText
_ FastString
_) = Ordering
LT
compare (HsFractional FractionalLit
f1) (HsFractional FractionalLit
f2) = FractionalLit
f1 FractionalLit -> FractionalLit -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` FractionalLit
f2
compare (HsFractional FractionalLit
_) (HsIntegral IntegralLit
_) = Ordering
GT
compare (HsFractional FractionalLit
_) (HsIsString SourceText
_ FastString
_) = Ordering
LT
compare (HsIsString SourceText
_ FastString
s1) (HsIsString SourceText
_ FastString
s2) = FastString
s1 FastString -> FastString -> Ordering
`lexicalCompareFS` FastString
s2
compare (HsIsString SourceText
_ FastString
_) (HsIntegral IntegralLit
_) = Ordering
GT
compare (HsIsString SourceText
_ FastString
_) (HsFractional FractionalLit
_) = Ordering
GT
instance Outputable OverLitVal where
ppr :: OverLitVal -> SDoc
ppr (HsIntegral IntegralLit
i) = SourceText -> SDoc -> SDoc
pprWithSourceText (IntegralLit -> SourceText
il_text IntegralLit
i) (Integer -> SDoc
integer (IntegralLit -> Integer
il_value IntegralLit
i))
ppr (HsFractional FractionalLit
f) = FractionalLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr FractionalLit
f
ppr (HsIsString SourceText
st FastString
s) = SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
st (FastString -> SDoc
pprHsString FastString
s)
hsLitNeedsParens :: PprPrec -> HsLit x -> Bool
hsLitNeedsParens :: PprPrec -> HsLit x -> Bool
hsLitNeedsParens PprPrec
p = HsLit x -> Bool
go
where
go :: HsLit x -> Bool
go (HsChar {}) = Bool
False
go (HsCharPrim {}) = Bool
False
go (HsString {}) = Bool
False
go (HsStringPrim {}) = Bool
False
go (HsInt XHsInt x
_ IntegralLit
x) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec Bool -> Bool -> Bool
&& IntegralLit -> Bool
il_neg IntegralLit
x
go (HsIntPrim XHsIntPrim x
_ Integer
x) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
go (HsWordPrim {}) = Bool
False
go (HsInt64Prim XHsInt64Prim x
_ Integer
x) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
go (HsWord64Prim {}) = Bool
False
go (HsInteger XHsInteger x
_ Integer
x Type
_) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
go (HsRat XHsRat x
_ FractionalLit
x Type
_) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec Bool -> Bool -> Bool
&& FractionalLit -> Bool
fl_neg FractionalLit
x
go (HsFloatPrim XHsFloatPrim x
_ FractionalLit
x) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec Bool -> Bool -> Bool
&& FractionalLit -> Bool
fl_neg FractionalLit
x
go (HsDoublePrim XHsDoublePrim x
_ FractionalLit
x) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec Bool -> Bool -> Bool
&& FractionalLit -> Bool
fl_neg FractionalLit
x
go (XLit XXLit x
_) = Bool
False
hsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool
hsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool
hsOverLitNeedsParens PprPrec
p (OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = OverLitVal
olv }) = OverLitVal -> Bool
go OverLitVal
olv
where
go :: OverLitVal -> Bool
go :: OverLitVal -> Bool
go (HsIntegral IntegralLit
x) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec Bool -> Bool -> Bool
&& IntegralLit -> Bool
il_neg IntegralLit
x
go (HsFractional FractionalLit
x) = PprPrec
p PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
> PprPrec
topPrec Bool -> Bool -> Bool
&& FractionalLit -> Bool
fl_neg FractionalLit
x
go (HsIsString {}) = Bool
False
hsOverLitNeedsParens PprPrec
_ (XOverLit { }) = Bool
False