diff options
-rw-r--r-- | compiler/GHC/Builtin/Names.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types.hs-boot | 6 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types/Prim.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/Core/Coercion.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/DataCon.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Monad.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/SpecConstr.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Core/TyCo/Rep.hs-boot | 1 | ||||
-rw-r--r-- | compiler/GHC/Core/Type.hs | 14 | ||||
-rw-r--r-- | compiler/GHC/Core/Type.hs-boot | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Utils.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/CoreToStg/Prep.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Stg/Lint.hs | 17 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Hole.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/TcType.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Types/Id/Make.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Types/RepType.hs | 11 |
18 files changed, 50 insertions, 66 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs index 62511b3cfc..e99cb5a1c6 100644 --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -316,7 +316,6 @@ basicKnownKeyNames newStablePtrName, -- GHC Extensions - groupWithName, considerAccessibleName, -- Strings and lists @@ -1111,8 +1110,7 @@ alternativeClassKey = mkPreludeMiscIdUnique 754 -- Functions for GHC extensions -groupWithName, considerAccessibleName :: Name -groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey +considerAccessibleName :: Name considerAccessibleName = varQual gHC_EXTS (fsLit "considerAccessible") considerAccessibleIdKey -- Random GHC.Base functions @@ -2328,9 +2326,8 @@ inlineIdKey, noinlineIdKey :: Unique inlineIdKey = mkPreludeMiscIdUnique 120 -- see below -mapIdKey, groupWithIdKey, dollarIdKey, coercionTokenIdKey, considerAccessibleIdKey :: Unique +mapIdKey, dollarIdKey, coercionTokenIdKey, considerAccessibleIdKey :: Unique mapIdKey = mkPreludeMiscIdUnique 121 -groupWithIdKey = mkPreludeMiscIdUnique 122 dollarIdKey = mkPreludeMiscIdUnique 123 coercionTokenIdKey = mkPreludeMiscIdUnique 124 noinlineIdKey = mkPreludeMiscIdUnique 125 diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs index e566dea938..148b9aa1ca 100644 --- a/compiler/GHC/Builtin/Types.hs +++ b/compiler/GHC/Builtin/Types.hs @@ -179,6 +179,7 @@ import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) import GHC.Core.Type import qualified GHC.Core.TyCo.Rep as TyCoRep (Type(TyConApp)) +import GHC.Core.TyCo.Rep (RuntimeRepType) import GHC.Types.RepType import GHC.Core.DataCon import GHC.Core.ConLike @@ -1530,7 +1531,7 @@ liftedRepTyCon where rhs = TyCoRep.TyConApp boxedRepDataConTyCon [liftedDataConTy] -liftedRepTy :: Type +liftedRepTy :: RuntimeRepType liftedRepTy = mkTyConTy liftedRepTyCon ---------------------- @@ -1541,7 +1542,7 @@ unliftedRepTyCon where rhs = TyCoRep.TyConApp boxedRepDataConTyCon [unliftedDataConTy] -unliftedRepTy :: Type +unliftedRepTy :: RuntimeRepType unliftedRepTy = mkTyConTy unliftedRepTyCon ---------------------- @@ -1552,7 +1553,7 @@ zeroBitRepTyCon where rhs = TyCoRep.TyConApp tupleRepDataConTyCon [mkPromotedListTy runtimeRepTy []] -zeroBitRepTy :: Type +zeroBitRepTy :: RuntimeRepType zeroBitRepTy = mkTyConTy zeroBitRepTyCon @@ -1708,7 +1709,7 @@ intRepDataConTy, wordRepDataConTy, word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy, addrRepDataConTy, - floatRepDataConTy, doubleRepDataConTy :: Type + floatRepDataConTy, doubleRepDataConTy :: RuntimeRepType [intRepDataConTy, int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy, wordRepDataConTy, diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot index f65781f1d7..3149e1f55b 100644 --- a/compiler/GHC/Builtin/Types.hs-boot +++ b/compiler/GHC/Builtin/Types.hs-boot @@ -1,7 +1,7 @@ module GHC.Builtin.Types where import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) -import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type, Kind) +import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type, Kind, RuntimeRepType) import {-# SOURCE #-} GHC.Core.DataCon ( DataCon ) import GHC.Types.Basic (Arity, TupleSort, Boxity, ConTag) @@ -33,7 +33,7 @@ runtimeRepTy, levityTy :: Type boxedRepDataConTyCon, liftedDataConTyCon :: TyCon vecRepDataConTyCon, tupleRepDataConTyCon :: TyCon -liftedRepTy, unliftedRepTy, zeroBitRepTy :: Type +liftedRepTy, unliftedRepTy, zeroBitRepTy :: RuntimeRepType liftedDataConTy, unliftedDataConTy :: Type intRepDataConTy, @@ -41,7 +41,7 @@ intRepDataConTy, wordRepDataConTy, word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy, addrRepDataConTy, - floatRepDataConTy, doubleRepDataConTy :: Type + floatRepDataConTy, doubleRepDataConTy :: RuntimeRepType vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy, vec64DataConTy :: Type diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs index aa867cc6ed..e4d812a203 100644 --- a/compiler/GHC/Builtin/Types/Prim.hs +++ b/compiler/GHC/Builtin/Types/Prim.hs @@ -107,7 +107,7 @@ module GHC.Builtin.Types.Prim( import GHC.Prelude import {-# SOURCE #-} GHC.Builtin.Types - ( runtimeRepTy, levityTy, unboxedTupleKind, liftedTypeKind + ( runtimeRepTy, levityTy, unboxedTupleKind, liftedTypeKind, unliftedTypeKind , boxedRepDataConTyCon, vecRepDataConTyCon , liftedRepTy, unliftedRepTy, zeroBitRepTy , intRepDataConTy @@ -388,7 +388,7 @@ alphaTy, betaTy, gammaTy, deltaTy :: Type (alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys alphaTyVarsUnliftedRep :: [TyVar] -alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat (mkTYPEapp unliftedRepTy) +alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat unliftedTypeKind alphaTyVarUnliftedRep :: TyVar (alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep @@ -406,7 +406,7 @@ runtimeRep1TyVarInf, runtimeRep2TyVarInf :: TyVarBinder runtimeRep1TyVarInf = mkTyVarBinder Inferred runtimeRep1TyVar runtimeRep2TyVarInf = mkTyVarBinder Inferred runtimeRep2TyVar -runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty :: Type +runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty :: RuntimeRepType runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar runtimeRep3Ty = mkTyVarTy runtimeRep3TyVar @@ -925,9 +925,6 @@ realWorldTy = mkTyConTy realWorldTyCon realWorldStatePrimTy :: Type realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld --- Note: the ``state-pairing'' types are not truly primitive, --- so they are defined in \tr{GHC.Builtin.Types}, not here. - mkProxyPrimTy :: Type -> Type -> Type mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty] diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs index 235e8c65fb..dfd50df83c 100644 --- a/compiler/GHC/Core/Coercion.hs +++ b/compiler/GHC/Core/Coercion.hs @@ -886,7 +886,7 @@ once ~# is made to be homogeneous. -- See Note [Unused coercion variable in ForAllCo] mkForAllCo :: TyCoVar -> CoercionN -> Coercion -> Coercion mkForAllCo v kind_co co - | assert (varType v `eqType` (pFst $ coercionKind kind_co)) True + | assert (varType v `eqType` (coercionLKind kind_co)) True , assert (isTyVar v || almostDevoidCoVarOfCo v co) True , Just (ty, r) <- isReflCo_maybe co , isGReflCo kind_co @@ -899,7 +899,7 @@ mkForAllCo v kind_co co -- The kind of the tycovar should be the left-hand kind of the kind coercion. mkForAllCo_NoRefl :: TyCoVar -> CoercionN -> Coercion -> Coercion mkForAllCo_NoRefl v kind_co co - | assert (varType v `eqType` (pFst $ coercionKind kind_co)) True + | assert (varType v `eqType` (coercionLKind kind_co)) True , assert (isTyVar v || almostDevoidCoVarOfCo v co) True , assert (not (isReflCo co)) True , isCoVar v diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs index 07419b9c5c..064cdc866f 100644 --- a/compiler/GHC/Core/DataCon.hs +++ b/compiler/GHC/Core/DataCon.hs @@ -1555,7 +1555,7 @@ dataConInstUnivs dc dc_args = chkAppend dc_args $ map mkTyVarTy dc_args_suffix (text "dataConInstUnivs" <+> ppr dc_args <+> ppr (dataConUnivTyVars dc)) $ - splitAt (length dc_args) $ dataConUnivTyVars dc + splitAtList dc_args $ dataConUnivTyVars dc (_, dc_args_suffix) = substTyVarBndrs prefix_subst dc_univs_suffix prefix_subst = mkTvSubst prefix_in_scope prefix_env prefix_in_scope = mkInScopeSet $ tyCoVarsOfTypes dc_args diff --git a/compiler/GHC/Core/Opt/Simplify/Monad.hs b/compiler/GHC/Core/Opt/Simplify/Monad.hs index 8ee49f4968..33318f5d58 100644 --- a/compiler/GHC/Core/Opt/Simplify/Monad.hs +++ b/compiler/GHC/Core/Opt/Simplify/Monad.hs @@ -24,7 +24,7 @@ import GHC.Prelude import GHC.Types.Var ( Var, isId, mkLocalVar ) import GHC.Types.Name ( mkSystemVarName ) -import GHC.Types.Id ( Id, mkSysLocalOrCoVar ) +import GHC.Types.Id ( Id, mkSysLocalOrCoVarM ) import GHC.Types.Id.Info ( IdDetails(..), vanillaIdInfo, setArityInfo ) import GHC.Core.Type ( Type, Mult ) import GHC.Core.FamInstEnv ( FamInstEnv ) @@ -219,8 +219,7 @@ getOptCoercionOpts :: SimplM OptCoercionOpts getOptCoercionOpts = SM (\st_env sc -> return (st_co_opt_opts st_env, sc)) newId :: FastString -> Mult -> Type -> SimplM Id -newId fs w ty = do uniq <- getUniqueM - return (mkSysLocalOrCoVar fs uniq w ty) +newId fs w ty = mkSysLocalOrCoVarM fs w ty -- | Make a join id with given type and arity but without call-by-value annotations. newJoinId :: [Var] -> Type -> SimplM Id diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs index c4517c1c52..d3b9396b2a 100644 --- a/compiler/GHC/Core/Opt/SpecConstr.hs +++ b/compiler/GHC/Core/Opt/SpecConstr.hs @@ -2522,11 +2522,11 @@ setStrUnfolding id str -- | wildCardPats are always boring wildCardPat :: Type -> StrictnessMark -> UniqSM (Bool, CoreArg) wildCardPat ty str - = do { uniq <- getUniqueM - ; let id = mkSysLocalOrCoVar (fsLit "sc") uniq Many ty `setStrUnfolding` str + = do { id <- mkSysLocalOrCoVarM (fsLit "sc") Many ty + ; let id' = id `setStrUnfolding` str -- See Note [SpecConstr and evaluated unfoldings] - -- ; pprTraceM "wildCardPat" (ppr id <+> ppr (idUnfolding id)) - ; return (False, varToCoreExpr id) } + -- ; pprTraceM "wildCardPat" (ppr id' <+> ppr (idUnfolding id')) + ; return (False, varToCoreExpr id') } isValue :: ValueEnv -> CoreExpr -> Maybe Value isValue _env (Lit lit) diff --git a/compiler/GHC/Core/TyCo/Rep.hs-boot b/compiler/GHC/Core/TyCo/Rep.hs-boot index f2e59d534f..ffbbf64a1e 100644 --- a/compiler/GHC/Core/TyCo/Rep.hs-boot +++ b/compiler/GHC/Core/TyCo/Rep.hs-boot @@ -17,6 +17,7 @@ data Scaled a type Mult = Type type PredType = Type +type RuntimeRepType = Type type Kind = Type type ThetaType = [PredType] type CoercionN = Coercion diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs index 76dec32239..d9d8b41f33 100644 --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -651,7 +651,7 @@ isTyConKeyApp_maybe key ty -- | Extract the RuntimeRep classifier of a type from its kind. For example, -- @kindRep * = LiftedRep@; Panics if this is not possible. -- Treats * and Constraint as the same -kindRep :: HasDebugCallStack => Kind -> Type +kindRep :: HasDebugCallStack => Kind -> RuntimeRepType kindRep k = case kindRep_maybe k of Just r -> r Nothing -> pprPanic "kindRep" (ppr k) @@ -660,7 +660,7 @@ kindRep k = case kindRep_maybe k of -- For example, @kindRep_maybe * = Just LiftedRep@ -- Returns 'Nothing' if the kind is not of form (TYPE rr) -- Treats * and Constraint as the same -kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type +kindRep_maybe :: HasDebugCallStack => Kind -> Maybe RuntimeRepType kindRep_maybe kind | Just [arg] <- isTyConKeyApp_maybe tYPETyConKey kind = Just arg | otherwise = Nothing @@ -1725,13 +1725,13 @@ mkTyConApp tycon tys@(ty1:rest) key = tyConUnique tycon bale_out = TyConApp tycon tys -mkTYPEapp :: Type -> Type +mkTYPEapp :: RuntimeRepType -> Type mkTYPEapp rr = case mkTYPEapp_maybe rr of Just ty -> ty Nothing -> TyConApp tYPETyCon [rr] -mkTYPEapp_maybe :: Type -> Maybe Type +mkTYPEapp_maybe :: RuntimeRepType -> Maybe Type -- ^ Given a @RuntimeRep@, applies @TYPE@ to it. -- On the fly it rewrites -- TYPE LiftedRep --> liftedTypeKind (a synonym) @@ -2529,12 +2529,12 @@ dropRuntimeRepArgs = dropWhile isRuntimeRepKindedTy -- @getRuntimeRep_maybe Int = Just LiftedRep@. Returns 'Nothing' if this is not -- possible. getRuntimeRep_maybe :: HasDebugCallStack - => Type -> Maybe Type + => Type -> Maybe RuntimeRepType getRuntimeRep_maybe = kindRep_maybe . typeKind -- | Extract the RuntimeRep classifier of a type. For instance, -- @getRuntimeRep_maybe Int = LiftedRep@. Panics if this is not possible. -getRuntimeRep :: HasDebugCallStack => Type -> Type +getRuntimeRep :: HasDebugCallStack => Type -> RuntimeRepType getRuntimeRep ty = case getRuntimeRep_maybe ty of Just r -> r @@ -3135,7 +3135,7 @@ tcIsConstraintKind ty -- | Like 'kindRep_maybe', but considers 'Constraint' to be distinct -- from 'Type'. For a version that treats them as the same type, see -- 'kindRep_maybe'. -tcKindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type +tcKindRep_maybe :: HasDebugCallStack => Kind -> Maybe RuntimeRepType tcKindRep_maybe kind | Just (tc, [arg]) <- tcSplitTyConApp_maybe kind -- Note: tcSplit here , tc `hasKey` tYPETyConKey = Just arg diff --git a/compiler/GHC/Core/Type.hs-boot b/compiler/GHC/Core/Type.hs-boot index f5b9c6f20d..5b91063a08 100644 --- a/compiler/GHC/Core/Type.hs-boot +++ b/compiler/GHC/Core/Type.hs-boot @@ -4,7 +4,7 @@ module GHC.Core.Type where import GHC.Prelude import {-# SOURCE #-} GHC.Core.TyCon -import {-# SOURCE #-} GHC.Core.TyCo.Rep( Type, Coercion ) +import {-# SOURCE #-} GHC.Core.TyCo.Rep( Type, RuntimeRepType, Coercion ) import GHC.Utils.Misc isPredTy :: HasDebugCallStack => Type -> Bool @@ -22,7 +22,7 @@ isRuntimeRepTy :: Type -> Bool isLevityTy :: Type -> Bool isMultiplicityTy :: Type -> Bool isLiftedTypeKind :: Type -> Bool -mkTYPEapp :: Type -> Type +mkTYPEapp :: RuntimeRepType -> Type splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type]) tyConAppTyCon_maybe :: Type -> Maybe TyCon diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index 73cf2712d3..6811498c54 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -103,7 +103,6 @@ import GHC.Types.Unique.Set import GHC.Data.FastString import GHC.Data.Maybe import GHC.Data.List.SetOps( minusList ) -import GHC.Data.Pair import GHC.Data.OrdList import GHC.Utils.Constants (debugIsOn) @@ -139,7 +138,7 @@ exprType (Let bind body) , Type ty <- rhs = substTyWithUnchecked [tv] [ty] (exprType body) | otherwise = exprType body exprType (Case _ _ ty _) = ty -exprType (Cast _ co) = pSnd (coercionKind co) +exprType (Cast _ co) = coercionRKind co exprType (Tick _ e) = exprType e exprType (Lam binder expr) = mkLamType binder (exprType expr) exprType e@(App _ _) diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs index e7b546803c..63aeba48ca 100644 --- a/compiler/GHC/CoreToStg/Prep.hs +++ b/compiler/GHC/CoreToStg/Prep.hs @@ -2180,9 +2180,7 @@ fiddleCCall id newVar :: Type -> UniqSM Id newVar ty - = seqType ty `seq` do - uniq <- getUniqueM - return (mkSysLocalOrCoVar (fsLit "sat") uniq Many ty) + = seqType ty `seq` mkSysLocalOrCoVarM (fsLit "sat") Many ty ------------------------------------------------------------------------------ diff --git a/compiler/GHC/Stg/Lint.hs b/compiler/GHC/Stg/Lint.hs index acc785346f..cd9f3dff03 100644 --- a/compiler/GHC/Stg/Lint.hs +++ b/compiler/GHC/Stg/Lint.hs @@ -116,7 +116,6 @@ import GHC.Runtime.Context ( InteractiveContext ) import GHC.Data.Bag ( Bag, emptyBag, isEmptyBag, snocBag, bagToList ) -import Control.Applicative ((<|>)) import Control.Monad import Data.Maybe import GHC.Utils.Misc @@ -499,15 +498,13 @@ checkPostUnariseConArg arg = case arg of -- Post-unarisation args and case alt binders should not have unboxed tuple, -- unboxed sum, or void types. Return what the binder is if it is one of these. checkPostUnariseId :: Id -> Maybe String -checkPostUnariseId id = - let - id_ty = idType id - is_sum, is_tuple, is_void :: Maybe String - is_sum = guard (isUnboxedSumType id_ty) >> return "unboxed sum" - is_tuple = guard (isUnboxedTupleType id_ty) >> return "unboxed tuple" - is_void = guard (isZeroBitTy id_ty) >> return "void" - in - is_sum <|> is_tuple <|> is_void +checkPostUnariseId id + | isUnboxedSumType id_ty = Just "unboxed sum" + | isUnboxedTupleType id_ty = Just "unboxed tuple" + | isZeroBitTy id_ty = Just "void" + | otherwise = Nothing + where + id_ty = idType id addErrL :: SDoc -> LintM () addErrL msg = LintM $ \_mod _lf df _opts loc _scope errs -> ((), addErr df errs msg loc) diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs index fcae57f975..f0a8e7aa8e 100644 --- a/compiler/GHC/Tc/Errors/Hole.hs +++ b/compiler/GHC/Tc/Errors/Hole.hs @@ -677,8 +677,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _ -- of only concrete hole fits like `sum`. mkRefTy :: Int -> TcM (TcType, [TcTyVar]) mkRefTy refLvl = (wrapWithVars &&& id) <$> newTyVars - where newTyVars = replicateM refLvl $ setLvl <$> - (newOpenTypeKind >>= newFlexiTyVar) + where newTyVars = replicateM refLvl $ setLvl <$> newOpenFlexiTyVar setLvl = flip setMetaTyVarTcLevel hole_lvl wrapWithVars vars = mkVisFunTysMany (map mkTyVarTy vars) hole_ty diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs index bb9f5aa910..b40c77c11b 100644 --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -175,8 +175,8 @@ module GHC.Tc.Utils.TcType ( substCoUnchecked, substCoWithUnchecked, substTheta, - isUnliftedType, -- Source types are always lifted - isUnboxedTupleType, -- Ditto + isUnliftedType, + isUnboxedTupleType, isPrimitiveType, tcView, coreView, diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs index 4180e557c8..3089c6533f 100644 --- a/compiler/GHC/Types/Id/Make.hs +++ b/compiler/GHC/Types/Id/Make.hs @@ -970,8 +970,7 @@ newLocal :: FastString -- ^ a string which will form part of the 'Var'\'s name -> Scaled Type -- ^ the type of the 'Var' -> UniqSM Var newLocal name_stem (Scaled w ty) = - do { uniq <- getUniqueM - ; return (mkSysLocalOrCoVar name_stem uniq w ty) } + mkSysLocalOrCoVarM name_stem w ty -- We should not have "OrCoVar" here, this is a bug (#17545) @@ -1410,7 +1409,7 @@ proxyHashId -- -- The visibility of the `k` binder is Inferred to match the type of the -- Proxy data constructor (#16293). - [kv,tv] = mkTemplateKiTyVars [liftedTypeKind] id + [kv,tv] = mkTemplateKiTyVar liftedTypeKind (\x -> [x]) kv_ty = mkTyVarTy kv tv_ty = mkTyVarTy tv ty = mkInfForAllTy kv $ mkSpecForAllTy tv $ mkProxyPrimTy kv_ty tv_ty diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs index 28bf5cb7d4..2c0d93afb5 100644 --- a/compiler/GHC/Types/RepType.hs +++ b/compiler/GHC/Types/RepType.hs @@ -578,11 +578,8 @@ tyConPrimRep1 tc = case tyConPrimRep tc of -- See also Note [Getting from RuntimeRep to PrimRep] kindPrimRep :: HasDebugCallStack => SDoc -> Kind -> [PrimRep] kindPrimRep doc ki - | Just ki' <- coreView ki - = kindPrimRep doc ki' -kindPrimRep doc (TyConApp typ [runtime_rep]) - = assert (typ `hasKey` tYPETyConKey) $ - runtimeRepPrimRep doc runtime_rep + | Just runtime_rep <- kindRep_maybe ki + = runtimeRepPrimRep doc runtime_rep kindPrimRep doc ki = pprPanic "kindPrimRep" (ppr ki $$ doc) @@ -606,7 +603,7 @@ kindPrimRep_maybe _ki -- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that -- it encodes. See also Note [Getting from RuntimeRep to PrimRep] -- The [PrimRep] is the final runtime representation /after/ unarisation -runtimeRepPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep] +runtimeRepPrimRep :: HasDebugCallStack => SDoc -> RuntimeRepType -> [PrimRep] runtimeRepPrimRep doc rr_ty | Just rr_ty' <- coreView rr_ty = runtimeRepPrimRep doc rr_ty' @@ -631,7 +628,7 @@ runtimeRepPrimRep_maybe rr_ty = Nothing -- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep -primRepToRuntimeRep :: PrimRep -> Type +primRepToRuntimeRep :: PrimRep -> RuntimeRepType primRepToRuntimeRep rep = case rep of VoidRep -> zeroBitRepTy LiftedRep -> liftedRepTy |