diff options
Diffstat (limited to 'compiler/GHC/Core')
| -rw-r--r-- | compiler/GHC/Core/ConLike.hs | 14 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Env.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Core/PatSyn.hs | 93 |
3 files changed, 64 insertions, 47 deletions
diff --git a/compiler/GHC/Core/ConLike.hs b/compiler/GHC/Core/ConLike.hs index efe29f608f..bbdab332a7 100644 --- a/compiler/GHC/Core/ConLike.hs +++ b/compiler/GHC/Core/ConLike.hs @@ -16,13 +16,13 @@ module GHC.Core.ConLike ( , conLikeExTyCoVars , conLikeName , conLikeStupidTheta - , conLikeWrapId_maybe , conLikeImplBangs , conLikeFullSig , conLikeResTy , conLikeFieldType , conLikesWithFields , conLikeIsInfix + , conLikeHasBuilder ) where #include "HsVersions.h" @@ -41,6 +41,7 @@ import GHC.Types.Var import GHC.Core.Type(mkTyConApp) import GHC.Core.Multiplicity +import Data.Maybe( isJust ) import qualified Data.Data as Data {- @@ -144,12 +145,11 @@ conLikeStupidTheta :: ConLike -> ThetaType conLikeStupidTheta (RealDataCon data_con) = dataConStupidTheta data_con conLikeStupidTheta (PatSynCon {}) = [] --- | Returns the `Id` of the wrapper. This is also known as the builder in --- some contexts. The value is Nothing only in the case of unidirectional --- pattern synonyms. -conLikeWrapId_maybe :: ConLike -> Maybe Id -conLikeWrapId_maybe (RealDataCon data_con) = Just $ dataConWrapId data_con -conLikeWrapId_maybe (PatSynCon pat_syn) = fst <$> patSynBuilder pat_syn +-- | 'conLikeHasBuilder' returns True except for +-- uni-directional pattern synonyms, which have no builder +conLikeHasBuilder :: ConLike -> Bool +conLikeHasBuilder (RealDataCon {}) = True +conLikeHasBuilder (PatSynCon pat_syn) = isJust (patSynBuilder pat_syn) -- | Returns the strictness information for each constructor conLikeImplBangs :: ConLike -> [HsImplBang] diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs index 8ef66a6a9d..180e562c73 100644 --- a/compiler/GHC/Core/Opt/Simplify/Env.hs +++ b/compiler/GHC/Core/Opt/Simplify/Env.hs @@ -60,7 +60,6 @@ import GHC.Data.OrdList import GHC.Types.Id as Id import GHC.Core.Make ( mkWildValBinder ) import GHC.Driver.Session ( DynFlags ) -import GHC.Driver.Ppr import GHC.Builtin.Types import GHC.Core.TyCo.Rep ( TyCoBinder(..) ) import qualified GHC.Core.Type as Type @@ -683,7 +682,8 @@ refineFromInScope :: InScopeSet -> Var -> Var refineFromInScope in_scope v | isLocalId v = case lookupInScope in_scope v of Just v' -> v' - Nothing -> WARN( True, ppr v ) v -- This is an error! + Nothing -> pprPanic "refineFromInScope" (ppr in_scope $$ ppr v) + -- c.f #19074 for a subtle place where this went wrong | otherwise = v lookupRecBndr :: SimplEnv -> InId -> OutId diff --git a/compiler/GHC/Core/PatSyn.hs b/compiler/GHC/Core/PatSyn.hs index b07b8265a7..3fa12a626a 100644 --- a/compiler/GHC/Core/PatSyn.hs +++ b/compiler/GHC/Core/PatSyn.hs @@ -9,10 +9,10 @@ module GHC.Core.PatSyn ( -- * Main data types - PatSyn, mkPatSyn, + PatSyn, PatSynMatcher, PatSynBuilder, mkPatSyn, -- ** Type deconstruction - patSynName, patSynArity, patSynIsInfix, + patSynName, patSynArity, patSynIsInfix, patSynResultType, patSynArgs, patSynMatcher, patSynBuilder, patSynUnivTyVarBinders, patSynExTyVars, patSynExTyVarBinders, @@ -20,7 +20,7 @@ module GHC.Core.PatSyn ( patSynInstArgTys, patSynInstResTy, patSynFieldLabels, patSynFieldType, - updatePatSynIds, pprPatSynType + pprPatSynType ) where #include "HsVersions.h" @@ -86,34 +86,38 @@ data PatSyn -- See Note [Pattern synonym result type] -- See Note [Matchers and builders for pattern synonyms] - psMatcher :: (Id, Bool), - -- Matcher function. - -- If Bool is True then prov_theta and arg_tys are empty - -- and type is - -- forall (p :: RuntimeRep) (r :: TYPE p) univ_tvs. - -- req_theta - -- => res_ty - -- -> (forall ex_tvs. Void# -> r) - -- -> (Void# -> r) - -- -> r - -- - -- Otherwise type is - -- forall (p :: RuntimeRep) (r :: TYPE r) univ_tvs. - -- req_theta - -- => res_ty - -- -> (forall ex_tvs. prov_theta => arg_tys -> r) - -- -> (Void# -> r) - -- -> r - - psBuilder :: Maybe (Id, Bool) - -- Nothing => uni-directional pattern synonym - -- Just (builder, is_unlifted) => bi-directional - -- Builder function, of type - -- forall univ_tvs, ex_tvs. (req_theta, prov_theta) - -- => arg_tys -> res_ty - -- See Note [Builder for pattern synonyms with unboxed type] + -- See Note [Keep Ids out of PatSyn] + psMatcher :: PatSynMatcher, + psBuilder :: PatSynBuilder } +type PatSynMatcher = (Name, Type, Bool) + -- Matcher function. + -- If Bool is True then prov_theta and arg_tys are empty + -- and type is + -- forall (p :: RuntimeRep) (r :: TYPE p) univ_tvs. + -- req_theta + -- => res_ty + -- -> (forall ex_tvs. Void# -> r) + -- -> (Void# -> r) + -- -> r + -- + -- Otherwise type is + -- forall (p :: RuntimeRep) (r :: TYPE r) univ_tvs. + -- req_theta + -- => res_ty + -- -> (forall ex_tvs. prov_theta => arg_tys -> r) + -- -> (Void# -> r) + -- -> r + +type PatSynBuilder = Maybe (Name, Type, Bool) + -- Nothing => uni-directional pattern synonym + -- Just (builder, is_unlifted) => bi-directional + -- Builder function, of type + -- forall univ_tvs, ex_tvs. (req_theta, prov_theta) + -- => arg_tys -> res_ty + -- See Note [Builder for pattern synonyms with unboxed type] + {- Note [Pattern synonym signature contexts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In a pattern synonym signature we write @@ -203,6 +207,22 @@ The latter generates the proper required constraint, the former does not. Also rather different to GADTs is the fact that Just42 doesn't have any universally quantified type variables, whereas Just'42 or MkS above has. +Note [Keep Ids out of PatSyn] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We carefully arrange that PatSyn does not contain the Ids for the matcher +and builder. We want PatSyn, like TyCon and DataCon, to be completely +immutable. But, the matcher and builder are relatively sophisticated +functions, and we want to get their final IdInfo in the same way as +any other Id, so we'd have to update the Ids in the PatSyn too. + +Rather than try to tidy PatSyns (which is easy to forget and is a bit +tricky, see #19074), it seems cleaner to make them entirely immutable, +like TyCons and Classes. To that end PatSynBuilder and PatSynMatcher +contain Names not Ids. Which, it turns out, is absolutely fine. + +c.f. DefMethInfo in Class, which contains the Name, but not the Id, +of the default method. + Note [Pattern synonym representation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the following pattern synonym declaration @@ -363,8 +383,8 @@ mkPatSyn :: Name -- variables and provided dicts -> [Type] -- ^ Original arguments -> Type -- ^ Original result type - -> (Id, Bool) -- ^ Name of matcher - -> Maybe (Id, Bool) -- ^ Name of builder + -> PatSynMatcher -- ^ Matcher + -> PatSynBuilder -- ^ Builder -> [FieldLabel] -- ^ Names of fields for -- a record pattern synonym -> PatSyn @@ -433,17 +453,14 @@ patSynSig :: PatSyn -> ([TyVar], ThetaType, [TyVar], ThetaType, [Scaled Type], T patSynSig ps = let (u_tvs, req, e_tvs, prov, arg_tys, res_ty) = patSynSigBndr ps in (binderVars u_tvs, req, binderVars e_tvs, prov, arg_tys, res_ty) -patSynMatcher :: PatSyn -> (Id,Bool) +patSynMatcher :: PatSyn -> PatSynMatcher patSynMatcher = psMatcher -patSynBuilder :: PatSyn -> Maybe (Id, Bool) +patSynBuilder :: PatSyn -> PatSynBuilder patSynBuilder = psBuilder -updatePatSynIds :: (Id -> Id) -> PatSyn -> PatSyn -updatePatSynIds tidy_fn ps@(MkPatSyn { psMatcher = matcher, psBuilder = builder }) - = ps { psMatcher = tidy_pr matcher, psBuilder = fmap tidy_pr builder } - where - tidy_pr (id, dummy) = (tidy_fn id, dummy) +patSynResultType :: PatSyn -> Type +patSynResultType = psResultTy patSynInstArgTys :: PatSyn -> [Type] -> [Type] -- Return the types of the argument patterns |