diff options
Diffstat (limited to 'compiler/GHC/Hs')
| -rw-r--r-- | compiler/GHC/Hs/Binds.hs | 93 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Decls.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Dump.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Expr.hs | 173 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Expr.hs-boot | 3 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Extension.hs | 173 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Instances.hs | 464 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Pat.hs | 48 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Utils.hs | 104 |
9 files changed, 542 insertions, 527 deletions
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs index 01c10b1ea1..074da0353a 100644 --- a/compiler/GHC/Hs/Binds.hs +++ b/compiler/GHC/Hs/Binds.hs @@ -16,6 +16,8 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@. {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module GHC.Hs.Binds where @@ -29,7 +31,7 @@ import {-# SOURCE #-} GHC.Hs.Pat ( LPat ) import GHC.Hs.Extension import GHC.Hs.Types import CoreSyn -import TcEvidence +import PprCore () -- Outputable (Tickish id) import Type import NameSet import BasicTypes @@ -218,29 +220,29 @@ data HsBindLR idL idR -- For details on above see note [Api annotations] in ApiAnnotation FunBind { - fun_ext :: XFunBind idL idR, -- ^ After the renamer, this contains - -- the locally-bound - -- free variables of this defn. - -- See Note [Bind free vars] + fun_ext :: XFunBind idL idR, + + -- ^ After the renamer (but before the type-checker), this contains the + -- locally-bound free variables of this defn. See Note [Bind free vars] + -- + -- After the type-checker, a coercion from the type of the MatchGroup + -- to the type of the Id. Example: + -- + -- @ + -- f :: Int -> forall a. a -> a + -- f x y = y + -- @ + -- + -- Then the MatchGroup will have type (Int -> a' -> a') + -- (with a free type variable a'). The coercion will take + -- a CoreExpr of this type and convert it to a CoreExpr of + -- type Int -> forall a'. a' -> a' + -- Notice that the coercion captures the free a'. fun_id :: Located (IdP idL), -- Note [fun_id in Match] in GHC.Hs.Expr fun_matches :: MatchGroup idR (LHsExpr idR), -- ^ The payload - fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of - -- the Id. Example: - -- - -- @ - -- f :: Int -> forall a. a -> a - -- f x y = y - -- @ - -- - -- Then the MatchGroup will have type (Int -> a' -> a') - -- (with a free type variable a'). The coercion will take - -- a CoreExpr of this type and convert it to a CoreExpr of - -- type Int -> forall a'. a' -> a' - -- Notice that the coercion captures the free a'. - fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any } @@ -292,7 +294,7 @@ data HsBindLR idL idR -- | Evidence bindings -- Why a list? See TcInstDcls -- Note [Typechecking plan for instance declarations] - abs_ev_binds :: [TcEvBinds], + abs_ev_binds :: [XTcEvBinds], -- | Typechecked user bindings abs_binds :: LHsBinds idL, @@ -319,8 +321,8 @@ data NPatBindTc = NPatBindTc { } deriving Data type instance XFunBind (GhcPass pL) GhcPs = NoExtField -type instance XFunBind (GhcPass pL) GhcRn = NameSet -- Free variables -type instance XFunBind (GhcPass pL) GhcTc = NameSet -- Free variables +type instance XFunBind (GhcPass pL) GhcRn = NameSet -- Free variables +type instance XFunBind (GhcPass pL) GhcTc = XHsWrapper -- See comments on FunBind.fun_ext type instance XPatBind GhcPs (GhcPass pR) = NoExtField type instance XPatBind GhcRn (GhcPass pR) = NameSet -- Free variables @@ -349,7 +351,7 @@ data ABExport p = ABE { abe_ext :: XABE p , abe_poly :: IdP p -- ^ Any INLINE pragma is attached to this Id , abe_mono :: IdP p - , abe_wrap :: HsWrapper -- ^ See Note [ABExport wrapper] + , abe_wrap :: XHsWrapper -- ^ See Note [ABExport wrapper] -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly , abe_prags :: TcSpecPrags -- ^ SPECIALISE pragmas } @@ -683,19 +685,6 @@ pprDeclList ds = pprDeeperList vcat ds emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b) emptyLocalBinds = EmptyLocalBinds noExtField --- AZ:These functions do not seem to be used at all? -isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool -isEmptyLocalBindsTc (HsValBinds _ ds) = isEmptyValBinds ds -isEmptyLocalBindsTc (HsIPBinds _ ds) = isEmptyIPBindsTc ds -isEmptyLocalBindsTc (EmptyLocalBinds _) = True -isEmptyLocalBindsTc (XHsLocalBindsLR _) = True - -isEmptyLocalBindsPR :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool -isEmptyLocalBindsPR (HsValBinds _ ds) = isEmptyValBinds ds -isEmptyLocalBindsPR (HsIPBinds _ ds) = isEmptyIPBindsPR ds -isEmptyLocalBindsPR (EmptyLocalBinds _) = True -isEmptyLocalBindsPR (XHsLocalBindsLR _) = True - eqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool eqEmptyLocalBinds (EmptyLocalBinds _) = True eqEmptyLocalBinds _ = False @@ -730,7 +719,8 @@ instance (idL ~ GhcPass pl, idR ~ GhcPass pr, => Outputable (HsBindLR idL idR) where ppr mbind = ppr_monobind mbind -ppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) +ppr_monobind :: forall idL idR. + (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR)) => HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss }) @@ -738,14 +728,15 @@ ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss }) ppr_monobind (VarBind { var_id = var, var_rhs = rhs }) = sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)] ppr_monobind (FunBind { fun_id = fun, - fun_co_fn = wrap, fun_matches = matches, - fun_tick = ticks }) + fun_tick = ticks, + fun_ext = wrap }) = pprTicks empty (if null ticks then empty else text "-- ticks = " <> ppr ticks) $$ whenPprDebug (pprBndr LetBind (unLoc fun)) $$ pprFunBind matches - $$ whenPprDebug (ppr wrap) + $$ whenPprDebug (pprIfTc @idR $ ppr wrap) + ppr_monobind (PatSynBind _ psb) = ppr psb ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars , abs_exports = exports, abs_binds = val_binds @@ -761,7 +752,7 @@ ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars , text "Exported types:" <+> vcat [pprBndr LetBind (abe_poly ex) | ex <- exports] , text "Binds:" <+> pprLHsBinds val_binds - , text "Evidence:" <+> ppr ev_binds ] + , pprIfTc @idR (text "Evidence:" <+> ppr ev_binds) ] else pprLHsBinds val_binds ppr_monobind (XHsBindsLR x) = ppr x @@ -770,7 +761,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ABExport p) where ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags }) = vcat [ ppr gbl <+> text "<=" <+> ppr lcl , nest 2 (pprTcSpecPrags prags) - , nest 2 (text "wrap:" <+> ppr wrap)] + , pprIfTc @pass $ nest 2 (text "wrap:" <+> ppr wrap) ] ppr (XABExport x) = ppr x instance (idR ~ GhcPass pr,OutputableBndrId idL, OutputableBndrId idR, @@ -825,20 +816,12 @@ data HsIPBinds id type instance XIPBinds GhcPs = NoExtField type instance XIPBinds GhcRn = NoExtField -type instance XIPBinds GhcTc = TcEvBinds -- binds uses of the - -- implicit parameters +type instance XIPBinds GhcTc = XTcEvBinds -- binds uses of the + -- implicit parameters type instance XXHsIPBinds (GhcPass p) = NoExtCon -isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool -isEmptyIPBindsPR (IPBinds _ is) = null is -isEmptyIPBindsPR (XHsIPBinds _) = True - -isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool -isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds -isEmptyIPBindsTc (XHsIPBinds _) = True - -- | Located Implicit Parameter Binding type LIPBind id = Located (IPBind id) -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a @@ -869,7 +852,7 @@ type instance XXIPBind (GhcPass p) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsIPBinds p) where ppr (IPBinds ds bs) = pprDeeperList vcat (map ppr bs) - $$ whenPprDebug (ppr ds) + $$ whenPprDebug (pprIfTc @pass $ ppr ds) ppr (XHsIPBinds x) = ppr x instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where @@ -1076,7 +1059,6 @@ data TcSpecPrags = IsDefaultMethod -- ^ Super-specialised: a default method should -- be macro-expanded at every call site | SpecPrags [LTcSpecPrag] - deriving Data -- | Located Type checker Specification Pragmas type LTcSpecPrag = Located TcSpecPrag @@ -1085,11 +1067,10 @@ type LTcSpecPrag = Located TcSpecPrag data TcSpecPrag = SpecPrag Id - HsWrapper + XHsWrapper InlinePragma -- ^ The Id to be specialised, a wrapper that specialises the -- polymorphic function, and inlining spec for the specialised function - deriving Data noSpecPrags :: TcSpecPrags noSpecPrags = SpecPrags [] diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index c43a27cef2..7ceeae8b1b 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -11,6 +11,8 @@ -- in module GHC.Hs.PlaceHolder {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Abstract syntax of global declarations. -- @@ -1956,7 +1958,10 @@ instance (p ~ GhcPass pass, OutputableBndrId p) ppr StockStrategy = text "stock" ppr AnyclassStrategy = text "anyclass" ppr NewtypeStrategy = text "newtype" - ppr (ViaStrategy ty) = text "via" <+> ppr ty + ppr (ViaStrategy ty) = text "via" <+> case ghcPass @p of + GhcPs -> ppr ty + GhcRn -> ppr ty + GhcTc -> ppr ty -- | A short description of a @DerivStrategy'@. derivStrategyName :: DerivStrategy a -> SDoc diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs index 5bdfc8668e..eec7d1d60d 100644 --- a/compiler/GHC/Hs/Dump.hs +++ b/compiler/GHC/Hs/Dump.hs @@ -4,6 +4,7 @@ -} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} -- | Contains a debug function to dump parts of the GHC.Hs AST. It uses a syb -- traversal which falls back to displaying based on the constructor name, so @@ -26,6 +27,7 @@ import Name import DataCon import SrcLoc import GHC.Hs +import GHC.Hs.Instances import OccName hiding (occName) import Var import Module @@ -39,7 +41,7 @@ data BlankSrcSpan = BlankSrcSpan | NoBlankSrcSpan -- | Show a GHC syntax tree. This parameterised because it is also used for -- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked -- out, to avoid comparing locations, only structure -showAstData :: Data a => BlankSrcSpan -> a -> SDoc +showAstData :: (DataX, Data a) => BlankSrcSpan -> a -> SDoc showAstData b a0 = blankLine $$ showAstData' a0 where showAstData' :: Data a => a -> SDoc diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index cd1a9f62bd..5db0be2b21 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -12,6 +12,9 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilyDependencies #-} -- | Abstract Haskell syntax for expressions. module GHC.Hs.Expr where @@ -30,7 +33,6 @@ import GHC.Hs.Types import GHC.Hs.Binds -- others: -import TcEvidence import CoreSyn import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) ) import Name @@ -43,8 +45,6 @@ import Util import Outputable import FastString import Type -import TcType (TcType) -import {-# SOURCE #-} TcRnTypes (TcLclEnv) -- libraries: import Data.Data hiding (Fixity(..)) @@ -93,6 +93,21 @@ type PostTcTable = [(Name, PostTcExpr)] -- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for -- @(>>=)@, and then instantiated by the type checker with its type args -- etc +type family SyntaxExpr p + +-- this allows for better type inference, because we can declare +-- SyntaxExprGhc to be injective (and closed). +type instance SyntaxExpr (GhcPass p) = SyntaxExprGhc p + +type family SyntaxExprGhc (p :: Pass) = (r :: *) | r -> p where + SyntaxExprGhc 'Parsed = NoExtField + SyntaxExprGhc 'Renamed = Maybe (HsExpr GhcRn) -- Nothing when the slot makes no sense + -- Why is the payload not just a Name? + -- See Note [Monad fail : Rebindable syntax, overloaded strings] in RnExpr + SyntaxExprGhc 'Typechecked = SyntaxExprTc + + +-- | An expression with wrappers, used for rebindable syntax -- -- This should desugar to -- @@ -100,42 +115,36 @@ type PostTcTable = [(Name, PostTcExpr)] -- > (syn_arg_wraps[1] arg1) ... -- -- where the actual arguments come from elsewhere in the AST. --- This could be defined using @GhcPass p@ and such, but it's --- harder to get it all to work out that way. ('noSyntaxExpr' is hard to --- write, for example.) -data SyntaxExpr p = SyntaxExpr { syn_expr :: HsExpr p - , syn_arg_wraps :: [HsWrapper] - , syn_res_wrap :: HsWrapper } +data SyntaxExprTc = SyntaxExpr { syn_expr :: HsExpr GhcTc + , syn_arg_wraps :: [XHsWrapper] + , syn_res_wrap :: XHsWrapper } + | NoSyntaxExpr -- when the slot just doesn't make sense -- | This is used for rebindable-syntax pieces that are too polymorphic -- for tcSyntaxOp (trS_fmap and the mzip in ParStmt) noExpr :: HsExpr (GhcPass p) noExpr = HsLit noExtField (HsString (SourceText "noExpr") (fsLit "noExpr")) -noSyntaxExpr :: SyntaxExpr (GhcPass p) +noSyntaxExpr :: forall p. IsPass p => SyntaxExpr (GhcPass p) -- Before renaming, and sometimes after, -- (if the syntax slot makes no sense) -noSyntaxExpr = SyntaxExpr { syn_expr = HsLit noExtField - (HsString NoSourceText - (fsLit "noSyntaxExpr")) - , syn_arg_wraps = [] - , syn_res_wrap = WpHole } - --- | Make a 'SyntaxExpr (HsExpr _)', missing its HsWrappers. -mkSyntaxExpr :: HsExpr (GhcPass p) -> SyntaxExpr (GhcPass p) -mkSyntaxExpr expr = SyntaxExpr { syn_expr = expr - , syn_arg_wraps = [] - , syn_res_wrap = WpHole } - --- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the --- renamer), missing its HsWrappers. +noSyntaxExpr = case pass @p of + GhcPs -> noExtField + GhcRn -> Nothing + GhcTc -> NoSyntaxExpr + +-- | Make a 'SyntaxExpr GhcRn' from an expression +-- Used only in getMonadFailOp. +-- See Note [Monad fail : Rebindable syntax, overloaded strings] in RnExpr +mkSyntaxExpr :: HsExpr GhcRn -> SyntaxExpr GhcRn +mkSyntaxExpr = Just + +-- | Make a 'SyntaxExpr' from a 'Name' (the "rn" is because this is used in the +-- renamer). mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn -mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExtField $ noLoc name - -- don't care about filling in syn_arg_wraps because we're clearly - -- not past the typechecker +mkRnSyntaxExpr name = Just $ HsVar noExtField $ noLoc name -instance (p ~ GhcPass pass, OutputableBndrId p) - => Outputable (SyntaxExpr p) where +instance OutputableBndrId GhcTc => Outputable SyntaxExprTc where ppr (SyntaxExpr { syn_expr = expr , syn_arg_wraps = arg_wraps , syn_res_wrap = res_wrap }) @@ -146,6 +155,8 @@ instance (p ~ GhcPass pass, OutputableBndrId p) <> braces (ppr res_wrap) else ppr expr + ppr NoSyntaxExpr = text "<no syntax expr>" + -- | Command Syntax Table (for Arrow syntax) type CmdSyntaxTable p = [(Name, HsExpr p)] -- See Note [CmdSyntaxTable] @@ -627,16 +638,6 @@ data HsExpr p -- See note [Pragma source text] in BasicTypes (LHsExpr p) - --------------------------------------- - -- Finally, HsWrap appears only in typechecker output - -- The contained Expr is *NOT* itself an HsWrap. - -- See Note [Detecting forced eta expansion] in DsExpr. This invariant - -- is maintained by GHC.Hs.Utils.mkHsWrap. - - | HsWrap (XWrap p) - HsWrapper -- TRANSLATION - (HsExpr p) - | XExpr (XXExpr p) -- Note [Trees that Grow] extension constructor @@ -653,12 +654,19 @@ data RecordUpdTc = RecordUpdTc -- _non-empty_ list of DataCons that have -- all the upd'd fields - , rupd_in_tys :: [Type] -- Argument types of *input* record type - , rupd_out_tys :: [Type] -- and *output* record type - -- The original type can be reconstructed - -- with conLikeResTy - , rupd_wrap :: HsWrapper -- See note [Record Update HsWrapper] - } deriving Data + , rupd_in_tys :: [Type] -- Argument types of *input* record type + , rupd_out_tys :: [Type] -- and *output* record type + -- The original type can be reconstructed + -- with conLikeResTy + , rupd_wrap :: XHsWrapper -- See note [Record Update HsWrapper] + } + +-- | HsWrap appears only in typechecker output +-- The contained Expr is *NOT* itself an HsWrap. +-- See Note [Detecting forced eta expansion] in DsExpr. This invariant +-- is maintained by GHC.Hs.Utils.mkHsWrap. +data HsWrap hs_syn = HsWrap XHsWrapper + (hs_syn GhcTc) -- --------------------------------------------------------------------- @@ -739,7 +747,10 @@ type instance XTick (GhcPass _) = NoExtField type instance XBinTick (GhcPass _) = NoExtField type instance XTickPragma (GhcPass _) = NoExtField type instance XWrap (GhcPass _) = NoExtField -type instance XXExpr (GhcPass _) = NoExtCon + +type instance XXExpr GhcPs = NoExtCon +type instance XXExpr GhcRn = NoExtCon +type instance XXExpr GhcTc = HsWrap HsExpr -- --------------------------------------------------------------------- @@ -1087,16 +1098,12 @@ ppr_expr (HsSCC _ st (StringLiteral stl lbl) expr) <+> pprWithSourceText stl (ftext lbl) <+> text "#-}", ppr expr ] -ppr_expr (HsWrap _ co_fn e) - = pprHsWrapper co_fn (\parens -> if parens then pprExpr e - else pprExpr e) - ppr_expr (HsSpliceE _ s) = pprSplice s ppr_expr (HsBracket _ b) = pprHsBracket b ppr_expr (HsRnBracketOut _ e []) = ppr e ppr_expr (HsRnBracketOut _ e ps) = ppr e $$ text "pending(rn)" <+> ppr ps ppr_expr (HsTcBracketOut _ e []) = ppr e -ppr_expr (HsTcBracketOut _ e ps) = ppr e $$ text "pending(tc)" <+> ppr ps +ppr_expr (HsTcBracketOut _ e ps) = ppr e $$ text "pending(tc)" <+> pprIfTc @p (ppr ps) ppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd))) = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr cmd] @@ -1126,15 +1133,24 @@ ppr_expr (HsTickPragma _ _ externalSrcLoc _ exp) text ")"] ppr_expr (HsRecFld _ f) = ppr f -ppr_expr (XExpr x) = ppr x +ppr_expr (XExpr x) = case pass @p of + GhcPs -> ppr x + GhcRn -> ppr x + GhcTc -> case x of + HsWrap co_fn e -> pprHsWrapper co_fn (\parens -> if parens then pprExpr e + else pprExpr e) -ppr_infix_expr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> Maybe SDoc + +ppr_infix_expr :: forall p. (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> Maybe SDoc ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v) ppr_infix_expr (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c)) ppr_infix_expr (HsRecFld _ f) = Just (pprInfixOcc f) ppr_infix_expr (HsUnboundVar _ h@TrueExprHole{}) = Just (pprInfixOcc (unboundVarOcc h)) -ppr_infix_expr (HsWrap _ _ e) = ppr_infix_expr e -ppr_infix_expr _ = Nothing +ppr_infix_expr (XExpr x) + | GhcTc <- pass @p + , HsWrap _ e <- x + = ppr_infix_expr e +ppr_infix_expr _ = Nothing ppr_apps :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) @@ -1189,7 +1205,7 @@ pprParendExpr p expr -- | @'hsExprNeedsParens' p e@ returns 'True' if the expression @e@ needs -- parentheses under precedence @p@. -hsExprNeedsParens :: PprPrec -> HsExpr p -> Bool +hsExprNeedsParens :: forall p. IsGhcPass p => PprPrec -> HsExpr p -> Bool hsExprNeedsParens p = go where go (HsVar{}) = False @@ -1223,7 +1239,6 @@ hsExprNeedsParens p = go go (ExprWithTySig{}) = p >= sigPrec go (ArithSeq{}) = False go (HsSCC{}) = p >= appPrec - go (HsWrap _ _ e) = go e go (HsSpliceE{}) = False go (HsBracket{}) = False go (HsRnBracketOut{}) = False @@ -1235,16 +1250,23 @@ hsExprNeedsParens p = go go (HsTickPragma _ _ _ _ (L _ e)) = go e go (RecordCon{}) = False go (HsRecFld{}) = False - go (XExpr{}) = True + go (XExpr x) + | GhcTc <- ghcPass @p + , HsWrap _ e <- x + = go e + + | otherwise + = True + -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true, -- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@. -parenthesizeHsExpr :: PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) +parenthesizeHsExpr :: IsPass p => PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) parenthesizeHsExpr p le@(L loc e) | hsExprNeedsParens p e = L loc (HsPar noExtField le) | otherwise = le -isAtomicHsExpr :: HsExpr id -> Bool +isAtomicHsExpr :: forall id. IsGhcPass id => HsExpr id -> Bool -- True of a single token isAtomicHsExpr (HsVar {}) = True isAtomicHsExpr (HsConLikeOut {}) = True @@ -1253,9 +1275,11 @@ isAtomicHsExpr (HsOverLit {}) = True isAtomicHsExpr (HsIPVar {}) = True isAtomicHsExpr (HsOverLabel {}) = True isAtomicHsExpr (HsUnboundVar {}) = True -isAtomicHsExpr (HsWrap _ _ e) = isAtomicHsExpr e isAtomicHsExpr (HsPar _ e) = isAtomicHsExpr (unLoc e) isAtomicHsExpr (HsRecFld{}) = True +isAtomicHsExpr (XExpr x) + | GhcTc <- ghcPass @id + , HsWrap _ e <- x = isAtomicHsExpr e isAtomicHsExpr _ = False {- @@ -1359,11 +1383,6 @@ data HsCmd id -- For details on above see note [Api annotations] in ApiAnnotation - | HsCmdWrap (XCmdWrap id) - HsWrapper - (HsCmd id) -- If cmd :: arg1 --> res - -- wrap :: arg1 "->" arg2 - -- Then (HsCmdWrap wrap cmd) :: arg2 --> res | XCmd (XXCmd id) -- Note [Trees that Grow] extension point type instance XCmdArrApp GhcPs = NoExtField @@ -1383,7 +1402,13 @@ type instance XCmdDo GhcRn = NoExtField type instance XCmdDo GhcTc = Type type instance XCmdWrap (GhcPass _) = NoExtField -type instance XXCmd (GhcPass _) = NoExtCon + +type instance XXCmd GhcPs = NoExtCon +type instance XXCmd GhcRn = NoExtCon +type instance XXCmd GhcTc = HsWrap HsCmd + -- If cmd :: arg1 --> res + -- wrap :: arg1 "->" arg2 + -- Then (XCmd (HsWrap wrap cmd)) :: arg2 --> res -- | Haskell Array Application Type data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp @@ -1475,8 +1500,6 @@ ppr_cmd (HsCmdLet _ (L _ binds) cmd) ppr_cmd (HsCmdDo _ (L _ stmts)) = pprDo ArrowExpr stmts -ppr_cmd (HsCmdWrap _ w cmd) - = pprHsWrapper w (\_ -> parens (ppr_cmd cmd)) ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp True) = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg] ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp False) @@ -1501,7 +1524,11 @@ ppr_cmd (HsCmdArrForm _ (L _ (HsConLikeOut _ c)) Infix _ [arg1, arg2]) ppr_cmd (HsCmdArrForm _ op _ _ args) = hang (text "(|" <+> ppr_lexpr op) 4 (sep (map (pprCmdArg.unLoc) args) <+> text "|)") -ppr_cmd (XCmd x) = ppr x +ppr_cmd (XCmd x) = case pass @p of + GhcPs -> ppr x + GhcRn -> ppr x + GhcTc -> case x of + HsWrap w cmd -> pprHsWrapper w (\_ -> parens (ppr_cmd cmd)) pprCmdArg :: (OutputableBndrId (GhcPass p)) => HsCmdTop (GhcPass p) -> SDoc pprCmdArg (HsCmdTop _ cmd) @@ -2417,7 +2444,7 @@ instance Data ThModFinalizers where -- These are the arguments that are passed to `TcSplice.runTopSplice` data DelayedSplice = DelayedSplice - TcLclEnv -- The local environment to run the splice in + XTcLclEnv -- The local environment to run the splice in (LHsExpr GhcRn) -- The original renamed expression TcType -- The result type of running the splice, unzonked (LHsExpr GhcTcId) -- The typechecked expression to run and splice in the result @@ -2621,10 +2648,10 @@ thBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+> thTyBrackets :: SDoc -> SDoc thTyBrackets pp_body = text "[||" <+> pp_body <+> ptext (sLit "||]") -instance Outputable PendingRnSplice where +instance OutputableAbstract GhcRn => Outputable PendingRnSplice where ppr (PendingRnSplice _ n e) = pprPendingSplice n e -instance Outputable PendingTcSplice where +instance OutputableAbstract GhcTc => Outputable PendingTcSplice where ppr (PendingTcSplice n e) = pprPendingSplice n e {- diff --git a/compiler/GHC/Hs/Expr.hs-boot b/compiler/GHC/Hs/Expr.hs-boot index 8fd8f3857a..a4b1070c77 100644 --- a/compiler/GHC/Hs/Expr.hs-boot +++ b/compiler/GHC/Hs/Expr.hs-boot @@ -20,13 +20,12 @@ type role HsCmd nominal type role MatchGroup nominal nominal type role GRHSs nominal nominal type role HsSplice nominal -type role SyntaxExpr nominal data HsExpr (i :: *) data HsCmd (i :: *) data HsSplice (i :: *) data MatchGroup (a :: *) (body :: *) data GRHSs (a :: *) (body :: *) -data SyntaxExpr (i :: *) +type family SyntaxExpr (i :: *) instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p) instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs index 35afc5f8d3..9426f4ecc2 100644 --- a/compiler/GHC/Hs/Extension.hs +++ b/compiler/GHC/Hs/Extension.hs @@ -12,6 +12,12 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types] -- in module GHC.Hs.PlaceHolder +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UndecidableSuperClasses #-} module GHC.Hs.Extension where @@ -129,10 +135,19 @@ the strict field changes described above and delete gobs of code involving code that consumes unused extension constructors. -} --- | Used as a data type index for the hsSyn AST -data GhcPass (c :: Pass) -deriving instance Eq (GhcPass c) -deriving instance Typeable c => Data (GhcPass c) +-- | Used as a data type index for the hsSyn AST; also serves +-- as a singleton type for Pass +data GhcPass (c :: Pass) where + GhcPs :: GhcPs + GhcRn :: GhcRn + GhcTc :: GhcTc + +-- This really should never be entered, but the data-deriving machinery +-- needs the instance to exist. +instance Typeable p => Data (GhcPass p) where + gunfold _ _ _ = panic "instance Data GhcPass" + toConstr _ = panic "instance Data GhcPass" + dataTypeOf _ = panic "instance Data GhcPass" data Pass = Parsed | Renamed | Typechecked deriving (Data) @@ -143,6 +158,35 @@ type GhcRn = GhcPass 'Renamed -- Old 'Name' type param type GhcTc = GhcPass 'Typechecked -- Old 'Id' type para, type GhcTcId = GhcTc -- Old 'TcId' type param +-- | Allows us to check what phase we're in at GHC's runtime. +-- For example, this class allows us to write +-- > f :: forall p. IsGhcPass p => HsExpr p -> blah +-- > f e = case ghcPass @p of +-- > GhcPs -> ... in this RHS we have HsExpr GhcPs... +-- > GhcRn -> ... in this RHS we have HsExpr GhcRn... +-- > GhcTc -> ... in this RHS we have HsExpr GhcTc... +-- which is very useful, for example, when pretty-printing. +class (p ~ GhcPass (GetPass p), IsGhcPass (NoGhcTc p), NoGhcTc p ~ NoGhcTc (NoGhcTc p)) => IsGhcPass p where + type GetPass p :: Pass + ghcPass :: GhcPass (GetPass p) + +instance IsGhcPass GhcPs where + type GetPass GhcPs = 'Parsed + ghcPass = GhcPs +instance IsGhcPass GhcRn where + type GetPass GhcRn = 'Renamed + ghcPass = GhcRn +instance IsGhcPass GhcTc where + type GetPass GhcTc = 'Typechecked + ghcPass = GhcTc + +-- | This variant of 'IsGhcPass' is convenient when you have (p :: Pass) +type IsPass p = IsGhcPass (GhcPass p) + +-- | This variant of 'ghcPass' is convenient when you have (p :: Pass) +pass :: forall p. IsPass p => GhcPass p +pass = ghcPass @(GhcPass p) + -- | Maps the "normal" id type for a given pass type family IdP p type instance IdP GhcPs = RdrName @@ -1130,37 +1174,6 @@ type ConvertIdX a b = -- ---------------------------------------------------------------------- --- Note [OutputableX] --- ~~~~~~~~~~~~~~~~~~ --- --- is required because the type family resolution --- process cannot determine that all cases are handled for a `GhcPass p` --- case where the cases are listed separately. --- --- So --- --- type instance XXHsIPBinds (GhcPass p) = NoExtCon --- --- will correctly deduce Outputable for (GhcPass p), but --- --- type instance XIPBinds GhcPs = NoExt --- type instance XIPBinds GhcRn = NoExt --- type instance XIPBinds GhcTc = TcEvBinds --- --- will not. - - --- | Provide a summary constraint that gives all am Outputable constraint to --- extension points needing one -type OutputableX p = -- See Note [OutputableX] - ( Outputable (XIPBinds p) - , Outputable (XViaStrategy p) - , Outputable (XViaStrategy GhcRn) - ) --- TODO: Should OutputableX be included in OutputableBndrId? - --- ---------------------------------------------------------------------- - -- |Constraint type to bundle up the requirement for 'OutputableBndr' on both -- the @id@ and the 'NameOrRdrName' type for it type OutputableBndrId id = @@ -1168,7 +1181,91 @@ type OutputableBndrId id = , OutputableBndr (IdP id) , OutputableBndr (NameOrRdrName (IdP (NoGhcTc id))) , OutputableBndr (IdP (NoGhcTc id)) - , NoGhcTc id ~ NoGhcTc (NoGhcTc id) - , OutputableX id - , OutputableX (NoGhcTc id) + , OutputableAbstract id + , OutputableAbstract (NoGhcTc id) + , IsGhcPass id ) + +-- useful helper functions: +pprIfPs :: forall p. IsPass p => (p ~ 'Parsed => SDoc) -> SDoc +pprIfPs pp = case pass @p of GhcPs -> pp + _ -> empty + +pprIfRn :: forall p. IsPass p => (p ~ 'Renamed => SDoc) -> SDoc +pprIfRn pp = case pass @p of GhcRn -> pp + _ -> empty + +pprIfTc :: forall p. IsPass p => (p ~ 'Typechecked => SDoc) -> SDoc +pprIfTc pp = case pass @p of GhcTc -> pp + _ -> empty + +{-------------------------------------------------------------------------- +-- Abstract data +--------------------------------------------------------------------------- + +These are defined in this module so they can be incoporated into e.g. +OutputableBndrId. + +Note [Abstract data] +~~~~~~~~~~~~~~~~~~~~ + +We wish to keep GHC as modular as possible, with an eye to, perhaps, breaking +it up into several packages some day. To do this, we want to avoid dependencies +from HsSyn on other seemingly-unrelated parts of the compiler. Specifically, +the type-checker should depend on HsSyn, not the other way around. Yet we +need to store type-checker information in the AST in a few places (notably, +HsWrap). + +To allow us to store type-checker datatypes in the HsSyn AST but without +taking a dependency, we use *nullary families*. The idea is that we +can define, say + + type family XHsWrapper + +but leave the (orphan) instance to be defined in the type-checker. No more +dependency. This works for both type and data families. + +The only real challenge is what to do with instances (e.g. Outputable and Data). +Only the code that has access to concrete representations can write these +instances meaningfully, so we must defer the instance declarations to e.g. +the type checker. But we need the instances available for writing e.g. +Outputable instances within HsSyn. We thus *absract* over the instances +by using e.g. the OutputableAbstract pattern below. A further wrinkle here +is that HsWrappers want a custom printing function (not just ppr), so we +need the nullary class OutputableHsWrapper. This class is instantiated +where we define HsWrapper concretely. + +-} + +------------------------- +-- | An HsWrapper is, essentially, a Core expression with a hole in it. +-- They are manufactured by the type-checker, and should appear in expressions +-- only after type-checking. We thus leave the definition abstract via +-- the use of a nullary type family. +-- See Note [Abstract data] +type family XHsWrapper + +class OutputableHsWrapper where + -- | With @-fprint-typechecker-elaboration@, print the wrapper + -- otherwise just print what's inside + -- The pp_thing_inside function takes Bool to say whether + -- it's in a position that needs parens for a non-atomic thing + pprHsWrapper :: XHsWrapper -> (Bool -> SDoc) -> SDoc + +-- | Abstract version of 'TcEvBinds' (used in 'AbsBinds') +type family XTcEvBinds + +-- | Abstract version of 'TcLclEnv' (used for delayed splices) +-- See Note [Running typed splices in the zonker] in GHC.Hs.Expr +type family XTcLclEnv + +-- | A summary constraint assuming Outputable for abstract types. +-- Defining this as a type family (and thus allowing us to avoid +-- the need for XHsWrapper and XTcEvBinds in the GhcPs and GhcRn +-- cases) means that the parser needn't depend on the type-checker. +type family OutputableAbstract p :: Constraint +type instance OutputableAbstract GhcPs = () +type instance OutputableAbstract GhcRn = () +type instance OutputableAbstract GhcTc = ( Outputable XHsWrapper + , Outputable XTcEvBinds + , OutputableHsWrapper ) diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs index b3a33df43c..ef147e3193 100644 --- a/compiler/GHC/Hs/Instances.hs +++ b/compiler/GHC/Hs/Instances.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ConstraintKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module GHC.Hs.Instances where @@ -27,399 +28,406 @@ import GHC.Hs.Pat import GHC.Hs.ImpExp -- --------------------------------------------------------------------- +-- Data for abstract families. See Note [Abstract families] in GHC.Hs.Extension. +type DataX = (Data XHsWrapper, Data XTcEvBinds) + +-- --------------------------------------------------------------------- -- Data derivations from GHC.Hs----------------------------------------- -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs.Binds ---------------------------------- -- deriving instance (DataIdLR pL pR) => Data (HsLocalBindsLR pL pR) -deriving instance Data (HsLocalBindsLR GhcPs GhcPs) -deriving instance Data (HsLocalBindsLR GhcPs GhcRn) -deriving instance Data (HsLocalBindsLR GhcRn GhcRn) -deriving instance Data (HsLocalBindsLR GhcTc GhcTc) +deriving instance DataX => Data (HsLocalBindsLR GhcPs GhcPs) +deriving instance DataX => Data (HsLocalBindsLR GhcPs GhcRn) +deriving instance DataX => Data (HsLocalBindsLR GhcRn GhcRn) +deriving instance DataX => Data (HsLocalBindsLR GhcTc GhcTc) -- deriving instance (DataIdLR pL pR) => Data (HsValBindsLR pL pR) -deriving instance Data (HsValBindsLR GhcPs GhcPs) -deriving instance Data (HsValBindsLR GhcPs GhcRn) -deriving instance Data (HsValBindsLR GhcRn GhcRn) -deriving instance Data (HsValBindsLR GhcTc GhcTc) +deriving instance DataX => Data (HsValBindsLR GhcPs GhcPs) +deriving instance DataX => Data (HsValBindsLR GhcPs GhcRn) +deriving instance DataX => Data (HsValBindsLR GhcRn GhcRn) +deriving instance DataX => Data (HsValBindsLR GhcTc GhcTc) -- deriving instance (DataIdLR pL pL) => Data (NHsValBindsLR pL) -deriving instance Data (NHsValBindsLR GhcPs) -deriving instance Data (NHsValBindsLR GhcRn) -deriving instance Data (NHsValBindsLR GhcTc) +deriving instance DataX => Data (NHsValBindsLR GhcPs) +deriving instance DataX => Data (NHsValBindsLR GhcRn) +deriving instance DataX => Data (NHsValBindsLR GhcTc) -- deriving instance (DataIdLR pL pR) => Data (HsBindLR pL pR) -deriving instance Data (HsBindLR GhcPs GhcPs) -deriving instance Data (HsBindLR GhcPs GhcRn) -deriving instance Data (HsBindLR GhcRn GhcRn) -deriving instance Data (HsBindLR GhcTc GhcTc) +deriving instance DataX => Data (HsBindLR GhcPs GhcPs) +deriving instance DataX => Data (HsBindLR GhcPs GhcRn) +deriving instance DataX => Data (HsBindLR GhcRn GhcRn) +deriving instance DataX => Data (HsBindLR GhcTc GhcTc) -- deriving instance (DataId p) => Data (ABExport p) -deriving instance Data (ABExport GhcPs) -deriving instance Data (ABExport GhcRn) -deriving instance Data (ABExport GhcTc) +deriving instance DataX => Data (ABExport GhcPs) +deriving instance DataX => Data (ABExport GhcRn) +deriving instance DataX => Data (ABExport GhcTc) -- deriving instance (DataIdLR pL pR) => Data (PatSynBind pL pR) -deriving instance Data (PatSynBind GhcPs GhcPs) -deriving instance Data (PatSynBind GhcPs GhcRn) -deriving instance Data (PatSynBind GhcRn GhcRn) -deriving instance Data (PatSynBind GhcTc GhcTc) +deriving instance DataX => Data (PatSynBind GhcPs GhcPs) +deriving instance DataX => Data (PatSynBind GhcPs GhcRn) +deriving instance DataX => Data (PatSynBind GhcRn GhcRn) +deriving instance DataX => Data (PatSynBind GhcTc GhcTc) -- deriving instance (DataIdLR p p) => Data (HsIPBinds p) -deriving instance Data (HsIPBinds GhcPs) -deriving instance Data (HsIPBinds GhcRn) -deriving instance Data (HsIPBinds GhcTc) +deriving instance DataX => Data (HsIPBinds GhcPs) +deriving instance DataX => Data (HsIPBinds GhcRn) +deriving instance DataX => Data (HsIPBinds GhcTc) -- deriving instance (DataIdLR p p) => Data (IPBind p) -deriving instance Data (IPBind GhcPs) -deriving instance Data (IPBind GhcRn) -deriving instance Data (IPBind GhcTc) +deriving instance DataX => Data (IPBind GhcPs) +deriving instance DataX => Data (IPBind GhcRn) +deriving instance DataX => Data (IPBind GhcTc) -- deriving instance (DataIdLR p p) => Data (Sig p) -deriving instance Data (Sig GhcPs) -deriving instance Data (Sig GhcRn) -deriving instance Data (Sig GhcTc) +deriving instance DataX => Data (Sig GhcPs) +deriving instance DataX => Data (Sig GhcRn) +deriving instance DataX => Data (Sig GhcTc) -- deriving instance (DataId p) => Data (FixitySig p) -deriving instance Data (FixitySig GhcPs) -deriving instance Data (FixitySig GhcRn) -deriving instance Data (FixitySig GhcTc) +deriving instance DataX => Data (FixitySig GhcPs) +deriving instance DataX => Data (FixitySig GhcRn) +deriving instance DataX => Data (FixitySig GhcTc) -- deriving instance (DataId p) => Data (StandaloneKindSig p) -deriving instance Data (StandaloneKindSig GhcPs) -deriving instance Data (StandaloneKindSig GhcRn) -deriving instance Data (StandaloneKindSig GhcTc) +deriving instance DataX => Data (StandaloneKindSig GhcPs) +deriving instance DataX => Data (StandaloneKindSig GhcRn) +deriving instance DataX => Data (StandaloneKindSig GhcTc) -- deriving instance (DataIdLR p p) => Data (HsPatSynDir p) -deriving instance Data (HsPatSynDir GhcPs) -deriving instance Data (HsPatSynDir GhcRn) -deriving instance Data (HsPatSynDir GhcTc) +deriving instance DataX => Data (HsPatSynDir GhcPs) +deriving instance DataX => Data (HsPatSynDir GhcRn) +deriving instance DataX => Data (HsPatSynDir GhcTc) + +deriving instance DataX => Data TcSpecPrag +deriving instance DataX => Data TcSpecPrags -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs.Decls ---------------------------------- -- deriving instance (DataIdLR p p) => Data (HsDecl p) -deriving instance Data (HsDecl GhcPs) -deriving instance Data (HsDecl GhcRn) -deriving instance Data (HsDecl GhcTc) +deriving instance DataX => Data (HsDecl GhcPs) +deriving instance DataX => Data (HsDecl GhcRn) +deriving instance DataX => Data (HsDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (HsGroup p) -deriving instance Data (HsGroup GhcPs) -deriving instance Data (HsGroup GhcRn) -deriving instance Data (HsGroup GhcTc) +deriving instance DataX => Data (HsGroup GhcPs) +deriving instance DataX => Data (HsGroup GhcRn) +deriving instance DataX => Data (HsGroup GhcTc) -- deriving instance (DataIdLR p p) => Data (SpliceDecl p) -deriving instance Data (SpliceDecl GhcPs) -deriving instance Data (SpliceDecl GhcRn) -deriving instance Data (SpliceDecl GhcTc) +deriving instance DataX => Data (SpliceDecl GhcPs) +deriving instance DataX => Data (SpliceDecl GhcRn) +deriving instance DataX => Data (SpliceDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (TyClDecl p) -deriving instance Data (TyClDecl GhcPs) -deriving instance Data (TyClDecl GhcRn) -deriving instance Data (TyClDecl GhcTc) +deriving instance DataX => Data (TyClDecl GhcPs) +deriving instance DataX => Data (TyClDecl GhcRn) +deriving instance DataX => Data (TyClDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (TyClGroup p) -deriving instance Data (TyClGroup GhcPs) -deriving instance Data (TyClGroup GhcRn) -deriving instance Data (TyClGroup GhcTc) +deriving instance DataX => Data (TyClGroup GhcPs) +deriving instance DataX => Data (TyClGroup GhcRn) +deriving instance DataX => Data (TyClGroup GhcTc) -- deriving instance (DataIdLR p p) => Data (FamilyResultSig p) -deriving instance Data (FamilyResultSig GhcPs) -deriving instance Data (FamilyResultSig GhcRn) -deriving instance Data (FamilyResultSig GhcTc) +deriving instance DataX => Data (FamilyResultSig GhcPs) +deriving instance DataX => Data (FamilyResultSig GhcRn) +deriving instance DataX => Data (FamilyResultSig GhcTc) -- deriving instance (DataIdLR p p) => Data (FamilyDecl p) -deriving instance Data (FamilyDecl GhcPs) -deriving instance Data (FamilyDecl GhcRn) -deriving instance Data (FamilyDecl GhcTc) +deriving instance DataX => Data (FamilyDecl GhcPs) +deriving instance DataX => Data (FamilyDecl GhcRn) +deriving instance DataX => Data (FamilyDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (InjectivityAnn p) -deriving instance Data (InjectivityAnn GhcPs) -deriving instance Data (InjectivityAnn GhcRn) -deriving instance Data (InjectivityAnn GhcTc) +deriving instance DataX => Data (InjectivityAnn GhcPs) +deriving instance DataX => Data (InjectivityAnn GhcRn) +deriving instance DataX => Data (InjectivityAnn GhcTc) -- deriving instance (DataIdLR p p) => Data (FamilyInfo p) -deriving instance Data (FamilyInfo GhcPs) -deriving instance Data (FamilyInfo GhcRn) -deriving instance Data (FamilyInfo GhcTc) +deriving instance DataX => Data (FamilyInfo GhcPs) +deriving instance DataX => Data (FamilyInfo GhcRn) +deriving instance DataX => Data (FamilyInfo GhcTc) -- deriving instance (DataIdLR p p) => Data (HsDataDefn p) -deriving instance Data (HsDataDefn GhcPs) -deriving instance Data (HsDataDefn GhcRn) -deriving instance Data (HsDataDefn GhcTc) +deriving instance DataX => Data (HsDataDefn GhcPs) +deriving instance DataX => Data (HsDataDefn GhcRn) +deriving instance DataX => Data (HsDataDefn GhcTc) -- deriving instance (DataIdLR p p) => Data (HsDerivingClause p) -deriving instance Data (HsDerivingClause GhcPs) -deriving instance Data (HsDerivingClause GhcRn) -deriving instance Data (HsDerivingClause GhcTc) +deriving instance DataX => Data (HsDerivingClause GhcPs) +deriving instance DataX => Data (HsDerivingClause GhcRn) +deriving instance DataX => Data (HsDerivingClause GhcTc) -- deriving instance (DataIdLR p p) => Data (ConDecl p) -deriving instance Data (ConDecl GhcPs) -deriving instance Data (ConDecl GhcRn) -deriving instance Data (ConDecl GhcTc) +deriving instance DataX => Data (ConDecl GhcPs) +deriving instance DataX => Data (ConDecl GhcRn) +deriving instance DataX => Data (ConDecl GhcTc) -- deriving instance DataIdLR p p => Data (TyFamInstDecl p) -deriving instance Data (TyFamInstDecl GhcPs) -deriving instance Data (TyFamInstDecl GhcRn) -deriving instance Data (TyFamInstDecl GhcTc) +deriving instance DataX => Data (TyFamInstDecl GhcPs) +deriving instance DataX => Data (TyFamInstDecl GhcRn) +deriving instance DataX => Data (TyFamInstDecl GhcTc) -- deriving instance DataIdLR p p => Data (DataFamInstDecl p) -deriving instance Data (DataFamInstDecl GhcPs) -deriving instance Data (DataFamInstDecl GhcRn) -deriving instance Data (DataFamInstDecl GhcTc) +deriving instance DataX => Data (DataFamInstDecl GhcPs) +deriving instance DataX => Data (DataFamInstDecl GhcRn) +deriving instance DataX => Data (DataFamInstDecl GhcTc) -- deriving instance (DataIdLR p p,Data rhs)=>Data (FamEqn p rhs) -deriving instance Data rhs => Data (FamEqn GhcPs rhs) -deriving instance Data rhs => Data (FamEqn GhcRn rhs) -deriving instance Data rhs => Data (FamEqn GhcTc rhs) +deriving instance DataX => Data rhs => Data (FamEqn GhcPs rhs) +deriving instance DataX => Data rhs => Data (FamEqn GhcRn rhs) +deriving instance DataX => Data rhs => Data (FamEqn GhcTc rhs) -- deriving instance (DataIdLR p p) => Data (ClsInstDecl p) -deriving instance Data (ClsInstDecl GhcPs) -deriving instance Data (ClsInstDecl GhcRn) -deriving instance Data (ClsInstDecl GhcTc) +deriving instance DataX => Data (ClsInstDecl GhcPs) +deriving instance DataX => Data (ClsInstDecl GhcRn) +deriving instance DataX => Data (ClsInstDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (InstDecl p) -deriving instance Data (InstDecl GhcPs) -deriving instance Data (InstDecl GhcRn) -deriving instance Data (InstDecl GhcTc) +deriving instance DataX => Data (InstDecl GhcPs) +deriving instance DataX => Data (InstDecl GhcRn) +deriving instance DataX => Data (InstDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (DerivDecl p) -deriving instance Data (DerivDecl GhcPs) -deriving instance Data (DerivDecl GhcRn) -deriving instance Data (DerivDecl GhcTc) +deriving instance DataX => Data (DerivDecl GhcPs) +deriving instance DataX => Data (DerivDecl GhcRn) +deriving instance DataX => Data (DerivDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (DerivStrategy p) -deriving instance Data (DerivStrategy GhcPs) -deriving instance Data (DerivStrategy GhcRn) -deriving instance Data (DerivStrategy GhcTc) +deriving instance DataX => Data (DerivStrategy GhcPs) +deriving instance DataX => Data (DerivStrategy GhcRn) +deriving instance DataX => Data (DerivStrategy GhcTc) -- deriving instance (DataIdLR p p) => Data (DefaultDecl p) -deriving instance Data (DefaultDecl GhcPs) -deriving instance Data (DefaultDecl GhcRn) -deriving instance Data (DefaultDecl GhcTc) +deriving instance DataX => Data (DefaultDecl GhcPs) +deriving instance DataX => Data (DefaultDecl GhcRn) +deriving instance DataX => Data (DefaultDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (ForeignDecl p) -deriving instance Data (ForeignDecl GhcPs) -deriving instance Data (ForeignDecl GhcRn) -deriving instance Data (ForeignDecl GhcTc) +deriving instance DataX => Data (ForeignDecl GhcPs) +deriving instance DataX => Data (ForeignDecl GhcRn) +deriving instance DataX => Data (ForeignDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (RuleDecls p) -deriving instance Data (RuleDecls GhcPs) -deriving instance Data (RuleDecls GhcRn) -deriving instance Data (RuleDecls GhcTc) +deriving instance DataX => Data (RuleDecls GhcPs) +deriving instance DataX => Data (RuleDecls GhcRn) +deriving instance DataX => Data (RuleDecls GhcTc) -- deriving instance (DataIdLR p p) => Data (RuleDecl p) -deriving instance Data (RuleDecl GhcPs) -deriving instance Data (RuleDecl GhcRn) -deriving instance Data (RuleDecl GhcTc) +deriving instance DataX => Data (RuleDecl GhcPs) +deriving instance DataX => Data (RuleDecl GhcRn) +deriving instance DataX => Data (RuleDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (RuleBndr p) -deriving instance Data (RuleBndr GhcPs) -deriving instance Data (RuleBndr GhcRn) -deriving instance Data (RuleBndr GhcTc) +deriving instance DataX => Data (RuleBndr GhcPs) +deriving instance DataX => Data (RuleBndr GhcRn) +deriving instance DataX => Data (RuleBndr GhcTc) -- deriving instance (DataId p) => Data (WarnDecls p) -deriving instance Data (WarnDecls GhcPs) -deriving instance Data (WarnDecls GhcRn) -deriving instance Data (WarnDecls GhcTc) +deriving instance DataX => Data (WarnDecls GhcPs) +deriving instance DataX => Data (WarnDecls GhcRn) +deriving instance DataX => Data (WarnDecls GhcTc) -- deriving instance (DataId p) => Data (WarnDecl p) -deriving instance Data (WarnDecl GhcPs) -deriving instance Data (WarnDecl GhcRn) -deriving instance Data (WarnDecl GhcTc) +deriving instance DataX => Data (WarnDecl GhcPs) +deriving instance DataX => Data (WarnDecl GhcRn) +deriving instance DataX => Data (WarnDecl GhcTc) -- deriving instance (DataIdLR p p) => Data (AnnDecl p) -deriving instance Data (AnnDecl GhcPs) -deriving instance Data (AnnDecl GhcRn) -deriving instance Data (AnnDecl GhcTc) +deriving instance DataX => Data (AnnDecl GhcPs) +deriving instance DataX => Data (AnnDecl GhcRn) +deriving instance DataX => Data (AnnDecl GhcTc) -- deriving instance (DataId p) => Data (RoleAnnotDecl p) -deriving instance Data (RoleAnnotDecl GhcPs) -deriving instance Data (RoleAnnotDecl GhcRn) -deriving instance Data (RoleAnnotDecl GhcTc) +deriving instance DataX => Data (RoleAnnotDecl GhcPs) +deriving instance DataX => Data (RoleAnnotDecl GhcRn) +deriving instance DataX => Data (RoleAnnotDecl GhcTc) -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs.Expr ----------------------------------- -- deriving instance (DataIdLR p p) => Data (SyntaxExpr p) -deriving instance Data (SyntaxExpr GhcPs) -deriving instance Data (SyntaxExpr GhcRn) -deriving instance Data (SyntaxExpr GhcTc) +deriving instance DataX => Data SyntaxExprTc -- deriving instance (DataIdLR p p) => Data (HsExpr p) -deriving instance Data (HsExpr GhcPs) -deriving instance Data (HsExpr GhcRn) -deriving instance Data (HsExpr GhcTc) +deriving instance DataX => Data (HsExpr GhcPs) +deriving instance DataX => Data (HsExpr GhcRn) +deriving instance DataX => Data (HsExpr GhcTc) -- deriving instance (DataIdLR p p) => Data (HsTupArg p) -deriving instance Data (HsTupArg GhcPs) -deriving instance Data (HsTupArg GhcRn) -deriving instance Data (HsTupArg GhcTc) +deriving instance DataX => Data (HsTupArg GhcPs) +deriving instance DataX => Data (HsTupArg GhcRn) +deriving instance DataX => Data (HsTupArg GhcTc) -- deriving instance (DataIdLR p p) => Data (HsCmd p) -deriving instance Data (HsCmd GhcPs) -deriving instance Data (HsCmd GhcRn) -deriving instance Data (HsCmd GhcTc) +deriving instance DataX => Data (HsCmd GhcPs) +deriving instance DataX => Data (HsCmd GhcRn) +deriving instance DataX => Data (HsCmd GhcTc) -- deriving instance (DataIdLR p p) => Data (HsCmdTop p) -deriving instance Data (HsCmdTop GhcPs) -deriving instance Data (HsCmdTop GhcRn) -deriving instance Data (HsCmdTop GhcTc) +deriving instance DataX => Data (HsCmdTop GhcPs) +deriving instance DataX => Data (HsCmdTop GhcRn) +deriving instance DataX => Data (HsCmdTop GhcTc) -- deriving instance (DataIdLR p p,Data body) => Data (MatchGroup p body) -deriving instance (Data body) => Data (MatchGroup GhcPs body) -deriving instance (Data body) => Data (MatchGroup GhcRn body) -deriving instance (Data body) => Data (MatchGroup GhcTc body) +deriving instance (DataX, Data body) => Data (MatchGroup GhcPs body) +deriving instance (DataX, Data body) => Data (MatchGroup GhcRn body) +deriving instance (DataX, Data body) => Data (MatchGroup GhcTc body) -- deriving instance (DataIdLR p p,Data body) => Data (Match p body) -deriving instance (Data body) => Data (Match GhcPs body) -deriving instance (Data body) => Data (Match GhcRn body) -deriving instance (Data body) => Data (Match GhcTc body) +deriving instance (DataX, Data body) => Data (Match GhcPs body) +deriving instance (DataX, Data body) => Data (Match GhcRn body) +deriving instance (DataX, Data body) => Data (Match GhcTc body) -- deriving instance (DataIdLR p p,Data body) => Data (GRHSs p body) -deriving instance (Data body) => Data (GRHSs GhcPs body) -deriving instance (Data body) => Data (GRHSs GhcRn body) -deriving instance (Data body) => Data (GRHSs GhcTc body) +deriving instance (DataX, Data body) => Data (GRHSs GhcPs body) +deriving instance (DataX, Data body) => Data (GRHSs GhcRn body) +deriving instance (DataX, Data body) => Data (GRHSs GhcTc body) -- deriving instance (DataIdLR p p,Data body) => Data (GRHS p body) -deriving instance (Data body) => Data (GRHS GhcPs body) -deriving instance (Data body) => Data (GRHS GhcRn body) -deriving instance (Data body) => Data (GRHS GhcTc body) +deriving instance (DataX, Data body) => Data (GRHS GhcPs body) +deriving instance (DataX, Data body) => Data (GRHS GhcRn body) +deriving instance (DataX, Data body) => Data (GRHS GhcTc body) -- deriving instance (DataIdLR p p,Data body) => Data (StmtLR p p body) -deriving instance (Data body) => Data (StmtLR GhcPs GhcPs body) -deriving instance (Data body) => Data (StmtLR GhcPs GhcRn body) -deriving instance (Data body) => Data (StmtLR GhcRn GhcRn body) -deriving instance (Data body) => Data (StmtLR GhcTc GhcTc body) +deriving instance (DataX, Data body) => Data (StmtLR GhcPs GhcPs body) +deriving instance (DataX, Data body) => Data (StmtLR GhcPs GhcRn body) +deriving instance (DataX, Data body) => Data (StmtLR GhcRn GhcRn body) +deriving instance (DataX, Data body) => Data (StmtLR GhcTc GhcTc body) -deriving instance Data RecStmtTc +deriving instance DataX => Data RecStmtTc +deriving instance DataX => Data RecordUpdTc +deriving instance (DataX, Data (body GhcTc), Typeable body) => Data (HsWrap body) -- deriving instance (DataIdLR p p) => Data (ParStmtBlock p p) -deriving instance Data (ParStmtBlock GhcPs GhcPs) -deriving instance Data (ParStmtBlock GhcPs GhcRn) -deriving instance Data (ParStmtBlock GhcRn GhcRn) -deriving instance Data (ParStmtBlock GhcTc GhcTc) +deriving instance DataX => Data (ParStmtBlock GhcPs GhcPs) +deriving instance DataX => Data (ParStmtBlock GhcPs GhcRn) +deriving instance DataX => Data (ParStmtBlock GhcRn GhcRn) +deriving instance DataX => Data (ParStmtBlock GhcTc GhcTc) -- deriving instance (DataIdLR p p) => Data (ApplicativeArg p) -deriving instance Data (ApplicativeArg GhcPs) -deriving instance Data (ApplicativeArg GhcRn) -deriving instance Data (ApplicativeArg GhcTc) +deriving instance DataX => Data (ApplicativeArg GhcPs) +deriving instance DataX => Data (ApplicativeArg GhcRn) +deriving instance DataX => Data (ApplicativeArg GhcTc) -- deriving instance (DataIdLR p p) => Data (HsSplice p) -deriving instance Data (HsSplice GhcPs) -deriving instance Data (HsSplice GhcRn) -deriving instance Data (HsSplice GhcTc) +deriving instance DataX => Data (HsSplice GhcPs) +deriving instance DataX => Data (HsSplice GhcRn) +deriving instance DataX => Data (HsSplice GhcTc) -- deriving instance (DataIdLR p p) => Data (HsSplicedThing p) -deriving instance Data (HsSplicedThing GhcPs) -deriving instance Data (HsSplicedThing GhcRn) -deriving instance Data (HsSplicedThing GhcTc) +deriving instance DataX => Data (HsSplicedThing GhcPs) +deriving instance DataX => Data (HsSplicedThing GhcRn) +deriving instance DataX => Data (HsSplicedThing GhcTc) -- deriving instance (DataIdLR p p) => Data (HsBracket p) -deriving instance Data (HsBracket GhcPs) -deriving instance Data (HsBracket GhcRn) -deriving instance Data (HsBracket GhcTc) +deriving instance DataX => Data (HsBracket GhcPs) +deriving instance DataX => Data (HsBracket GhcRn) +deriving instance DataX => Data (HsBracket GhcTc) -- deriving instance (DataIdLR p p) => Data (ArithSeqInfo p) -deriving instance Data (ArithSeqInfo GhcPs) -deriving instance Data (ArithSeqInfo GhcRn) -deriving instance Data (ArithSeqInfo GhcTc) +deriving instance DataX => Data (ArithSeqInfo GhcPs) +deriving instance DataX => Data (ArithSeqInfo GhcRn) +deriving instance DataX => Data (ArithSeqInfo GhcTc) -deriving instance Data RecordConTc -deriving instance Data CmdTopTc -deriving instance Data PendingRnSplice -deriving instance Data PendingTcSplice +deriving instance DataX => Data RecordConTc +deriving instance DataX => Data CmdTopTc +deriving instance DataX => Data PendingRnSplice +deriving instance DataX => Data PendingTcSplice -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs.Lit ------------------------------------ -- deriving instance (DataId p) => Data (HsLit p) -deriving instance Data (HsLit GhcPs) -deriving instance Data (HsLit GhcRn) -deriving instance Data (HsLit GhcTc) +deriving instance DataX => Data (HsLit GhcPs) +deriving instance DataX => Data (HsLit GhcRn) +deriving instance DataX => Data (HsLit GhcTc) -- deriving instance (DataIdLR p p) => Data (HsOverLit p) -deriving instance Data (HsOverLit GhcPs) -deriving instance Data (HsOverLit GhcRn) -deriving instance Data (HsOverLit GhcTc) +deriving instance DataX => Data (HsOverLit GhcPs) +deriving instance DataX => Data (HsOverLit GhcRn) +deriving instance DataX => Data (HsOverLit GhcTc) -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs.Pat ------------------------------------ -- deriving instance (DataIdLR p p) => Data (Pat p) -deriving instance Data (Pat GhcPs) -deriving instance Data (Pat GhcRn) -deriving instance Data (Pat GhcTc) +deriving instance DataX => Data (Pat GhcPs) +deriving instance DataX => Data (Pat GhcRn) +deriving instance DataX => Data (Pat GhcTc) -deriving instance Data ListPatTc +deriving instance DataX => Data ListPatTc -- deriving instance (DataIdLR p p, Data body) => Data (HsRecFields p body) -deriving instance (Data body) => Data (HsRecFields GhcPs body) -deriving instance (Data body) => Data (HsRecFields GhcRn body) -deriving instance (Data body) => Data (HsRecFields GhcTc body) +deriving instance (DataX, Data body) => Data (HsRecFields GhcPs body) +deriving instance (DataX, Data body) => Data (HsRecFields GhcRn body) +deriving instance (DataX, Data body) => Data (HsRecFields GhcTc body) -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs.Types ---------------------------------- -- deriving instance (DataIdLR p p) => Data (LHsQTyVars p) -deriving instance Data (LHsQTyVars GhcPs) -deriving instance Data (LHsQTyVars GhcRn) -deriving instance Data (LHsQTyVars GhcTc) +deriving instance DataX => Data (LHsQTyVars GhcPs) +deriving instance DataX => Data (LHsQTyVars GhcRn) +deriving instance DataX => Data (LHsQTyVars GhcTc) -- deriving instance (DataIdLR p p, Data thing) =>Data (HsImplicitBndrs p thing) -deriving instance (Data thing) => Data (HsImplicitBndrs GhcPs thing) -deriving instance (Data thing) => Data (HsImplicitBndrs GhcRn thing) -deriving instance (Data thing) => Data (HsImplicitBndrs GhcTc thing) +deriving instance (DataX, Data thing) => Data (HsImplicitBndrs GhcPs thing) +deriving instance (DataX, Data thing) => Data (HsImplicitBndrs GhcRn thing) +deriving instance (DataX, Data thing) => Data (HsImplicitBndrs GhcTc thing) -- deriving instance (DataIdLR p p, Data thing) =>Data (HsWildCardBndrs p thing) -deriving instance (Data thing) => Data (HsWildCardBndrs GhcPs thing) -deriving instance (Data thing) => Data (HsWildCardBndrs GhcRn thing) -deriving instance (Data thing) => Data (HsWildCardBndrs GhcTc thing) +deriving instance (DataX, Data thing) => Data (HsWildCardBndrs GhcPs thing) +deriving instance (DataX, Data thing) => Data (HsWildCardBndrs GhcRn thing) +deriving instance (DataX, Data thing) => Data (HsWildCardBndrs GhcTc thing) -- deriving instance (DataIdLR p p) => Data (HsTyVarBndr p) -deriving instance Data (HsTyVarBndr GhcPs) -deriving instance Data (HsTyVarBndr GhcRn) -deriving instance Data (HsTyVarBndr GhcTc) +deriving instance DataX => Data (HsTyVarBndr GhcPs) +deriving instance DataX => Data (HsTyVarBndr GhcRn) +deriving instance DataX => Data (HsTyVarBndr GhcTc) -- deriving instance (DataIdLR p p) => Data (HsType p) -deriving instance Data (HsType GhcPs) -deriving instance Data (HsType GhcRn) -deriving instance Data (HsType GhcTc) +deriving instance DataX => Data (HsType GhcPs) +deriving instance DataX => Data (HsType GhcRn) +deriving instance DataX => Data (HsType GhcTc) -deriving instance Data (LHsTypeArg GhcPs) -deriving instance Data (LHsTypeArg GhcRn) -deriving instance Data (LHsTypeArg GhcTc) +deriving instance DataX => Data (LHsTypeArg GhcPs) +deriving instance DataX => Data (LHsTypeArg GhcRn) +deriving instance DataX => Data (LHsTypeArg GhcTc) -- deriving instance (DataIdLR p p) => Data (ConDeclField p) -deriving instance Data (ConDeclField GhcPs) -deriving instance Data (ConDeclField GhcRn) -deriving instance Data (ConDeclField GhcTc) +deriving instance DataX => Data (ConDeclField GhcPs) +deriving instance DataX => Data (ConDeclField GhcRn) +deriving instance DataX => Data (ConDeclField GhcTc) -- deriving instance (DataId p) => Data (FieldOcc p) -deriving instance Data (FieldOcc GhcPs) -deriving instance Data (FieldOcc GhcRn) -deriving instance Data (FieldOcc GhcTc) +deriving instance DataX => Data (FieldOcc GhcPs) +deriving instance DataX => Data (FieldOcc GhcRn) +deriving instance DataX => Data (FieldOcc GhcTc) -- deriving instance DataId p => Data (AmbiguousFieldOcc p) -deriving instance Data (AmbiguousFieldOcc GhcPs) -deriving instance Data (AmbiguousFieldOcc GhcRn) -deriving instance Data (AmbiguousFieldOcc GhcTc) +deriving instance DataX => Data (AmbiguousFieldOcc GhcPs) +deriving instance DataX => Data (AmbiguousFieldOcc GhcRn) +deriving instance DataX => Data (AmbiguousFieldOcc GhcTc) -- deriving instance (DataId name) => Data (ImportDecl name) -deriving instance Data (ImportDecl GhcPs) -deriving instance Data (ImportDecl GhcRn) -deriving instance Data (ImportDecl GhcTc) +deriving instance DataX => Data (ImportDecl GhcPs) +deriving instance DataX => Data (ImportDecl GhcRn) +deriving instance DataX => Data (ImportDecl GhcTc) -- deriving instance (DataId name) => Data (IE name) -deriving instance Data (IE GhcPs) -deriving instance Data (IE GhcRn) -deriving instance Data (IE GhcTc) +deriving instance DataX => Data (IE GhcPs) +deriving instance DataX => Data (IE GhcRn) +deriving instance DataX => Data (IE GhcTc) -- deriving instance (Eq name, Eq (IdP name)) => Eq (IE name) -deriving instance Eq (IE GhcPs) -deriving instance Eq (IE GhcRn) -deriving instance Eq (IE GhcTc) +deriving instance DataX => Eq (IE GhcPs) +deriving instance DataX => Eq (IE GhcRn) +deriving instance DataX => Eq (IE GhcTc) -- --------------------------------------------------------------------- diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs index fe8a4e88d5..c224dcf67b 100644 --- a/compiler/GHC/Hs/Pat.hs +++ b/compiler/GHC/Hs/Pat.hs @@ -17,6 +17,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} module GHC.Hs.Pat ( Pat(..), InPat, OutPat, LPat, @@ -29,8 +31,6 @@ module GHC.Hs.Pat ( hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs, hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr, - mkPrefixConPat, mkCharLitPat, mkNilPat, - looksLazyPatBind, isBangedLPat, patNeedsParens, parenthesizePat, @@ -50,11 +50,9 @@ import GHC.Hs.Binds import GHC.Hs.Lit import GHC.Hs.Extension import GHC.Hs.Types -import TcEvidence import BasicTypes -- others: import PprCore ( {- instance OutputableBndr TyVar -} ) -import TysWiredIn import Var import RdrName ( RdrName ) import ConLike @@ -187,9 +185,9 @@ data Pat p -- One reason for putting coercion variable here, I think, -- is to ensure their kinds are zonked - pat_binds :: TcEvBinds, -- Bindings involving those dictionaries + pat_binds :: XTcEvBinds, -- Bindings involving those dictionaries pat_args :: HsConPatDetails p, - pat_wrap :: HsWrapper -- Extra wrapper to pass to the matcher + pat_wrap :: XHsWrapper -- Extra wrapper to pass to the matcher -- Only relevant for pattern-synonyms; -- ignored for data cons } @@ -261,7 +259,7 @@ data Pat p ------------ Pattern coercions (translation only) --------------- | CoPat (XCoPat p) - HsWrapper -- Coercion Pattern + XHsWrapper -- Coercion Pattern -- If co :: t1 ~ t2, p :: t2, -- then (CoPat co p) :: t1 (Pat p) -- Why not LPat? Ans: existing locn will do @@ -535,7 +533,7 @@ pprParendPat p pat = sdocWithDynFlags $ \ dflags -> -- But otherwise the CoPat is discarded, so it -- is the pattern inside that matters. Sigh. -pprPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc +pprPat :: forall p. (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc pprPat (VarPat _ lvar) = pprPatBndr (unLoc lvar) pprPat (WildPat _) = char '_' pprPat (LazyPat _ pat) = char '~' <> pprParendLPat appPrec pat @@ -549,8 +547,9 @@ pprPat (NPat _ l Nothing _) = ppr l pprPat (NPat _ l (Just _) _) = char '-' <> ppr l pprPat (NPlusKPat _ n k _ _ _) = hcat [ppr n, char '+', ppr k] pprPat (SplicePat _ splice) = pprSplice splice -pprPat (CoPat _ co pat _) = pprHsWrapper co $ \parens - -> if parens +pprPat (CoPat _ co pat _) = pprIfTc @p $ + pprHsWrapper co $ \parens + -> if parens then pprParendPat appPrec pat else pprPat pat pprPat (SigPat _ pat ty) = ppr pat <+> dcolon <+> ppr ty @@ -571,7 +570,7 @@ pprPat (ConPatOut { pat_con = con if gopt Opt_PrintTypecheckerElaboration dflags then ppr con <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts)) - , ppr binds]) + , pprIfTc @p $ ppr binds ]) <+> pprConArgs details else pprUserCon (unLoc con) details pprPat (XPat x) = ppr x @@ -608,33 +607,6 @@ instance (Outputable p, Outputable arg) {- ************************************************************************ * * -* Building patterns -* * -************************************************************************ --} - -mkPrefixConPat :: DataCon -> - [OutPat (GhcPass p)] -> [Type] -> OutPat (GhcPass p) --- Make a vanilla Prefix constructor pattern -mkPrefixConPat dc pats tys - = noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc) - , pat_tvs = [] - , pat_dicts = [] - , pat_binds = emptyTcEvBinds - , pat_args = PrefixCon pats - , pat_arg_tys = tys - , pat_wrap = idHsWrapper } - -mkNilPat :: Type -> OutPat (GhcPass p) -mkNilPat ty = mkPrefixConPat nilDataCon [] [ty] - -mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p) -mkCharLitPat src c = mkPrefixConPat charDataCon - [noLoc $ LitPat noExtField (HsCharPrim src c)] [] - -{- -************************************************************************ -* * * Predicates for checking things about pattern-lists in EquationInfo * * * ************************************************************************ diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 5d54196af2..52ba85b2e8 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -24,14 +24,12 @@ module GHC.Hs.Utils( mkHsPar, mkHsApp, mkHsAppType, mkHsAppTypes, mkHsCaseAlt, mkSimpleMatch, unguardedGRHSs, unguardedRHS, mkMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf, - mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo, - mkHsDictLet, mkHsLams, - mkHsOpApp, mkHsDo, mkHsComp, mkHsWrapPat, mkHsWrapPatCo, - mkLHsPar, mkHsCmdWrap, mkLHsCmdWrap, + mkHsOpApp, mkHsDo, mkHsComp, + mkLHsPar, mkHsCmdIf, - nlHsTyApp, nlHsTyApps, nlHsVar, nlHsDataCon, - nlHsLit, nlHsApp, nlHsApps, nlHsSyntaxApps, + nlHsVar, nlHsDataCon, + nlHsLit, nlHsApp, nlHsApps, nlHsIntLit, nlHsVarApps, nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList, mkLHsTupleExpr, mkLHsVarTuple, missingTupArg, @@ -102,7 +100,6 @@ import GHC.Hs.Lit import GHC.Hs.PlaceHolder import GHC.Hs.Extension -import TcEvidence import RdrName import Var import TyCoRep @@ -118,7 +115,6 @@ import NameEnv import BasicTypes import SrcLoc import FastString -import Util import Bag import Outputable import Constants @@ -195,10 +191,6 @@ mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExtField matches)) [mkSimpleMatch LambdaExpr pats' body] pats' = map (parenthesizePat appPrec) pats -mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc -mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars - <.> mkWpLams dicts) expr - -- |A simple case alternative with a single pattern, no binds, no guards; -- pre-typechecking mkHsCaseAlt :: LPat (GhcPass p) -> (Located (body (GhcPass p))) @@ -206,16 +198,8 @@ mkHsCaseAlt :: LPat (GhcPass p) -> (Located (body (GhcPass p))) mkHsCaseAlt pat expr = mkSimpleMatch CaseAlt [pat] expr -nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id) -nlHsTyApp fun_id tys - = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExtField (noLoc fun_id))) - -nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)] - -> LHsExpr (GhcPass id) -nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs - --------- Adding parens --------- -mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) +mkLHsPar :: IsPass id => LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -- Wrap in parens if (hsExprNeedsParens appPrec) says it needs them -- So 'f x' becomes '(f x)', but '3' stays as '3' mkLHsPar le@(dL->L loc e) @@ -245,11 +229,11 @@ mkNPat :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> Pat GhcPs mkNPlusKPat :: Located RdrName -> Located (HsOverLit GhcPs) -> Pat GhcPs -mkLastStmt :: Located (bodyR (GhcPass idR)) +mkLastStmt :: IsPass idR => Located (bodyR (GhcPass idR)) -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR))) mkBodyStmt :: Located (bodyR GhcPs) -> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs)) -mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR) +mkBindStmt :: IsPass idR => (XBindStmt (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR))) ~ NoExtField) => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR)) -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR))) @@ -272,11 +256,11 @@ mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt]) where last_stmt = cL (getLoc expr) $ mkLastStmt expr -mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) +mkHsIf :: IsPass p => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p) mkHsIf c a b = HsIf noExtField (Just noSyntaxExpr) c a b -mkHsCmdIf :: LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p) +mkHsCmdIf :: IsPass p => LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p) -> HsCmd (GhcPass p) mkHsCmdIf c a b = HsCmdIf noExtField (Just noSyntaxExpr) c a b @@ -314,8 +298,8 @@ mkBindStmt pat body mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr -- don't use placeHolderTypeTc above, because that panics during zonking -emptyRecStmt' :: forall idL idR body. - XRecStmt (GhcPass idL) (GhcPass idR) body +emptyRecStmt' :: forall idL idR body. IsPass idR + => XRecStmt (GhcPass idL) (GhcPass idR) body -> StmtLR (GhcPass idL) (GhcPass idR) body emptyRecStmt' tyVal = RecStmt @@ -396,23 +380,10 @@ nlVarPat n = noLoc (VarPat noExtField (noLoc n)) nlLitPat :: HsLit GhcPs -> LPat GhcPs nlLitPat l = noLoc (LitPat noExtField l) -nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) +nlHsApp :: IsPass id => LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) nlHsApp f x = noLoc (HsApp noExtField f (mkLHsPar x)) -nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)] - -> LHsExpr (GhcPass id) -nlHsSyntaxApps (SyntaxExpr { syn_expr = fun - , syn_arg_wraps = arg_wraps - , syn_res_wrap = res_wrap }) args - | [] <- arg_wraps -- in the noSyntaxExpr case - = ASSERT( isIdHsWrapper res_wrap ) - foldl' nlHsApp (noLoc fun) args - - | otherwise - = mkLHsWrap res_wrap (foldl' nlHsApp (noLoc fun) (zipWithEqual "nlHsSyntaxApps" - mkLHsWrap arg_wraps args)) - -nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) +nlHsApps :: IsPass id => IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id) nlHsApps f xs = foldl' nlHsApp (nlHsVar f) xs nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id) @@ -737,51 +708,6 @@ visible kind applications, so even specified arguments count towards injective positions in the kind of the tycon. -} -{- ********************************************************************* -* * - --------- HsWrappers: type args, dict args, casts --------- -* * -********************************************************************* -} - -mkLHsWrap :: HsWrapper -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -mkLHsWrap co_fn (dL->L loc e) = cL loc (mkHsWrap co_fn e) - --- Avoid (HsWrap co (HsWrap co' _)). --- See Note [Detecting forced eta expansion] in DsExpr -mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) -mkHsWrap co_fn e | isIdHsWrapper co_fn = e -mkHsWrap co_fn (HsWrap _ co_fn' e) = mkHsWrap (co_fn <.> co_fn') e -mkHsWrap co_fn e = HsWrap noExtField co_fn e - -mkHsWrapCo :: TcCoercionN -- A Nominal coercion a ~N b - -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) -mkHsWrapCo co e = mkHsWrap (mkWpCastN co) e - -mkHsWrapCoR :: TcCoercionR -- A Representational coercion a ~R b - -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) -mkHsWrapCoR co e = mkHsWrap (mkWpCastR co) e - -mkLHsWrapCo :: TcCoercionN -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -mkLHsWrapCo co (dL->L loc e) = cL loc (mkHsWrapCo co e) - -mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p) -mkHsCmdWrap w cmd | isIdHsWrapper w = cmd - | otherwise = HsCmdWrap noExtField w cmd - -mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p) -mkLHsCmdWrap w (dL->L loc c) = cL loc (mkHsCmdWrap w c) - -mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id) -mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p - | otherwise = CoPat noExtField co_fn p ty - -mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id) -mkHsWrapPatCo co pat ty | isTcReflCo co = pat - | otherwise = CoPat noExtField (mkWpCastN co) pat ty - -mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc -mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr - {- l ************************************************************************ @@ -796,7 +722,6 @@ mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)] -- Not infix, with place holders for coercion and free vars mkFunBind fn ms = FunBind { fun_id = fn , fun_matches = mkMatchGroup Generated ms - , fun_co_fn = idHsWrapper , fun_ext = noExtField , fun_tick = [] } @@ -805,7 +730,6 @@ mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)] -- In Name-land, with empty bind_fvs mkTopFunBind origin fn ms = FunBind { fun_id = fn , fun_matches = mkMatchGroup origin ms - , fun_co_fn = idHsWrapper , fun_ext = emptyNameSet -- NB: closed -- binding , fun_tick = [] } @@ -831,7 +755,7 @@ mkPatSynBind name details lpat dir = PatSynBind noExtField psb -- |If any of the matches in the 'FunBind' are infix, the 'FunBind' is -- considered infix. isInfixFunBind :: HsBindLR id1 id2 -> Bool -isInfixFunBind (FunBind _ _ (MG _ matches _) _ _) +isInfixFunBind (FunBind { fun_matches = MG _ matches _ }) = any (isInfixMatch . unLoc) (unLoc matches) isInfixFunBind _ = False |