module HsLit where
#include "HsVersions.h"
import HsExpr( HsExpr, pprExpr )
import BasicTypes ( FractionalLit(..),SourceText )
import Type ( Type )
import Outputable
import FastString
import PlaceHolder ( PostTc,PostRn,DataId )
import Data.ByteString (ByteString)
import Data.Data hiding ( Fixity )
data HsLit
= HsChar SourceText Char
| HsCharPrim SourceText Char
| HsString SourceText FastString
| HsStringPrim SourceText ByteString
| HsInt SourceText Integer
| HsIntPrim SourceText Integer
| HsWordPrim SourceText Integer
| HsInt64Prim SourceText Integer
| HsWord64Prim SourceText Integer
| HsInteger SourceText Integer Type
| HsRat FractionalLit Type
| HsFloatPrim FractionalLit
| HsDoublePrim FractionalLit
deriving (Data, Typeable)
instance Eq HsLit 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 id
= OverLit {
ol_val :: OverLitVal,
ol_rebindable :: PostRn id Bool,
ol_witness :: HsExpr id,
ol_type :: PostTc id Type }
deriving (Typeable)
deriving instance (DataId id) => Data (HsOverLit id)
data OverLitVal
= HsIntegral !SourceText !Integer
| HsFractional !FractionalLit
| HsIsString !SourceText !FastString
deriving (Data, Typeable)
overLitType :: HsOverLit a -> PostTc a Type
overLitType = ol_type
instance Eq (HsOverLit id) where
(OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2
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 (HsOverLit id) where
compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2
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 where
ppr (HsChar _ c) = pprHsChar c
ppr (HsCharPrim _ c) = pprPrimChar c
ppr (HsString _ s) = pprHsString s
ppr (HsStringPrim _ s) = pprHsBytes s
ppr (HsInt _ i) = integer i
ppr (HsInteger _ i _) = integer i
ppr (HsRat f _) = ppr f
ppr (HsFloatPrim f) = ppr f <> primFloatSuffix
ppr (HsDoublePrim d) = ppr d <> primDoubleSuffix
ppr (HsIntPrim _ i) = pprPrimInt i
ppr (HsWordPrim _ w) = pprPrimWord w
ppr (HsInt64Prim _ i) = pprPrimInt64 i
ppr (HsWord64Prim _ w) = pprPrimWord64 w
instance OutputableBndr id => Outputable (HsOverLit id) where
ppr (OverLit {ol_val=val, ol_witness=witness})
= ppr val <+> (ifPprDebug (parens (pprExpr witness)))
instance Outputable OverLitVal where
ppr (HsIntegral _ i) = integer i
ppr (HsFractional f) = ppr f
ppr (HsIsString _ s) = pprHsString s
pmPprHsLit :: HsLit -> SDoc
pmPprHsLit (HsChar _ c) = pprHsChar c
pmPprHsLit (HsCharPrim _ c) = pprHsChar c
pmPprHsLit (HsString _ s) = pprHsString s
pmPprHsLit (HsStringPrim _ s) = pprHsBytes s
pmPprHsLit (HsInt _ i) = integer 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