summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Core.hs2
-rw-r--r--compiler/GHC/Core/Coercion.hs18
-rw-r--r--compiler/GHC/Core/Opt/ConstantFold.hs4
-rw-r--r--compiler/GHC/Core/Type.hs8
-rw-r--r--compiler/GHC/Driver/Session.hs1
-rw-r--r--compiler/GHC/HsToCore/Expr.hs2
-rw-r--r--compiler/GHC/HsToCore/Utils.hs2
-rw-r--r--compiler/GHC/Tc/TyCl/PatSyn.hs7
-rw-r--r--compiler/GHC/Types/Id/Make.hs6
-rw-r--r--compiler/GHC/Utils/Outputable.hs2
10 files changed, 15 insertions, 37 deletions
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index ad1d87feae..4e58df6fc9 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -772,7 +772,7 @@ However, join points have simpler invariants in other ways
e.g. let j :: Int# = factorial x in ...
6. The RHS of join point is not required to have a fixed runtime representation,
- e.g. let j :: r :: TYPE l = fail void# in ...
+ e.g. let j :: r :: TYPE l = fail (##) in ...
This happened in an intermediate program #13394
Examples:
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index d1a9efc843..dc3f7d277f 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -45,7 +45,6 @@ module GHC.Core.Coercion (
mkKindCo,
castCoercionKind, castCoercionKind1, castCoercionKind2,
- mkHeteroCoercionType,
mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole,
mkHeteroPrimEqPred, mkHeteroReprPrimEqPred,
@@ -77,7 +76,6 @@ module GHC.Core.Coercion (
-- ** Coercion variables
mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique,
- isCoVar_maybe,
-- ** Free variables
tyCoVarsOfCo, tyCoVarsOfCos, coVarsOfCo,
@@ -521,7 +519,9 @@ decomposePiCos orig_co (Pair orig_k1 orig_k2) orig_args
-- didn't have enough binders
go acc_arg_cos _ki1 co _ki2 _tys = (reverse acc_arg_cos, co)
--- | Attempts to obtain the type variable underlying a 'Coercion'
+-- | Extract a covar, if possible. This check is dirty. Be ashamed
+-- of yourself. (It's dirty because it cares about the structure of
+-- a coercion, which is morally reprehensible.)
getCoVar_maybe :: Coercion -> Maybe CoVar
getCoVar_maybe (CoVarCo cv) = Just cv
getCoVar_maybe _ = Nothing
@@ -953,13 +953,6 @@ it's a relatively expensive test and perhaps better done in
optCoercion. Not a big deal either way.
-}
--- | Extract a covar, if possible. This check is dirty. Be ashamed
--- of yourself. (It's dirty because it cares about the structure of
--- a coercion, which is morally reprehensible.)
-isCoVar_maybe :: Coercion -> Maybe CoVar
-isCoVar_maybe (CoVarCo cv) = Just cv
-isCoVar_maybe _ = Nothing
-
mkAxInstCo :: Role -> CoAxiom br -> BranchIndex -> [Type] -> [Coercion]
-> Coercion
-- mkAxInstCo can legitimately be called over-staturated;
@@ -2558,11 +2551,6 @@ mkCoercionType Phantom = \ty1 ty2 ->
in
TyConApp eqPhantPrimTyCon [ki1, ki2, ty1, ty2]
-mkHeteroCoercionType :: Role -> Kind -> Kind -> Type -> Type -> Type
-mkHeteroCoercionType Nominal = mkHeteroPrimEqPred
-mkHeteroCoercionType Representational = mkHeteroReprPrimEqPred
-mkHeteroCoercionType Phantom = panic "mkHeteroCoercionType"
-
-- | Creates a primitive type equality predicate.
-- Invariant: the types are not Coercions
mkPrimEqPred :: Type -> Type -> Type
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index c2fc84687e..14d5c88262 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -34,7 +34,7 @@ import GHC.Prelude
import GHC.Platform
-import GHC.Types.Id.Make ( voidPrimId )
+import GHC.Types.Id.Make ( unboxedUnitExpr )
import GHC.Types.Id
import GHC.Types.Literal
import GHC.Types.Name.Occurrence ( occNameFS )
@@ -2107,7 +2107,7 @@ builtinBignumRules =
let ret n v = pure $ mkCoreUbxSum 2 n [unboxedUnitTy,naturalTy] v
platform <- getPlatform
if x < y
- then ret 1 $ Var voidPrimId
+ then ret 1 unboxedUnitExpr
else ret 2 $ mkNaturalExpr platform (x - y)
-- unary operations
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 5e769acaa9..86b868566c 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -129,7 +129,6 @@ module GHC.Core.Type (
isUnliftedType, isBoxedType, isUnboxedTupleType, isUnboxedSumType,
kindBoxedRepLevity_maybe,
mightBeLiftedType, mightBeUnliftedType,
- isStateType,
isAlgType, isDataFamilyAppType,
isPrimitiveType, isStrictType,
isLevityTy, isLevityVar,
@@ -2482,13 +2481,6 @@ isUnliftedType ty =
Nothing ->
pprPanic "isUnliftedType" (ppr ty <+> dcolon <+> ppr (typeKind ty))
--- | State token type.
-isStateType :: Type -> Bool
-isStateType ty
- = case tyConAppTyCon_maybe ty of
- Just tycon -> tycon == statePrimTyCon
- _ -> False
-
-- | Returns:
--
-- * 'False' if the type is /guaranteed/ unlifted or
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index c8dd400c23..9d03c434f6 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -5023,7 +5023,6 @@ initSDocContext dflags style = SDC
, sdocSuppressStgExts = gopt Opt_SuppressStgExts dflags
, sdocErrorSpans = gopt Opt_ErrorSpans dflags
, sdocStarIsType = xopt LangExt.StarIsType dflags
- , sdocImpredicativeTypes = xopt LangExt.ImpredicativeTypes dflags
, sdocLinearTypes = xopt LangExt.LinearTypes dflags
, sdocListTuplePuns = True
, sdocPrintTypeAbbreviations = True
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 1acc52fad0..702ded54a3 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -795,7 +795,7 @@ dsHsConLike (PatSynCon ps)
= do { builder_id <- dsLookupGlobalId builder_name
; return (if add_void
then mkCoreApp (text "dsConLike" <+> ppr ps)
- (Var builder_id) (Var voidPrimId)
+ (Var builder_id) unboxedUnitExpr
else Var builder_id) }
| otherwise
= pprPanic "dsConLike" (ppr ps)
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index e6ecf795dd..7eb60afd78 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -917,7 +917,7 @@ mkFailurePair expr
; fail_fun_arg <- newSysLocalDs Many unboxedUnitTy
; let real_arg = setOneShotLambda fail_fun_arg
; return (NonRec fail_fun_var (Lam real_arg expr),
- App (Var fail_fun_var) (Var voidPrimId)) }
+ App (Var fail_fun_var) unboxedUnitExpr) }
where
ty = exprType expr
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 814e5640a2..8076d575ac 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -56,7 +56,6 @@ import GHC.Tc.Types.Evidence
import GHC.Tc.Types.Origin
import GHC.Tc.TyCl.Build
import GHC.Types.Var.Set
-import GHC.Types.Id.Make
import GHC.Tc.TyCl.Utils
import GHC.Core.ConLike
import GHC.Types.FieldLabel
@@ -796,8 +795,8 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn
res_ty = mkTyVarTy res_tv
is_unlifted = null args && null prov_dicts
(cont_args, cont_arg_tys)
- | is_unlifted = ([nlHsVar voidPrimId], [unboxedUnitTy])
- | otherwise = (args, arg_tys)
+ | is_unlifted = ([nlHsDataCon unboxedUnitDataCon], [unboxedUnitTy])
+ | otherwise = (args, arg_tys)
cont_ty = mkInfSigmaTy ex_tvs prov_theta $
mkVisFunTysMany cont_arg_tys res_ty
@@ -818,7 +817,7 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn
inst_wrap = mkWpEvApps prov_dicts <.> mkWpTyApps ex_tys
cont' = foldl' nlHsApp (mkLHsWrap inst_wrap (nlHsVar cont)) cont_args
- fail' = nlHsApps fail [nlHsVar voidPrimId]
+ fail' = nlHsApps fail [nlHsDataCon unboxedUnitDataCon]
args = map nlVarPat [scrutinee, cont, fail]
lwpat = noLocA $ WildPat pat_ty
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index 2806ad1bd0..be10faaca3 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -25,6 +25,7 @@ module GHC.Types.Id.Make (
DataConBoxer(..), vanillaDataConBoxer,
mkDataConRep, mkDataConWorkId,
DataConBangOpts (..), BangOpts (..),
+ unboxedUnitExpr,
-- And some particular Ids; see below for why they are wired in
wiredInIds, ghcPrimIds,
@@ -1812,9 +1813,10 @@ voidPrimId :: Id -- Global constant :: Void#
-- We cannot define it in normal Haskell, since it's
-- a top-level unlifted value.
voidPrimId = pcMiscPrelId voidPrimIdName unboxedUnitTy
- (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs)
- where rhs = Var (dataConWorkId unboxedUnitDataCon)
+ (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts unboxedUnitExpr)
+unboxedUnitExpr :: CoreExpr
+unboxedUnitExpr = Var (dataConWorkId unboxedUnitDataCon)
voidArgId :: Id -- Local lambda-bound :: Void#
voidArgId = mkSysLocal (fsLit "void") voidArgIdKey Many unboxedUnitTy
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index e1c9ceb054..bd8204f856 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -390,7 +390,6 @@ data SDocContext = SDC
, sdocErrorSpans :: !Bool
, sdocStarIsType :: !Bool
, sdocLinearTypes :: !Bool
- , sdocImpredicativeTypes :: !Bool
, sdocListTuplePuns :: !Bool
, sdocPrintTypeAbbreviations :: !Bool
, sdocUnitIdForUser :: !(FastString -> SDoc)
@@ -450,7 +449,6 @@ defaultSDocContext = SDC
, sdocSuppressStgExts = False
, sdocErrorSpans = False
, sdocStarIsType = False
- , sdocImpredicativeTypes = False
, sdocLinearTypes = False
, sdocListTuplePuns = True
, sdocPrintTypeAbbreviations = True
View Lorry Controller Status