diff options
Diffstat (limited to 'compiler/hsSyn/HsLit.hs')
-rw-r--r-- | compiler/hsSyn/HsLit.hs | 71 |
1 files changed, 15 insertions, 56 deletions
diff --git a/compiler/hsSyn/HsLit.hs b/compiler/hsSyn/HsLit.hs index a47b0ff4fe..7f0864eccc 100644 --- a/compiler/hsSyn/HsLit.hs +++ b/compiler/hsSyn/HsLit.hs @@ -28,7 +28,6 @@ import Type ( Type ) import Outputable import FastString import HsExtension -import PlaceHolder import Data.ByteString (ByteString) import Data.Data hiding ( Fixity ) @@ -78,25 +77,8 @@ data HsLit x | HsDoublePrim (XHsDoublePrim x) FractionalLit -- ^ Unboxed Double - | XLit (XXLit x) - deriving instance (DataId x) => Data (HsLit 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 _) = PlaceHolder -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 _) = PlaceHolder -type instance XHsFloatPrim (GhcPass _) = PlaceHolder -type instance XHsDoublePrim (GhcPass _) = PlaceHolder -type instance XXLit (GhcPass _) = PlaceHolder - instance Eq (HsLit x) where (HsChar _ x1) == (HsChar _ x2) = x1==x2 @@ -117,25 +99,11 @@ instance Eq (HsLit x) where -- | Haskell Overloaded Literal data HsOverLit p = OverLit { - ol_ext :: (XOverLit p), - ol_val :: OverLitVal, - ol_witness :: HsExpr p} -- Note [Overloaded literal witnesses] - - | XOverLit - (XXOverLit p) -deriving instance (DataIdLR p p) => Data (HsOverLit p) - -data OverLitTc - = OverLitTc { - ol_rebindable :: Bool, -- Note [ol_rebindable] - ol_type :: Type } - deriving Data - -type instance XOverLit GhcPs = PlaceHolder -type instance XOverLit GhcRn = Bool -- Note [ol_rebindable] -type instance XOverLit GhcTc = OverLitTc - -type instance XXOverLit (GhcPass _) = PlaceHolder + ol_val :: OverLitVal, + ol_rebindable :: PostRn p Bool, -- Note [ol_rebindable] + ol_witness :: HsExpr p, -- Note [Overloaded literal witnesses] + ol_type :: PostTc p Type } +deriving instance (DataId p) => Data (HsOverLit p) -- Note [Literal source text] in BasicTypes for SourceText fields in -- the following @@ -151,9 +119,8 @@ 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{} = panic "overLitType" +overLitType :: HsOverLit p -> PostTc p Type +overLitType = ol_type -- | Convert a literal from one index type to another, updating the annotations -- according to the relevant 'Convertable' instance @@ -171,7 +138,6 @@ 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)) {- Note [ol_rebindable] @@ -205,10 +171,8 @@ found to have. -- Comparison operations are needed when grouping literals -- for compiling pattern-matching (module MatchLit) -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 (HsOverLit p) where + (OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2 instance Eq OverLitVal where (HsIntegral i1) == (HsIntegral i2) = i1 == i2 @@ -216,10 +180,8 @@ instance Eq OverLitVal where (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 (HsOverLit p) 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 @@ -233,7 +195,7 @@ instance Ord OverLitVal where compare (HsIsString _ _) (HsFractional _) = GT -- Instance specific to GhcPs, need the SourceText -instance (SourceTextX (GhcPass x)) => Outputable (HsLit (GhcPass x)) where +instance (SourceTextX x) => Outputable (HsLit x) where ppr (HsChar st c) = pprWithSourceText (getSourceText st) (pprHsChar c) ppr (HsCharPrim st c) = pp_st_suffix (getSourceText st) primCharSuffix (pprPrimChar c) @@ -255,18 +217,16 @@ instance (SourceTextX (GhcPass x)) => Outputable (HsLit (GhcPass x)) where = pp_st_suffix (getSourceText st) primInt64Suffix (pprPrimInt64 i) ppr (HsWord64Prim st w) = pp_st_suffix (getSourceText 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 -- in debug mode, print the expression that it's resolved to, too -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (HsOverLit (GhcPass p)) where +instance (SourceTextX p, OutputableBndrId p) + => Outputable (HsOverLit 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)) @@ -279,7 +239,7 @@ instance Outputable OverLitVal where -- mainly for too reasons: -- * We do not want to expose their internal representation -- * The warnings become too messy -pmPprHsLit :: (SourceTextX (GhcPass x)) => HsLit (GhcPass x) -> SDoc +pmPprHsLit :: (SourceTextX x) => HsLit x -> SDoc pmPprHsLit (HsChar _ c) = pprHsChar c pmPprHsLit (HsCharPrim _ c) = pprHsChar c pmPprHsLit (HsString st s) = pprWithSourceText (getSourceText st) @@ -294,4 +254,3 @@ 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 |