summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Core')
-rw-r--r--compiler/GHC/Core/Coercion.hs4
-rw-r--r--compiler/GHC/Core/DataCon.hs2
-rw-r--r--compiler/GHC/Core/Opt/Simplify/Monad.hs5
-rw-r--r--compiler/GHC/Core/Opt/SpecConstr.hs8
-rw-r--r--compiler/GHC/Core/TyCo/Rep.hs-boot1
-rw-r--r--compiler/GHC/Core/Type.hs14
-rw-r--r--compiler/GHC/Core/Type.hs-boot4
-rw-r--r--compiler/GHC/Core/Utils.hs3
8 files changed, 20 insertions, 21 deletions
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 _ _)
View Lorry Controller Status