From 468d7819ab0d7848c3c7910b40d0102efca43590 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Wed, 22 Nov 2017 21:28:58 +0200 Subject: Revert "Revert "trees that grow" work" Continuing work on a long-running branch This reverts commit 314bc31489f1f4cd69e913c3b1e33236b2bdf553. --- compiler/hsSyn/HsLit.hs | 71 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 56 insertions(+), 15 deletions(-) (limited to 'compiler/hsSyn/HsLit.hs') diff --git a/compiler/hsSyn/HsLit.hs b/compiler/hsSyn/HsLit.hs index 7f0864eccc..a47b0ff4fe 100644 --- a/compiler/hsSyn/HsLit.hs +++ b/compiler/hsSyn/HsLit.hs @@ -28,6 +28,7 @@ import Type ( Type ) import Outputable import FastString import HsExtension +import PlaceHolder import Data.ByteString (ByteString) import Data.Data hiding ( Fixity ) @@ -77,8 +78,25 @@ 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 @@ -99,11 +117,25 @@ instance Eq (HsLit x) where -- | Haskell Overloaded Literal data HsOverLit p = OverLit { - 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) + 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 -- Note [Literal source text] in BasicTypes for SourceText fields in -- the following @@ -119,8 +151,9 @@ negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i) negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f) negateOverLitVal _ = panic "negateOverLitVal: argument is not a number" -overLitType :: HsOverLit p -> PostTc p Type -overLitType = ol_type +overLitType :: HsOverLit GhcTc -> Type +overLitType (OverLit (OverLitTc _ ty) _ _) = ty +overLitType XOverLit{} = panic "overLitType" -- | Convert a literal from one index type to another, updating the annotations -- according to the relevant 'Convertable' instance @@ -138,6 +171,7 @@ 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] @@ -171,8 +205,10 @@ found to have. -- Comparison operations are needed when grouping literals -- for compiling pattern-matching (module MatchLit) -instance Eq (HsOverLit p) where - (OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2 +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 @@ -180,8 +216,10 @@ instance Eq OverLitVal where (HsIsString _ s1) == (HsIsString _ s2) = s1 == s2 _ == _ = False -instance Ord (HsOverLit p) where - compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2 +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 @@ -195,7 +233,7 @@ instance Ord OverLitVal where compare (HsIsString _ _) (HsFractional _) = GT -- Instance specific to GhcPs, need the SourceText -instance (SourceTextX x) => Outputable (HsLit x) where +instance (SourceTextX (GhcPass x)) => Outputable (HsLit (GhcPass x)) where ppr (HsChar st c) = pprWithSourceText (getSourceText st) (pprHsChar c) ppr (HsCharPrim st c) = pp_st_suffix (getSourceText st) primCharSuffix (pprPrimChar c) @@ -217,16 +255,18 @@ instance (SourceTextX x) => Outputable (HsLit 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 p, OutputableBndrId p) - => Outputable (HsOverLit p) where +instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass 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)) @@ -239,7 +279,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 x) => HsLit x -> SDoc +pmPprHsLit :: (SourceTextX (GhcPass x)) => HsLit (GhcPass x) -> SDoc pmPprHsLit (HsChar _ c) = pprHsChar c pmPprHsLit (HsCharPrim _ c) = pprHsChar c pmPprHsLit (HsString st s) = pprWithSourceText (getSourceText st) @@ -254,3 +294,4 @@ 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 -- cgit v1.2.1