diff options
Diffstat (limited to 'compiler/hsSyn/HsBinds.hs')
| -rw-r--r-- | compiler/hsSyn/HsBinds.hs | 121 |
1 files changed, 64 insertions, 57 deletions
diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index b39e25a2c7..b760cb3a88 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -22,13 +22,12 @@ import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr, GRHSs, pprPatBind ) import {-# SOURCE #-} HsPat ( LPat ) -import PlaceHolder ( PostTc,PostRn,DataId,OutputableBndrId ) +import HsExtension import HsTypes import PprCore () import CoreSyn import TcEvidence import Type -import Name import NameSet import BasicTypes import Outputable @@ -87,8 +86,7 @@ data HsLocalBindsLR idL idR type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR) -deriving instance (DataId idL, DataId idR) - => Data (HsLocalBindsLR idL idR) +deriving instance (DataId idL, DataId idR) => Data (HsLocalBindsLR idL idR) -- | Haskell Value Bindings type HsValBinds id = HsValBindsLR id id @@ -112,10 +110,9 @@ data HsValBindsLR idL idR -- later bindings in the list may depend on earlier ones. | ValBindsOut [(RecFlag, LHsBinds idL)] - [LSig Name] + [LSig GhcRn] -- AZ: how to do this? -deriving instance (DataId idL, DataId idR) - => Data (HsValBindsLR idL idR) +deriving instance (DataId idL, DataId idR) => Data (HsValBindsLR idL idR) -- | Located Haskell Binding type LHsBind id = LHsBindLR id id @@ -158,7 +155,7 @@ data HsBindLR idL idR -- For details on above see note [Api annotations] in ApiAnnotation FunBind { - fun_id :: Located idL, -- Note [fun_id in Match] in HsExpr + fun_id :: Located (IdP idL), -- Note [fun_id in Match] in HsExpr fun_matches :: MatchGroup idR (LHsExpr idR), -- ^ The payload @@ -182,7 +179,7 @@ data HsBindLR idL idR -- See Note [Bind free vars] - fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any + fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any } -- | Pattern Binding @@ -210,7 +207,7 @@ data HsBindLR idL idR -- Dictionary binding and suchlike. -- All VarBinds are introduced by the type checker | VarBind { - var_id :: idL, + var_id :: IdP idL, var_rhs :: LHsExpr idR, -- ^ Located only for consistency var_inline :: Bool -- ^ True <=> inline this binding regardless -- (used for implication constraints only) @@ -242,7 +239,7 @@ data HsBindLR idL idR abs_tvs :: [TyVar], abs_ev_vars :: [EvVar], - abs_sig_export :: idL, -- like abe_poly + abs_sig_export :: IdP idL, -- like abe_poly abs_sig_prags :: TcSpecPrags, abs_sig_ev_bind :: TcEvBinds, -- no list needed here @@ -259,8 +256,7 @@ data HsBindLR idL idR -- For details on above see note [Api annotations] in ApiAnnotation -deriving instance (DataId idL, DataId idR) - => Data (HsBindLR idL idR) +deriving instance (DataId idL, DataId idR) => Data (HsBindLR idL idR) -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds] -- @@ -275,13 +271,14 @@ deriving instance (DataId idL, DataId idR) -- See Note [AbsBinds] -- | Abtraction Bindings Export -data ABExport id - = ABE { abe_poly :: id -- ^ Any INLINE pragmas is attached to this Id - , abe_mono :: id +data ABExport p + = ABE { abe_poly :: IdP p -- ^ Any INLINE pragmas is attached to this Id + , abe_mono :: IdP p , abe_wrap :: HsWrapper -- ^ See Note [ABExport wrapper] -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly , abe_prags :: TcSpecPrags -- ^ SPECIALISE pragmas - } deriving Data + } +deriving instance (DataId p) => Data (ABExport p) -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern', -- 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnLarrow' @@ -292,14 +289,14 @@ data ABExport id -- | Pattern Synonym binding data PatSynBind idL idR - = PSB { psb_id :: Located idL, -- ^ Name of the pattern synonym + = PSB { psb_id :: Located (IdP idL), -- ^ Name of the pattern synonym psb_fvs :: PostRn idR NameSet, -- ^ See Note [Bind free vars] - psb_args :: HsPatSynDetails (Located idR), -- ^ Formal parameter names - psb_def :: LPat idR, -- ^ Right-hand side - psb_dir :: HsPatSynDir idR -- ^ Directionality + psb_args :: HsPatSynDetails (Located (IdP idR)), + -- ^ Formal parameter names + psb_def :: LPat idR, -- ^ Right-hand side + psb_dir :: HsPatSynDir idR -- ^ Directionality } -deriving instance (DataId idL, DataId idR) - => Data (PatSynBind idL idR) +deriving instance (DataId idL, DataId idR) => Data (PatSynBind idL idR) {- Note [AbsBinds] @@ -442,13 +439,15 @@ Specifically, it's just an error thunk -} -instance (OutputableBndrId idL, OutputableBndrId idR) +instance (SourceTextX idL, SourceTextX idR, + OutputableBndrId idL, OutputableBndrId idR) => Outputable (HsLocalBindsLR idL idR) where ppr (HsValBinds bs) = ppr bs ppr (HsIPBinds bs) = ppr bs ppr EmptyLocalBinds = empty -instance (OutputableBndrId idL, OutputableBndrId idR) +instance (SourceTextX idL, SourceTextX idR, + OutputableBndrId idL, OutputableBndrId idR) => Outputable (HsValBindsLR idL idR) where ppr (ValBindsIn binds sigs) = pprDeclList (pprLHsBindsForUser binds sigs) @@ -464,14 +463,16 @@ instance (OutputableBndrId idL, OutputableBndrId idR) pp_rec Recursive = text "rec" pp_rec NonRecursive = text "nonrec" -pprLHsBinds :: (OutputableBndrId idL, OutputableBndrId idR) +pprLHsBinds :: (SourceTextX idL, SourceTextX idR, + OutputableBndrId idL, OutputableBndrId idR) => LHsBindsLR idL idR -> SDoc pprLHsBinds binds | isEmptyLHsBinds binds = empty | otherwise = pprDeclList (map ppr (bagToList binds)) -pprLHsBindsForUser :: (OutputableBndrId idL, OutputableBndrId idR, - OutputableBndrId id2) +pprLHsBindsForUser :: (SourceTextX idL, SourceTextX idR, + OutputableBndrId idL, OutputableBndrId idR, + SourceTextX id2, OutputableBndrId id2) => LHsBindsLR idL idR -> [LSig id2] -> [SDoc] -- pprLHsBindsForUser is different to pprLHsBinds because -- a) No braces: 'let' and 'where' include a list of HsBindGroups @@ -562,11 +563,13 @@ So the desugarer tries to do a better job: in (fm,gm) -} -instance (OutputableBndrId idL, OutputableBndrId idR) +instance (SourceTextX idL, SourceTextX idR, + OutputableBndrId idL, OutputableBndrId idR) => Outputable (HsBindLR idL idR) where ppr mbind = ppr_monobind mbind -ppr_monobind :: (OutputableBndrId idL, OutputableBndrId idR) +ppr_monobind :: (SourceTextX idL, SourceTextX idR, + OutputableBndrId idL, OutputableBndrId idR) => HsBindLR idL idR -> SDoc ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss }) @@ -616,13 +619,14 @@ ppr_monobind (AbsBindsSig { abs_tvs = tyvars else ppr bind -instance (OutputableBndr id) => Outputable (ABExport id) where +instance (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)] -instance (OutputableBndr idL, OutputableBndrId idR) +instance (SourceTextX idR, + OutputableBndrId idL, OutputableBndrId idR) => Outputable (PatSynBind idL idR) where ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat, psb_dir = dir }) @@ -691,14 +695,14 @@ type LIPBind id = Located (IPBind id) -- For details on above see note [Api annotations] in ApiAnnotation data IPBind id - = IPBind (Either (Located HsIPName) id) (LHsExpr id) + = IPBind (Either (Located HsIPName) (IdP id)) (LHsExpr id) deriving instance (DataId name) => Data (IPBind name) -instance (OutputableBndrId id ) => Outputable (HsIPBinds id) where +instance (SourceTextX p, OutputableBndrId p) => Outputable (HsIPBinds p) where ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs) $$ ifPprDebug (ppr ds) -instance (OutputableBndrId id ) => Outputable (IPBind id) where +instance (SourceTextX p, OutputableBndrId p ) => Outputable (IPBind p) where ppr (IPBind lr rhs) = name <+> equals <+> pprExpr (unLoc rhs) where name = case lr of Left (L _ ip) -> pprBndr LetBind ip @@ -718,10 +722,10 @@ serves for both. -} -- | Located Signature -type LSig name = Located (Sig name) +type LSig pass = Located (Sig pass) -- | Signatures and pragmas -data Sig name +data Sig pass = -- | An ordinary type signature -- -- > f :: Num a => a -> a @@ -739,8 +743,8 @@ data Sig name -- For details on above see note [Api annotations] in ApiAnnotation TypeSig - [Located name] -- LHS of the signature; e.g. f,g,h :: blah - (LHsSigWcType name) -- RHS of the signature; can have wildcards + [Located (IdP pass)] -- LHS of the signature; e.g. f,g,h :: blah + (LHsSigWcType pass) -- RHS of the signature; can have wildcards -- | A pattern synonym type signature -- @@ -751,7 +755,7 @@ data Sig name -- 'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow' -- For details on above see note [Api annotations] in ApiAnnotation - | PatSynSig [Located name] (LHsSigType name) + | PatSynSig [Located (IdP pass)] (LHsSigType pass) -- P :: forall a b. Req => Prov => ty -- | A signature for a class method @@ -764,7 +768,7 @@ data Sig name -- -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault', -- 'ApiAnnotation.AnnDcolon' - | ClassOpSig Bool [Located name] (LHsSigType name) + | ClassOpSig Bool [Located (IdP pass)] (LHsSigType pass) -- | A type signature in generated code, notably the code -- generated for record selectors. We simply record @@ -782,7 +786,7 @@ data Sig name -- 'ApiAnnotation.AnnVal' -- For details on above see note [Api annotations] in ApiAnnotation - | FixSig (FixitySig name) + | FixSig (FixitySig pass) -- | An inline pragma -- @@ -795,8 +799,8 @@ data Sig name -- 'ApiAnnotation.AnnClose' -- For details on above see note [Api annotations] in ApiAnnotation - | InlineSig (Located name) -- Function name - InlinePragma -- Never defaultInlinePragma + | InlineSig (Located (IdP pass)) -- Function name + InlinePragma -- Never defaultInlinePragma -- | A specialisation pragma -- @@ -810,8 +814,8 @@ data Sig name -- 'ApiAnnotation.AnnDcolon' -- For details on above see note [Api annotations] in ApiAnnotation - | SpecSig (Located name) -- Specialise a function or datatype ... - [LHsSigType name] -- ... to these types + | SpecSig (Located (IdP pass)) -- Specialise a function or datatype ... + [LHsSigType pass] -- ... to these types InlinePragma -- The pragma on SPECIALISE_INLINE form. -- If it's just defaultInlinePragma, then we said -- SPECIALISE, not SPECIALISE_INLINE @@ -827,7 +831,7 @@ data Sig name -- 'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose' -- For details on above see note [Api annotations] in ApiAnnotation - | SpecInstSig SourceText (LHsSigType name) + | SpecInstSig SourceText (LHsSigType pass) -- Note [Pragma source text] in BasicTypes -- | A minimal complete definition pragma @@ -839,7 +843,7 @@ data Sig name -- 'ApiAnnotation.AnnClose' -- For details on above see note [Api annotations] in ApiAnnotation - | MinimalSig SourceText (LBooleanFormula (Located name)) + | MinimalSig SourceText (LBooleanFormula (Located (IdP pass))) -- Note [Pragma source text] in BasicTypes -- | A "set cost centre" pragma for declarations @@ -851,7 +855,7 @@ data Sig name -- > {-# SCC funName "cost_centre_name" #-} | SCCFunSig SourceText -- Note [Pragma source text] in BasicTypes - (Located name) -- Function name + (Located (IdP pass)) -- Function name (Maybe (Located StringLiteral)) -- | A complete match pragma -- @@ -860,16 +864,18 @@ data Sig name -- Used to inform the pattern match checker about additional -- complete matchings which, for example, arise from pattern -- synonym definitions. - | CompleteMatchSig SourceText (Located [Located name]) (Maybe (Located name)) + | CompleteMatchSig SourceText + (Located [Located (IdP pass)]) + (Maybe (Located (IdP pass))) -deriving instance (DataId name) => Data (Sig name) +deriving instance (DataId pass) => Data (Sig pass) -- | Located Fixity Signature -type LFixitySig name = Located (FixitySig name) +type LFixitySig pass = Located (FixitySig pass) -- | Fixity Signature -data FixitySig name = FixitySig [Located name] Fixity - deriving Data +data FixitySig pass = FixitySig [Located (IdP pass)] Fixity +deriving instance (DataId pass) => Data (FixitySig pass) -- | Type checker Specialisation Pragmas -- @@ -969,10 +975,11 @@ signatures. Since some of the signatures contain a list of names, testing for equality is not enough -- we have to check if they overlap. -} -instance (OutputableBndrId name ) => Outputable (Sig name) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (Sig pass) where ppr sig = ppr_sig sig -ppr_sig :: (OutputableBndrId name ) => Sig name -> SDoc +ppr_sig :: (SourceTextX pass, OutputableBndrId pass ) => Sig pass -> SDoc ppr_sig (TypeSig vars ty) = pprVarSig (map unLoc vars) (ppr ty) ppr_sig (ClassOpSig is_deflt vars ty) | is_deflt = text "default" <+> pprVarSig (map unLoc vars) (ppr ty) @@ -1004,7 +1011,7 @@ ppr_sig (CompleteMatchSig src cs mty) where opt_sig = maybe empty ((\t -> dcolon <+> ppr t) . unLoc) mty -instance OutputableBndr name => Outputable (FixitySig name) where +instance OutputableBndrId pass => Outputable (FixitySig pass) where ppr (FixitySig names fixity) = sep [ppr fixity, pprops] where pprops = hsep $ punctuate comma (map (pprInfixOcc . unLoc) names) |