module GHC.Hs.Lit where
#include "HsVersions.h"
import GhcPrelude
import GHC.Hs.Expr( HsExpr, pprExpr )
import BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit,
negateFractionalLit,SourceText(..),pprWithSourceText,
PprPrec(..), topPrec )
import Type
import Outputable
import FastString
import GHC.Hs.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)
type instance XHsChar (GhcPass _) = SourceText
type instance XHsCharPrim (GhcPass _) = SourceText
type instance XHsString (GhcPass _) = SourceText
type instance XHsStringPrim (GhcPass _) = SourceText
type instance XHsInt (GhcPass _) = NoExtField
type instance XHsIntPrim (GhcPass _) = SourceText
type instance XHsWordPrim (GhcPass _) = SourceText
type instance XHsInt64Prim (GhcPass _) = SourceText
type instance XHsWord64Prim (GhcPass _) = SourceText
type instance XHsInteger (GhcPass _) = SourceText
type instance XHsRat (GhcPass _) = NoExtField
type instance XHsFloatPrim (GhcPass _) = NoExtField
type instance XHsDoublePrim (GhcPass _) = NoExtField
type instance XXLit (GhcPass _) = NoExtCon
instance Eq (HsLit x) where
(HsChar _ x1) == (HsChar _ x2) = x1==x2
(HsCharPrim _ x1) == (HsCharPrim _ x2) = x1==x2
(HsString _ x1) == (HsString _ x2) = x1==x2
(HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
(HsInt _ x1) == (HsInt _ x2) = x1==x2
(HsIntPrim _ x1) == (HsIntPrim _ x2) = x1==x2
(HsWordPrim _ x1) == (HsWordPrim _ x2) = x1==x2
(HsInt64Prim _ x1) == (HsInt64Prim _ x2) = x1==x2
(HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
(HsInteger _ x1 _) == (HsInteger _ x2 _) = x1==x2
(HsRat _ x1 _) == (HsRat _ x2 _) = x1==x2
(HsFloatPrim _ x1) == (HsFloatPrim _ x2) = x1==x2
(HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2
_ == _ = False
data HsOverLit p
= OverLit {
ol_ext :: (XOverLit p),
ol_val :: OverLitVal,
ol_witness :: HsExpr p}
| XOverLit
(XXOverLit p)
data OverLitTc
= OverLitTc {
ol_rebindable :: Bool,
ol_type :: Type }
deriving Data
type instance XOverLit GhcPs = NoExtField
type instance XOverLit GhcRn = Bool
type instance XOverLit GhcTc = OverLitTc
type instance XXOverLit (GhcPass _) = NoExtCon
data OverLitVal
= HsIntegral !IntegralLit
| HsFractional !FractionalLit
| HsIsString !SourceText !FastString
deriving Data
negateOverLitVal :: OverLitVal -> OverLitVal
negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
overLitType :: HsOverLit GhcTc -> Type
overLitType (OverLit (OverLitTc _ ty) _ _) = ty
overLitType (XOverLit nec) = noExtCon nec
convertLit :: (ConvertIdX a b) => HsLit a -> HsLit b
convertLit (HsChar a x) = (HsChar (convert a) x)
convertLit (HsCharPrim a x) = (HsCharPrim (convert a) x)
convertLit (HsString a x) = (HsString (convert a) x)
convertLit (HsStringPrim a x) = (HsStringPrim (convert a) x)
convertLit (HsInt a x) = (HsInt (convert a) x)
convertLit (HsIntPrim a x) = (HsIntPrim (convert a) x)
convertLit (HsWordPrim a x) = (HsWordPrim (convert a) x)
convertLit (HsInt64Prim a x) = (HsInt64Prim (convert a) x)
convertLit (HsWord64Prim a x) = (HsWord64Prim (convert a) x)
convertLit (HsInteger a x b) = (HsInteger (convert a) x b)
convertLit (HsRat a x b) = (HsRat (convert a) x b)
convertLit (HsFloatPrim a x) = (HsFloatPrim (convert a) x)
convertLit (HsDoublePrim a x) = (HsDoublePrim (convert a) x)
convertLit (XLit a) = (XLit (convert a))
instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
(OverLit _ val1 _) == (OverLit _ val2 _) = val1 == val2
(XOverLit val1) == (XOverLit val2) = val1 == val2
_ == _ = panic "Eq HsOverLit"
instance Eq OverLitVal where
(HsIntegral i1) == (HsIntegral i2) = i1 == i2
(HsFractional f1) == (HsFractional f2) = f1 == f2
(HsIsString _ s1) == (HsIsString _ s2) = s1 == s2
_ == _ = False
instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where
compare (OverLit _ val1 _) (OverLit _ val2 _) = val1 `compare` val2
compare (XOverLit val1) (XOverLit val2) = val1 `compare` val2
compare _ _ = panic "Ord HsOverLit"
instance Ord OverLitVal where
compare (HsIntegral i1) (HsIntegral i2) = i1 `compare` i2
compare (HsIntegral _) (HsFractional _) = LT
compare (HsIntegral _) (HsIsString _ _) = LT
compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2
compare (HsFractional _) (HsIntegral _) = GT
compare (HsFractional _) (HsIsString _ _) = LT
compare (HsIsString _ s1) (HsIsString _ s2) = s1 `compare` s2
compare (HsIsString _ _) (HsIntegral _) = GT
compare (HsIsString _ _) (HsFractional _) = GT
instance Outputable (HsLit (GhcPass p)) where
ppr (HsChar st c) = pprWithSourceText st (pprHsChar c)
ppr (HsCharPrim st c) = pp_st_suffix st primCharSuffix (pprPrimChar c)
ppr (HsString st s) = pprWithSourceText st (pprHsString s)
ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
ppr (HsInt _ i)
= pprWithSourceText (il_text i) (integer (il_value i))
ppr (HsInteger st i _) = pprWithSourceText st (integer i)
ppr (HsRat _ f _) = ppr f
ppr (HsFloatPrim _ f) = ppr f <> primFloatSuffix
ppr (HsDoublePrim _ d) = ppr d <> primDoubleSuffix
ppr (HsIntPrim st i) = pprWithSourceText st (pprPrimInt i)
ppr (HsWordPrim st w) = pprWithSourceText st (pprPrimWord w)
ppr (HsInt64Prim st i) = pp_st_suffix st primInt64Suffix (pprPrimInt64 i)
ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w)
ppr (XLit x) = ppr x
pp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc
pp_st_suffix NoSourceText _ doc = doc
pp_st_suffix (SourceText st) suffix _ = text st <> suffix
instance OutputableBndrId p
=> Outputable (HsOverLit (GhcPass p)) where
ppr (OverLit {ol_val=val, ol_witness=witness})
= ppr val <+> (whenPprDebug (parens (pprExpr witness)))
ppr (XOverLit x) = ppr x
instance Outputable OverLitVal where
ppr (HsIntegral i) = pprWithSourceText (il_text i) (integer (il_value i))
ppr (HsFractional f) = ppr f
ppr (HsIsString st s) = pprWithSourceText st (pprHsString s)
pmPprHsLit :: HsLit (GhcPass x) -> SDoc
pmPprHsLit (HsChar _ c) = pprHsChar c
pmPprHsLit (HsCharPrim _ c) = pprHsChar c
pmPprHsLit (HsString st s) = pprWithSourceText st (pprHsString s)
pmPprHsLit (HsStringPrim _ s) = pprHsBytes s
pmPprHsLit (HsInt _ i) = integer (il_value i)
pmPprHsLit (HsIntPrim _ i) = integer i
pmPprHsLit (HsWordPrim _ w) = integer w
pmPprHsLit (HsInt64Prim _ i) = integer i
pmPprHsLit (HsWord64Prim _ w) = integer w
pmPprHsLit (HsInteger _ i _) = integer i
pmPprHsLit (HsRat _ f _) = ppr f
pmPprHsLit (HsFloatPrim _ f) = ppr f
pmPprHsLit (HsDoublePrim _ d) = ppr d
pmPprHsLit (XLit x) = ppr x
hsLitNeedsParens :: PprPrec -> HsLit x -> Bool
hsLitNeedsParens p = go
where
go (HsChar {}) = False
go (HsCharPrim {}) = False
go (HsString {}) = False
go (HsStringPrim {}) = False
go (HsInt _ x) = p > topPrec && il_neg x
go (HsIntPrim _ x) = p > topPrec && x < 0
go (HsWordPrim {}) = False
go (HsInt64Prim _ x) = p > topPrec && x < 0
go (HsWord64Prim {}) = False
go (HsInteger _ x _) = p > topPrec && x < 0
go (HsRat _ x _) = p > topPrec && fl_neg x
go (HsFloatPrim _ x) = p > topPrec && fl_neg x
go (HsDoublePrim _ x) = p > topPrec && fl_neg x
go (XLit _) = False
hsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool
hsOverLitNeedsParens p (OverLit { ol_val = olv }) = go olv
where
go :: OverLitVal -> Bool
go (HsIntegral x) = p > topPrec && il_neg x
go (HsFractional x) = p > topPrec && fl_neg x
go (HsIsString {}) = False
hsOverLitNeedsParens _ (XOverLit { }) = False