summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Builtin/Names.hs6
-rw-r--r--compiler/GHC/Builtin/Types/Prim.hs115
-rw-r--r--compiler/GHC/Builtin/primops.txt.pp323
-rw-r--r--compiler/GHC/Core/Opt/Simplify/Utils.hs15
-rw-r--r--compiler/GHC/Core/Type.hs103
-rw-r--r--compiler/GHC/Core/Type.hs-boot2
-rw-r--r--compiler/GHC/Core/Utils.hs4
-rw-r--r--compiler/GHC/Runtime/Heap/Inspect.hs23
-rw-r--r--compiler/GHC/StgToCmm/Foreign.hs8
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs40
-rw-r--r--compiler/GHC/Tc/Utils/Zonk.hs3
11 files changed, 301 insertions, 341 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 89dbfa5f30..c0ebb2929b 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -1770,7 +1770,7 @@ hasFieldClassNameKey = mkPreludeClassUnique 50
************************************************************************
-}
-addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey,
+addrPrimTyConKey, arrayPrimTyConKey, boolTyConKey,
byteArrayPrimTyConKey, charPrimTyConKey, charTyConKey, doublePrimTyConKey,
doubleTyConKey, floatPrimTyConKey, floatTyConKey, funTyConKey,
intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey,
@@ -1778,7 +1778,7 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey,
int64PrimTyConKey, int64TyConKey,
integerTyConKey, naturalTyConKey,
listTyConKey, foreignObjPrimTyConKey, maybeTyConKey,
- weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey,
+ weakPrimTyConKey, mutableArrayPrimTyConKey,
mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey,
ratioTyConKey, rationalTyConKey, realWorldTyConKey, stablePtrPrimTyConKey,
stablePtrTyConKey, eqTyConKey, heqTyConKey, ioPortPrimTyConKey,
@@ -1825,8 +1825,6 @@ stablePtrPrimTyConKey = mkPreludeTyConUnique 38
stablePtrTyConKey = mkPreludeTyConUnique 39
eqTyConKey = mkPreludeTyConUnique 40
heqTyConKey = mkPreludeTyConUnique 41
-arrayArrayPrimTyConKey = mkPreludeTyConUnique 42
-mutableArrayArrayPrimTyConKey = mkPreludeTyConUnique 43
statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
mutVarPrimTyConKey, ioTyConKey,
diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs
index 5eb260ce59..6570867898 100644
--- a/compiler/GHC/Builtin/Types/Prim.hs
+++ b/compiler/GHC/Builtin/Types/Prim.hs
@@ -66,11 +66,9 @@ module GHC.Builtin.Types.Prim(
arrayPrimTyCon, mkArrayPrimTy,
byteArrayPrimTyCon, byteArrayPrimTy,
- arrayArrayPrimTyCon, mkArrayArrayPrimTy,
smallArrayPrimTyCon, mkSmallArrayPrimTy,
mutableArrayPrimTyCon, mkMutableArrayPrimTy,
mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
- mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,
smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy,
mutVarPrimTyCon, mkMutVarPrimTy,
@@ -138,11 +136,12 @@ import GHC.Types.Unique
import GHC.Builtin.Uniques
import GHC.Builtin.Names
import GHC.Data.FastString
+import GHC.Utils.Misc ( changeLast )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid
-- import loops which show up if you import Type instead
-import {-# SOURCE #-} GHC.Core.Type ( mkTyConTy, mkTyConApp, mkTYPEapp )
+import {-# SOURCE #-} GHC.Core.Type ( mkTyConTy, mkTyConApp, mkTYPEapp, getLevity )
import Data.Char
@@ -175,7 +174,6 @@ exposedPrimTyCons
= [ addrPrimTyCon
, arrayPrimTyCon
, byteArrayPrimTyCon
- , arrayArrayPrimTyCon
, smallArrayPrimTyCon
, charPrimTyCon
, doublePrimTyCon
@@ -189,7 +187,6 @@ exposedPrimTyCons
, weakPrimTyCon
, mutableArrayPrimTyCon
, mutableByteArrayPrimTyCon
- , mutableArrayArrayPrimTyCon
, smallMutableArrayPrimTyCon
, mVarPrimTyCon
, ioPortPrimTyCon
@@ -234,8 +231,8 @@ charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int3
wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName,
addrPrimTyConName, floatPrimTyConName, doublePrimTyConName,
statePrimTyConName, proxyPrimTyConName, realWorldTyConName,
- arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName,
- mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName,
+ arrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName,
+ mutableArrayPrimTyConName, mutableByteArrayPrimTyConName,
smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName,
ioPortPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName,
stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName,
@@ -265,11 +262,9 @@ eqPhantPrimTyConName = mkBuiltInPrimTc (fsLit "~P#") eqPhantPrimTyConKe
realWorldTyConName = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
arrayPrimTyConName = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
byteArrayPrimTyConName = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
-arrayArrayPrimTyConName = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
smallArrayPrimTyConName = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon
mutableArrayPrimTyConName = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
-mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon
smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon
mutVarPrimTyConName = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
ioPortPrimTyConName = mkPrimTc (fsLit "IOPort#") ioPortPrimTyConKey ioPortPrimTyCon
@@ -644,13 +639,49 @@ functionWithMultiplicity mul = TyConApp funTyCon [mul]
************************************************************************
-}
--- only used herein
-pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon
-pcPrimTyCon name roles rep
+-- | Create a primitive 'TyCon' with the given 'Name',
+-- arguments of kind 'Type` with the given 'Role's,
+-- and the given result kind representation.
+--
+-- Only use this in "GHC.Builtin.Types.Prim".
+pcPrimTyCon :: Name
+ -> [Role] -> PrimRep -> TyCon
+pcPrimTyCon name roles res_rep
= mkPrimTyCon name binders result_kind roles
where
- binders = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles)
- result_kind = mkTYPEapp (primRepToRuntimeRep rep)
+ bndr_kis = liftedTypeKind <$ roles
+ binders = mkTemplateAnonTyConBinders bndr_kis
+ result_kind = mkTYPEapp (primRepToRuntimeRep res_rep)
+
+-- | Create a primitive nullary 'TyCon' with the given 'Name'
+-- and result kind representation.
+--
+-- Only use this in "GHC.Builtin.Types.Prim".
+pcPrimTyCon0 :: Name -> PrimRep -> TyCon
+pcPrimTyCon0 name res_rep
+ = pcPrimTyCon name [] res_rep
+
+-- | Create a primitive 'TyCon' like 'pcPrimTyCon', except the last
+-- argument is levity-polymorphic.
+--
+-- Only use this in "GHC.Builtin.Types.Prim".
+pcPrimTyCon_LevPolyLastArg :: Name
+ -> [Role] -- ^ roles of the arguments (must be non-empty),
+ -- not including the implicit argument of kind 'Levity',
+ -- which always has 'Nominal' role
+ -> PrimRep
+ -> TyCon
+pcPrimTyCon_LevPolyLastArg name roles res_rep
+ = mkPrimTyCon name binders result_kind (Nominal : roles)
+ where
+ result_kind = mkTYPEapp (primRepToRuntimeRep res_rep)
+ lev_bndr = mkNamedTyConBinder Inferred levity1TyVar
+ binders = lev_bndr : mkTemplateAnonTyConBinders anon_bndr_kis
+ lev_tv = mkTyVarTy (binderVar lev_bndr)
+
+ -- [ Type, ..., Type, TYPE (BoxedRep l) ]
+ anon_bndr_kis = changeLast (liftedTypeKind <$ roles)
+ (mkTYPEapp $ mkTyConApp boxedRepDataConTyCon [lev_tv])
-- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep
-- Defined here to avoid (more) module loops
@@ -706,10 +737,6 @@ primRepsToRuntimeRep :: [PrimRep] -> Type
primRepsToRuntimeRep [rep] = primRepToRuntimeRep rep
primRepsToRuntimeRep reps = mkTupleRep $ map primRepToRuntimeRep reps
-pcPrimTyCon0 :: Name -> PrimRep -> TyCon
-pcPrimTyCon0 name rep
- = pcPrimTyCon name [] rep
-
charPrimTy :: Type
charPrimTy = mkTyConTy charPrimTyCon
charPrimTyCon :: TyCon
@@ -1067,33 +1094,27 @@ concretePrimTyCon =
********************************************************************* -}
arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,
- byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon,
+ byteArrayPrimTyCon,
smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon
-arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName [Representational] UnliftedRep
-mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName [Nominal, Representational] UnliftedRep
+arrayPrimTyCon = pcPrimTyCon_LevPolyLastArg arrayPrimTyConName [Representational] UnliftedRep
+mutableArrayPrimTyCon = pcPrimTyCon_LevPolyLastArg mutableArrayPrimTyConName [Nominal, Representational] UnliftedRep
mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName [Nominal] UnliftedRep
byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName UnliftedRep
-arrayArrayPrimTyCon = pcPrimTyCon0 arrayArrayPrimTyConName UnliftedRep
-mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] UnliftedRep
-smallArrayPrimTyCon = pcPrimTyCon smallArrayPrimTyConName [Representational] UnliftedRep
-smallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] UnliftedRep
+smallArrayPrimTyCon = pcPrimTyCon_LevPolyLastArg smallArrayPrimTyConName [Representational] UnliftedRep
+smallMutableArrayPrimTyCon = pcPrimTyCon_LevPolyLastArg smallMutableArrayPrimTyConName [Nominal, Representational] UnliftedRep
mkArrayPrimTy :: Type -> Type
-mkArrayPrimTy elt = TyConApp arrayPrimTyCon [elt]
+mkArrayPrimTy elt = TyConApp arrayPrimTyCon [getLevity elt, elt]
byteArrayPrimTy :: Type
byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon
-mkArrayArrayPrimTy :: Type
-mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon
mkSmallArrayPrimTy :: Type -> Type
-mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt]
+mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [getLevity elt, elt]
mkMutableArrayPrimTy :: Type -> Type -> Type
-mkMutableArrayPrimTy s elt = TyConApp mutableArrayPrimTyCon [s, elt]
+mkMutableArrayPrimTy s elt = TyConApp mutableArrayPrimTyCon [getLevity elt, s, elt]
mkMutableByteArrayPrimTy :: Type -> Type
mkMutableByteArrayPrimTy s = TyConApp mutableByteArrayPrimTyCon [s]
-mkMutableArrayArrayPrimTy :: Type -> Type
-mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s]
mkSmallMutableArrayPrimTy :: Type -> Type -> Type
-mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]
+mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [getLevity elt, s, elt]
{- *********************************************************************
@@ -1103,10 +1124,10 @@ mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]
********************************************************************* -}
mutVarPrimTyCon :: TyCon
-mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName [Nominal, Representational] UnliftedRep
+mutVarPrimTyCon = pcPrimTyCon_LevPolyLastArg mutVarPrimTyConName [Nominal, Representational] UnliftedRep
mkMutVarPrimTy :: Type -> Type -> Type
-mkMutVarPrimTy s elt = TyConApp mutVarPrimTyCon [s, elt]
+mkMutVarPrimTy s elt = TyConApp mutVarPrimTyCon [getLevity elt, s, elt]
{-
************************************************************************
@@ -1117,10 +1138,10 @@ mkMutVarPrimTy s elt = TyConApp mutVarPrimTyCon [s, elt]
-}
ioPortPrimTyCon :: TyCon
-ioPortPrimTyCon = pcPrimTyCon ioPortPrimTyConName [Nominal, Representational] UnliftedRep
+ioPortPrimTyCon = pcPrimTyCon_LevPolyLastArg ioPortPrimTyConName [Nominal, Representational] UnliftedRep
mkIOPortPrimTy :: Type -> Type -> Type
-mkIOPortPrimTy s elt = TyConApp ioPortPrimTyCon [s, elt]
+mkIOPortPrimTy s elt = TyConApp ioPortPrimTyCon [getLevity elt, s, elt]
{-
************************************************************************
@@ -1132,10 +1153,10 @@ mkIOPortPrimTy s elt = TyConApp ioPortPrimTyCon [s, elt]
-}
mVarPrimTyCon :: TyCon
-mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName [Nominal, Representational] UnliftedRep
+mVarPrimTyCon = pcPrimTyCon_LevPolyLastArg mVarPrimTyConName [Nominal, Representational] UnliftedRep
mkMVarPrimTy :: Type -> Type -> Type
-mkMVarPrimTy s elt = TyConApp mVarPrimTyCon [s, elt]
+mkMVarPrimTy s elt = TyConApp mVarPrimTyCon [getLevity elt, s, elt]
{-
************************************************************************
@@ -1146,10 +1167,10 @@ mkMVarPrimTy s elt = TyConApp mVarPrimTyCon [s, elt]
-}
tVarPrimTyCon :: TyCon
-tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName [Nominal, Representational] UnliftedRep
+tVarPrimTyCon = pcPrimTyCon_LevPolyLastArg tVarPrimTyConName [Nominal, Representational] UnliftedRep
mkTVarPrimTy :: Type -> Type -> Type
-mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt]
+mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [getLevity elt, s, elt]
{-
************************************************************************
@@ -1160,10 +1181,10 @@ mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt]
-}
stablePtrPrimTyCon :: TyCon
-stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName [Representational] AddrRep
+stablePtrPrimTyCon = pcPrimTyCon_LevPolyLastArg stablePtrPrimTyConName [Representational] AddrRep
mkStablePtrPrimTy :: Type -> Type
-mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty]
+mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [getLevity ty, ty]
{-
************************************************************************
@@ -1174,10 +1195,10 @@ mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty]
-}
stableNamePrimTyCon :: TyCon
-stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName [Phantom] UnliftedRep
+stableNamePrimTyCon = pcPrimTyCon_LevPolyLastArg stableNamePrimTyConName [Phantom] UnliftedRep
mkStableNamePrimTy :: Type -> Type
-mkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [ty]
+mkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [getLevity ty, ty]
{-
************************************************************************
@@ -1233,10 +1254,10 @@ bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName LiftedRep
-}
weakPrimTyCon :: TyCon
-weakPrimTyCon = pcPrimTyCon weakPrimTyConName [Representational] UnliftedRep
+weakPrimTyCon = pcPrimTyCon_LevPolyLastArg weakPrimTyConName [Representational] UnliftedRep
mkWeakPrimTy :: Type -> Type
-mkWeakPrimTy v = TyConApp weakPrimTyCon [v]
+mkWeakPrimTy v = TyConApp weakPrimTyCon [getLevity v, v]
{-
************************************************************************
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index b2a45ad79f..092be8e26a 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -1340,7 +1340,7 @@ primtype Array# a
primtype MutableArray# s a
primop NewArrayOp "newArray#" GenPrimOp
- Int# -> a -> State# s -> (# State# s, MutableArray# s a #)
+ Int# -> v -> State# s -> (# State# s, MutableArray# s v #)
{Create a new mutable array with the specified number of elements,
in the specified state thread,
with each element containing the specified initial value.}
@@ -1349,14 +1349,14 @@ primop NewArrayOp "newArray#" GenPrimOp
has_side_effects = True
primop ReadArrayOp "readArray#" GenPrimOp
- MutableArray# s a -> Int# -> State# s -> (# State# s, a #)
+ MutableArray# s v -> Int# -> State# s -> (# State# s, v #)
{Read from specified index of mutable array. Result is not yet evaluated.}
with
has_side_effects = True
can_fail = True
primop WriteArrayOp "writeArray#" GenPrimOp
- MutableArray# s a -> Int# -> a -> State# s -> State# s
+ MutableArray# s v -> Int# -> v -> State# s -> State# s
{Write to specified index of mutable array.}
with
has_side_effects = True
@@ -1364,15 +1364,15 @@ primop WriteArrayOp "writeArray#" GenPrimOp
code_size = 2 -- card update too
primop SizeofArrayOp "sizeofArray#" GenPrimOp
- Array# a -> Int#
+ Array# v -> Int#
{Return the number of elements in the array.}
primop SizeofMutableArrayOp "sizeofMutableArray#" GenPrimOp
- MutableArray# s a -> Int#
+ MutableArray# s v -> Int#
{Return the number of elements in the array.}
primop IndexArrayOp "indexArray#" GenPrimOp
- Array# a -> Int# -> (# a #)
+ Array# v -> Int# -> (# v #)
{Read from the specified index of an immutable array. The result is packaged
into an unboxed unary tuple; the result itself is not yet
evaluated. Pattern matching on the tuple forces the indexing of the
@@ -1384,20 +1384,20 @@ primop IndexArrayOp "indexArray#" GenPrimOp
can_fail = True
primop UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp
- MutableArray# s a -> State# s -> (# State# s, Array# a #)
+ MutableArray# s v -> State# s -> (# State# s, Array# v #)
{Make a mutable array immutable, without copying.}
with
has_side_effects = True
primop UnsafeThawArrayOp "unsafeThawArray#" GenPrimOp
- Array# a -> State# s -> (# State# s, MutableArray# s a #)
+ Array# v -> State# s -> (# State# s, MutableArray# s v #)
{Make an immutable array mutable, without copying.}
with
out_of_line = True
has_side_effects = True
primop CopyArrayOp "copyArray#" GenPrimOp
- Array# a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s
+ Array# v -> Int# -> MutableArray# s v -> Int# -> Int# -> State# s -> State# s
{Given a source array, an offset into the source array, a
destination array, an offset into the destination array, and a
number of elements to copy, copy the elements from the source array
@@ -1411,7 +1411,7 @@ primop CopyArrayOp "copyArray#" GenPrimOp
can_fail = True
primop CopyMutableArrayOp "copyMutableArray#" GenPrimOp
- MutableArray# s a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s
+ MutableArray# s v -> Int# -> MutableArray# s v -> Int# -> Int# -> State# s -> State# s
{Given a source array, an offset into the source array, a
destination array, an offset into the destination array, and a
number of elements to copy, copy the elements from the source array
@@ -1425,7 +1425,7 @@ primop CopyMutableArrayOp "copyMutableArray#" GenPrimOp
can_fail = True
primop CloneArrayOp "cloneArray#" GenPrimOp
- Array# a -> Int# -> Int# -> Array# a
+ Array# v -> Int# -> Int# -> Array# v
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
@@ -1436,7 +1436,7 @@ primop CloneArrayOp "cloneArray#" GenPrimOp
can_fail = True
primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
- MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
+ MutableArray# s v -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s v #)
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
@@ -1447,7 +1447,7 @@ primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
can_fail = True
primop FreezeArrayOp "freezeArray#" GenPrimOp
- MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #)
+ MutableArray# s v -> Int# -> Int# -> State# s -> (# State# s, Array# v #)
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
@@ -1458,7 +1458,7 @@ primop FreezeArrayOp "freezeArray#" GenPrimOp
can_fail = True
primop ThawArrayOp "thawArray#" GenPrimOp
- Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
+ Array# v -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s v #)
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
@@ -1469,7 +1469,7 @@ primop ThawArrayOp "thawArray#" GenPrimOp
can_fail = True
primop CasArrayOp "casArray#" GenPrimOp
- MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
+ MutableArray# s v -> Int# -> v -> v -> State# s -> (# State# s, Int#, v #)
{Given an array, an offset, the expected old value, and
the new value, perform an atomic compare and swap (i.e. write the new
value if the current value and the old value are the same pointer).
@@ -1477,7 +1477,7 @@ primop CasArrayOp "casArray#" GenPrimOp
the element at the offset after the operation completes. This means that
on a success the new value is returned, and on a failure the actual old
value (not the expected one) is returned. Implies a full memory barrier.
- The use of a pointer equality on a lifted value makes this function harder
+ The use of a pointer equality on a boxed value makes this function harder
to use correctly than {\tt casIntArray\#}. All of the difficulties
of using {\tt reallyUnsafePtrEquality\#} correctly apply to
{\tt casArray\#} as well.
@@ -1516,7 +1516,7 @@ primtype SmallArray# a
primtype SmallMutableArray# s a
primop NewSmallArrayOp "newSmallArray#" GenPrimOp
- Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
+ Int# -> v -> State# s -> (# State# s, SmallMutableArray# s v #)
{Create a new mutable array with the specified number of elements,
in the specified state thread,
with each element containing the specified initial value.}
@@ -1525,7 +1525,7 @@ primop NewSmallArrayOp "newSmallArray#" GenPrimOp
has_side_effects = True
primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp
- SmallMutableArray# s a -> Int# -> State# s -> State# s
+ SmallMutableArray# s v -> Int# -> State# s -> State# s
{Shrink mutable array to new specified size, in
the specified state thread. The new size argument must be less than or
equal to the current size as reported by {\tt getSizeofSmallMutableArray\#}.}
@@ -1533,49 +1533,49 @@ primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp
has_side_effects = True
primop ReadSmallArrayOp "readSmallArray#" GenPrimOp
- SmallMutableArray# s a -> Int# -> State# s -> (# State# s, a #)
+ SmallMutableArray# s v -> Int# -> State# s -> (# State# s, v #)
{Read from specified index of mutable array. Result is not yet evaluated.}
with
has_side_effects = True
can_fail = True
primop WriteSmallArrayOp "writeSmallArray#" GenPrimOp
- SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
+ SmallMutableArray# s v -> Int# -> v -> State# s -> State# s
{Write to specified index of mutable array.}
with
has_side_effects = True
can_fail = True
primop SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp
- SmallArray# a -> Int#
+ SmallArray# v -> Int#
{Return the number of elements in the array.}
primop SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp
- SmallMutableArray# s a -> Int#
+ SmallMutableArray# s v -> Int#
{Return the number of elements in the array. Note that this is deprecated
as it is unsafe in the presence of shrink and resize operations on the
same small mutable array.}
with deprecated_msg = { Use 'getSizeofSmallMutableArray#' instead }
primop GetSizeofSmallMutableArrayOp "getSizeofSmallMutableArray#" GenPrimOp
- SmallMutableArray# s a -> State# s -> (# State# s, Int# #)
+ SmallMutableArray# s v -> State# s -> (# State# s, Int# #)
{Return the number of elements in the array.}
primop IndexSmallArrayOp "indexSmallArray#" GenPrimOp
- SmallArray# a -> Int# -> (# a #)
+ SmallArray# v -> Int# -> (# v #)
{Read from specified index of immutable array. Result is packaged into
an unboxed singleton; the result itself is not yet evaluated.}
with
can_fail = True
primop UnsafeFreezeSmallArrayOp "unsafeFreezeSmallArray#" GenPrimOp
- SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #)
+ SmallMutableArray# s v -> State# s -> (# State# s, SmallArray# v #)
{Make a mutable array immutable, without copying.}
with
has_side_effects = True
primop UnsafeThawSmallArrayOp "unsafeThawSmallArray#" GenPrimOp
- SmallArray# a -> State# s -> (# State# s, SmallMutableArray# s a #)
+ SmallArray# v -> State# s -> (# State# s, SmallMutableArray# s v #)
{Make an immutable array mutable, without copying.}
with
out_of_line = True
@@ -1585,7 +1585,7 @@ primop UnsafeThawSmallArrayOp "unsafeThawSmallArray#" GenPrimOp
-- primops aren't inlined. It would be nice to keep track of both.
primop CopySmallArrayOp "copySmallArray#" GenPrimOp
- SmallArray# a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
+ SmallArray# v -> Int# -> SmallMutableArray# s v -> Int# -> Int# -> State# s -> State# s
{Given a source array, an offset into the source array, a
destination array, an offset into the destination array, and a
number of elements to copy, copy the elements from the source array
@@ -1599,7 +1599,7 @@ primop CopySmallArrayOp "copySmallArray#" GenPrimOp
can_fail = True
primop CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp
- SmallMutableArray# s a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
+ SmallMutableArray# s v -> Int# -> SmallMutableArray# s v -> Int# -> Int# -> State# s -> State# s
{Given a source array, an offset into the source array, a
destination array, an offset into the destination array, and a
number of elements to copy, copy the elements from the source array
@@ -1614,7 +1614,7 @@ primop CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp
can_fail = True
primop CloneSmallArrayOp "cloneSmallArray#" GenPrimOp
- SmallArray# a -> Int# -> Int# -> SmallArray# a
+ SmallArray# v -> Int# -> Int# -> SmallArray# v
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
@@ -1625,7 +1625,7 @@ primop CloneSmallArrayOp "cloneSmallArray#" GenPrimOp
can_fail = True
primop CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp
- SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
+ SmallMutableArray# s v -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s v #)
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
@@ -1636,7 +1636,7 @@ primop CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp
can_fail = True
primop FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp
- SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallArray# a #)
+ SmallMutableArray# s v -> Int# -> Int# -> State# s -> (# State# s, SmallArray# v #)
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
@@ -1647,7 +1647,7 @@ primop FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp
can_fail = True
primop ThawSmallArrayOp "thawSmallArray#" GenPrimOp
- SmallArray# a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
+ SmallArray# v -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s v #)
{Given a source array, an offset into the source array, and a number
of elements to copy, create a new array with the elements from the
source array. The provided array must fully contain the specified
@@ -1658,7 +1658,7 @@ primop ThawSmallArrayOp "thawSmallArray#" GenPrimOp
can_fail = True
primop CasSmallArrayOp "casSmallArray#" GenPrimOp
- SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
+ SmallMutableArray# s v -> Int# -> v -> v -> State# s -> (# State# s, Int#, v #)
{Unsafe, machine-level atomic compare and swap on an element within an array.
See the documentation of {\tt casArray\#}.}
with
@@ -1970,114 +1970,6 @@ primop FetchXorByteArrayOp_Int "fetchXorIntArray#" GenPrimOp
with has_side_effects = True
can_fail = True
-
-------------------------------------------------------------------------
-section "Arrays of arrays"
- {Operations on {\tt ArrayArray\#}. An {\tt ArrayArray\#} contains references to {\em unpointed}
- arrays, such as {\tt ByteArray\#s}. Hence, it is not parameterised by the element types,
- just like a {\tt ByteArray\#}, but it needs to be scanned during GC, just like an {\tt Array\#}.
- We represent an {\tt ArrayArray\#} exactly as a {\tt Array\#}, but provide element-type-specific
- indexing, reading, and writing.}
-------------------------------------------------------------------------
-
-primtype ArrayArray#
-
-primtype MutableArrayArray# s
-
-primop NewArrayArrayOp "newArrayArray#" GenPrimOp
- Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- {Create a new mutable array of arrays with the specified number of elements,
- in the specified state thread, with each element recursively referring to the
- newly created array.}
- with
- out_of_line = True
- has_side_effects = True
-
-primop UnsafeFreezeArrayArrayOp "unsafeFreezeArrayArray#" GenPrimOp
- MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #)
- {Make a mutable array of arrays immutable, without copying.}
- with
- has_side_effects = True
-
-primop SizeofArrayArrayOp "sizeofArrayArray#" GenPrimOp
- ArrayArray# -> Int#
- {Return the number of elements in the array.}
-
-primop SizeofMutableArrayArrayOp "sizeofMutableArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int#
- {Return the number of elements in the array.}
-
-primop IndexArrayArrayOp_ByteArray "indexByteArrayArray#" GenPrimOp
- ArrayArray# -> Int# -> ByteArray#
- with can_fail = True
-
-primop IndexArrayArrayOp_ArrayArray "indexArrayArrayArray#" GenPrimOp
- ArrayArray# -> Int# -> ArrayArray#
- with can_fail = True
-
-primop ReadArrayArrayOp_ByteArray "readByteArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #)
- with has_side_effects = True
- can_fail = True
-
-primop ReadArrayArrayOp_MutableByteArray "readMutableByteArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
- with has_side_effects = True
- can_fail = True
-
-primop ReadArrayArrayOp_ArrayArray "readArrayArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #)
- with has_side_effects = True
- can_fail = True
-
-primop ReadArrayArrayOp_MutableArrayArray "readMutableArrayArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #)
- with has_side_effects = True
- can_fail = True
-
-primop WriteArrayArrayOp_ByteArray "writeByteArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s
- with has_side_effects = True
- can_fail = True
-
-primop WriteArrayArrayOp_MutableByteArray "writeMutableByteArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s
- with has_side_effects = True
- can_fail = True
-
-primop WriteArrayArrayOp_ArrayArray "writeArrayArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s
- with has_side_effects = True
- can_fail = True
-
-primop WriteArrayArrayOp_MutableArrayArray "writeMutableArrayArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s
- with has_side_effects = True
- can_fail = True
-
-primop CopyArrayArrayOp "copyArrayArray#" GenPrimOp
- ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
- {Copy a range of the ArrayArray\# to the specified region in the MutableArrayArray\#.
- Both arrays must fully contain the specified ranges, but this is not checked.
- The two arrays must not be the same array in different states, but this is not checked either.}
- with
- out_of_line = True
- has_side_effects = True
- can_fail = True
-
-primop CopyMutableArrayArrayOp "copyMutableArrayArray#" GenPrimOp
- MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
- {Copy a range of the first MutableArrayArray# to the specified region in the second
- MutableArrayArray#.
- Both arrays must fully contain the specified ranges, but this is not checked.
- The regions are allowed to overlap, although this is only possible when the same
- array is provided as both the source and the destination.
- }
- with
- out_of_line = True
- has_side_effects = True
- can_fail = True
-
------------------------------------------------------------------------
section "Addr#"
------------------------------------------------------------------------
@@ -2508,7 +2400,7 @@ primtype MutVar# s a
{A {\tt MutVar\#} behaves like a single-element mutable array.}
primop NewMutVarOp "newMutVar#" GenPrimOp
- a -> State# s -> (# State# s, MutVar# s a #)
+ v -> State# s -> (# State# s, MutVar# s v #)
{Create {\tt MutVar\#} with specified initial value in specified state thread.}
with
out_of_line = True
@@ -2529,14 +2421,14 @@ primop NewMutVarOp "newMutVar#" GenPrimOp
-- at least.
primop ReadMutVarOp "readMutVar#" GenPrimOp
- MutVar# s a -> State# s -> (# State# s, a #)
+ MutVar# s v -> State# s -> (# State# s, v #)
{Read contents of {\tt MutVar\#}. Result is not yet evaluated.}
with
-- See Note [Why MutVar# ops can't fail]
has_side_effects = True
primop WriteMutVarOp "writeMutVar#" GenPrimOp
- MutVar# s a -> a -> State# s -> State# s
+ MutVar# s v -> v -> State# s -> State# s
{Write contents of {\tt MutVar\#}.}
with
-- See Note [Why MutVar# ops can't fail]
@@ -2580,7 +2472,22 @@ primop AtomicModifyMutVar_Op "atomicModifyMutVar_#" GenPrimOp
can_fail = True
primop CasMutVarOp "casMutVar#" GenPrimOp
- MutVar# s a -> a -> a -> State# s -> (# State# s, Int#, a #)
+ MutVar# s v -> v -> v -> State# s -> (# State# s, Int#, v #)
+ { Compare-and-swap: perform a pointer equality test between
+ the first value passed to this function and the value
+ stored inside the {\tt MutVar\#}. If the pointers are equal,
+ replace the stored value with the second value passed to this
+ function, otherwise do nothing.
+ Returns the final value stored inside the {\tt MutVar\#}.
+ The {\tt Int\#} indicates whether a swap took place,
+ with {\tt 1\#} meaning that we didn't swap, and {\tt 0\#}
+ that we did.
+ Implies a full memory barrier.
+ Because the comparison is done on the level of pointers,
+ all of the difficulties of using
+ {\tt reallyUnsafePtrEquality\#} correctly apply to
+ {\tt casMutVar\#} as well.
+ }
with
out_of_line = True
has_side_effects = True
@@ -2603,10 +2510,10 @@ section "Exceptions"
-- head-strict in 'ma': GHC.IO.catchException.
primop CatchOp "catch#" GenPrimOp
- (State# RealWorld -> (# State# RealWorld, a #) )
- -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
+ (State# RealWorld -> (# State# RealWorld, o #) )
+ -> (w -> State# RealWorld -> (# State# RealWorld, o #) )
-> State# RealWorld
- -> (# State# RealWorld, a #)
+ -> (# State# RealWorld, o #)
with
strictness = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
, lazyApply2Dmd
@@ -2616,9 +2523,9 @@ primop CatchOp "catch#" GenPrimOp
has_side_effects = True
primop RaiseOp "raise#" GenPrimOp
- a -> p
- -- NB: "p" is the same as "b" except it is representation-polymorphic
- -- (we shouldn't use "o" here as that would conflict with "a")
+ v -> p
+ -- NB: "v" is the same as "a" except levity-polymorphic,
+ -- and "p" is the same as "b" except representation-polymorphic
-- See Note [Levity and representation polymorphic primops]
with
-- In contrast to 'raiseIO#', which throws a *precise* exception,
@@ -2633,7 +2540,7 @@ primop RaiseOp "raise#" GenPrimOp
can_fail = True
primop RaiseIOOp "raiseIO#" GenPrimOp
- a -> State# RealWorld -> (# State# RealWorld, b #)
+ v -> State# RealWorld -> (# State# RealWorld, p #)
with
-- See Note [Precise exceptions and strictness analysis] in "GHC.Types.Demand"
-- for why this is the *only* primop that has 'exnDiv'
@@ -2642,8 +2549,8 @@ primop RaiseIOOp "raiseIO#" GenPrimOp
has_side_effects = True
primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp
- (State# RealWorld -> (# State# RealWorld, a #))
- -> (State# RealWorld -> (# State# RealWorld, a #))
+ (State# RealWorld -> (# State# RealWorld, o #))
+ -> (State# RealWorld -> (# State# RealWorld, o #))
with
strictness = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
@@ -2651,16 +2558,16 @@ primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp
has_side_effects = True
primop MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp
- (State# RealWorld -> (# State# RealWorld, a #))
- -> (State# RealWorld -> (# State# RealWorld, a #))
+ (State# RealWorld -> (# State# RealWorld, o #))
+ -> (State# RealWorld -> (# State# RealWorld, o #))
with
strictness = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
out_of_line = True
has_side_effects = True
primop UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp
- (State# RealWorld -> (# State# RealWorld, a #))
- -> (State# RealWorld -> (# State# RealWorld, a #))
+ (State# RealWorld -> (# State# RealWorld, o #))
+ -> (State# RealWorld -> (# State# RealWorld, o #))
with
strictness = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
@@ -2680,8 +2587,8 @@ section "STM-accessible Mutable Variables"
primtype TVar# s a
primop AtomicallyOp "atomically#" GenPrimOp
- (State# RealWorld -> (# State# RealWorld, a #) )
- -> State# RealWorld -> (# State# RealWorld, a #)
+ (State# RealWorld -> (# State# RealWorld, v #) )
+ -> State# RealWorld -> (# State# RealWorld, v #)
with
strictness = { \ _arity -> mkClosedDmdSig [strictManyApply1Dmd,topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
@@ -2699,16 +2606,16 @@ primop AtomicallyOp "atomically#" GenPrimOp
-- retry# s1
-- where 'e' would be unreachable anyway. See #8091.
primop RetryOp "retry#" GenPrimOp
- State# RealWorld -> (# State# RealWorld, a #)
+ State# RealWorld -> (# State# RealWorld, v #)
with
strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv }
out_of_line = True
has_side_effects = True
primop CatchRetryOp "catchRetry#" GenPrimOp
- (State# RealWorld -> (# State# RealWorld, a #) )
- -> (State# RealWorld -> (# State# RealWorld, a #) )
- -> (State# RealWorld -> (# State# RealWorld, a #) )
+ (State# RealWorld -> (# State# RealWorld, v #) )
+ -> (State# RealWorld -> (# State# RealWorld, v #) )
+ -> (State# RealWorld -> (# State# RealWorld, v #) )
with
strictness = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
, lazyApply1Dmd
@@ -2718,9 +2625,9 @@ primop CatchRetryOp "catchRetry#" GenPrimOp
has_side_effects = True
primop CatchSTMOp "catchSTM#" GenPrimOp
- (State# RealWorld -> (# State# RealWorld, a #) )
- -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
- -> (State# RealWorld -> (# State# RealWorld, a #) )
+ (State# RealWorld -> (# State# RealWorld, v #) )
+ -> (b -> State# RealWorld -> (# State# RealWorld, v #) )
+ -> (State# RealWorld -> (# State# RealWorld, v #) )
with
strictness = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
, lazyApply2Dmd
@@ -2730,32 +2637,35 @@ primop CatchSTMOp "catchSTM#" GenPrimOp
has_side_effects = True
primop NewTVarOp "newTVar#" GenPrimOp
- a
- -> State# s -> (# State# s, TVar# s a #)
+ v
+ -> State# s -> (# State# s, TVar# s v #)
{Create a new {\tt TVar\#} holding a specified initial value.}
with
out_of_line = True
has_side_effects = True
primop ReadTVarOp "readTVar#" GenPrimOp
- TVar# s a
- -> State# s -> (# State# s, a #)
- {Read contents of {\tt TVar\#}. Result is not yet evaluated.}
+ TVar# s v
+ -> State# s -> (# State# s, v #)
+ {Read contents of {\tt TVar\#} inside an STM transaction,
+ i.e. within a call to {\tt atomically\#}.
+ Does not force evaluation of the result.}
with
out_of_line = True
has_side_effects = True
primop ReadTVarIOOp "readTVarIO#" GenPrimOp
- TVar# s a
- -> State# s -> (# State# s, a #)
- {Read contents of {\tt TVar\#} outside an STM transaction}
+ TVar# s v
+ -> State# s -> (# State# s, v #)
+ {Read contents of {\tt TVar\#} outside an STM transaction.
+ Does not force evaluation of the result.}
with
out_of_line = True
has_side_effects = True
primop WriteTVarOp "writeTVar#" GenPrimOp
- TVar# s a
- -> a
+ TVar# s v
+ -> v
-> State# s -> State# s
{Write contents of {\tt TVar\#}.}
with
@@ -2774,14 +2684,14 @@ primtype MVar# s a
represented by {\tt (MutVar\# (Maybe a))}.) }
primop NewMVarOp "newMVar#" GenPrimOp
- State# s -> (# State# s, MVar# s a #)
+ State# s -> (# State# s, MVar# s v #)
{Create new {\tt MVar\#}; initially empty.}
with
out_of_line = True
has_side_effects = True
primop TakeMVarOp "takeMVar#" GenPrimOp
- MVar# s a -> State# s -> (# State# s, a #)
+ MVar# s v -> State# s -> (# State# s, v #)
{If {\tt MVar\#} is empty, block until it becomes full.
Then remove and return its contents, and set it empty.}
with
@@ -2789,7 +2699,7 @@ primop TakeMVarOp "takeMVar#" GenPrimOp
has_side_effects = True
primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp
- MVar# s a -> State# s -> (# State# s, Int#, a #)
+ MVar# s v -> State# s -> (# State# s, Int#, v #)
{If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined.
Otherwise, return with integer 1 and contents of {\tt MVar\#}, and set {\tt MVar\#} empty.}
with
@@ -2797,7 +2707,7 @@ primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp
has_side_effects = True
primop PutMVarOp "putMVar#" GenPrimOp
- MVar# s a -> a -> State# s -> State# s
+ MVar# s v -> v -> State# s -> State# s
{If {\tt MVar\#} is full, block until it becomes empty.
Then store value arg as its new contents.}
with
@@ -2805,7 +2715,7 @@ primop PutMVarOp "putMVar#" GenPrimOp
has_side_effects = True
primop TryPutMVarOp "tryPutMVar#" GenPrimOp
- MVar# s a -> a -> State# s -> (# State# s, Int# #)
+ MVar# s v -> v -> State# s -> (# State# s, Int# #)
{If {\tt MVar\#} is full, immediately return with integer 0.
Otherwise, store value arg as {\tt MVar\#}'s new contents, and return with integer 1.}
with
@@ -2813,7 +2723,7 @@ primop TryPutMVarOp "tryPutMVar#" GenPrimOp
has_side_effects = True
primop ReadMVarOp "readMVar#" GenPrimOp
- MVar# s a -> State# s -> (# State# s, a #)
+ MVar# s v -> State# s -> (# State# s, v #)
{If {\tt MVar\#} is empty, block until it becomes full.
Then read its contents without modifying the MVar, without possibility
of intervention from other threads.}
@@ -2822,7 +2732,7 @@ primop ReadMVarOp "readMVar#" GenPrimOp
has_side_effects = True
primop TryReadMVarOp "tryReadMVar#" GenPrimOp
- MVar# s a -> State# s -> (# State# s, Int#, a #)
+ MVar# s v -> State# s -> (# State# s, Int#, v #)
{If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined.
Otherwise, return with integer 1 and contents of {\tt MVar\#}.}
with
@@ -2830,7 +2740,7 @@ primop TryReadMVarOp "tryReadMVar#" GenPrimOp
has_side_effects = True
primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp
- MVar# s a -> State# s -> (# State# s, Int# #)
+ MVar# s v -> State# s -> (# State# s, Int# #)
{Return 1 if {\tt MVar\#} is empty; 0 otherwise.}
with
out_of_line = True
@@ -2847,24 +2757,27 @@ primtype IOPort# s a
The main difference is that IOPort has no deadlock detection or
deadlock breaking code that forcibly releases the lock. }
-primop NewIOPortrOp "newIOPort#" GenPrimOp
- State# s -> (# State# s, IOPort# s a #)
+primop NewIOPortOp "newIOPort#" GenPrimOp
+ State# s -> (# State# s, IOPort# s v #)
{Create new {\tt IOPort\#}; initially empty.}
with
out_of_line = True
has_side_effects = True
primop ReadIOPortOp "readIOPort#" GenPrimOp
- IOPort# s a -> State# s -> (# State# s, a #)
+ IOPort# s v -> State# s -> (# State# s, v #)
{If {\tt IOPort\#} is empty, block until it becomes full.
- Then remove and return its contents, and set it empty.}
+ Then remove and return its contents, and set it empty.
+ Throws an {\tt IOPortException} if another thread is already
+ waiting to read this {\tt IOPort\#}.}
with
out_of_line = True
has_side_effects = True
primop WriteIOPortOp "writeIOPort#" GenPrimOp
- IOPort# s a -> a -> State# s -> (# State# s, Int# #)
- {If {\tt IOPort\#} is full, immediately return with integer 0.
+ IOPort# s v -> v -> State# s -> (# State# s, Int# #)
+ {If {\tt IOPort\#} is full, immediately return with integer 0,
+ throwing an {\tt IOPortException}.
Otherwise, store value arg as {\tt IOPort\#}'s new contents,
and return with integer 1. }
with
@@ -2918,7 +2831,7 @@ primtype ThreadId#
other operations can be omitted.)}
primop ForkOp "fork#" GenPrimOp
- (State# RealWorld -> (# State# RealWorld, a #))
+ (State# RealWorld -> (# State# RealWorld, o #))
-> State# RealWorld -> (# State# RealWorld, ThreadId# #)
with
has_side_effects = True
@@ -2927,7 +2840,7 @@ primop ForkOp "fork#" GenPrimOp
, topDmd ] topDiv }
primop ForkOnOp "forkOn#" GenPrimOp
- Int# -> (State# RealWorld -> (# State# RealWorld, a #))
+ Int# -> (State# RealWorld -> (# State# RealWorld, o #))
-> State# RealWorld -> (# State# RealWorld, ThreadId# #)
with
has_side_effects = True
@@ -2983,12 +2896,12 @@ section "Weak pointers"
primtype Weak# b
--- Note: "v" denotes a levity-polymorphic type variable
+-- N.B. "v" and "w" denote levity-polymorphic type variables.
-- See Note [Levity and representation polymorphic primops]
primop MkWeakOp "mkWeak#" GenPrimOp
- v -> b -> (State# RealWorld -> (# State# RealWorld, c #))
- -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+ v -> w -> (State# RealWorld -> (# State# RealWorld, c #))
+ -> State# RealWorld -> (# State# RealWorld, Weak# w #)
{ {\tt mkWeak# k v finalizer s} creates a weak reference to value {\tt k},
with an associated reference to some value {\tt v}. If {\tt k} is still
alive then {\tt v} can be retrieved using {\tt deRefWeak#}. Note that
@@ -2999,13 +2912,13 @@ primop MkWeakOp "mkWeak#" GenPrimOp
out_of_line = True
primop MkWeakNoFinalizerOp "mkWeakNoFinalizer#" GenPrimOp
- v -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+ v -> w -> State# RealWorld -> (# State# RealWorld, Weak# w #)
with
has_side_effects = True
out_of_line = True
primop AddCFinalizerToWeakOp "addCFinalizerToWeak#" GenPrimOp
- Addr# -> Addr# -> Int# -> Addr# -> Weak# b
+ Addr# -> Addr# -> Int# -> Addr# -> Weak# w
-> State# RealWorld -> (# State# RealWorld, Int# #)
{ {\tt addCFinalizerToWeak# fptr ptr flag eptr w} attaches a C
function pointer {\tt fptr} to a weak pointer {\tt w} as a finalizer. If
@@ -3018,13 +2931,13 @@ primop AddCFinalizerToWeakOp "addCFinalizerToWeak#" GenPrimOp
out_of_line = True
primop DeRefWeakOp "deRefWeak#" GenPrimOp
- Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #)
+ Weak# v -> State# RealWorld -> (# State# RealWorld, Int#, v #)
with
has_side_effects = True
out_of_line = True
primop FinalizeWeakOp "finalizeWeak#" GenPrimOp
- Weak# a -> State# RealWorld -> (# State# RealWorld, Int#,
+ Weak# v -> State# RealWorld -> (# State# RealWorld, Int#,
(State# RealWorld -> (# State# RealWorld, b #) ) #)
{ Finalize a weak pointer. The return value is an unboxed tuple
containing the new state of the world and an "unboxed Maybe",
@@ -3050,30 +2963,30 @@ primtype StablePtr# a
primtype StableName# a
primop MakeStablePtrOp "makeStablePtr#" GenPrimOp
- a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
+ v -> State# RealWorld -> (# State# RealWorld, StablePtr# v #)
with
has_side_effects = True
out_of_line = True
primop DeRefStablePtrOp "deRefStablePtr#" GenPrimOp
- StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
+ StablePtr# v -> State# RealWorld -> (# State# RealWorld, v #)
with
has_side_effects = True
out_of_line = True
primop EqStablePtrOp "eqStablePtr#" GenPrimOp
- StablePtr# a -> StablePtr# a -> Int#
+ StablePtr# v -> StablePtr# v -> Int#
with
has_side_effects = True
primop MakeStableNameOp "makeStableName#" GenPrimOp
- a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
+ v -> State# RealWorld -> (# State# RealWorld, StableName# v #)
with
has_side_effects = True
out_of_line = True
primop StableNameToIntOp "stableNameToInt#" GenPrimOp
- StableName# a -> Int#
+ StableName# v -> Int#
------------------------------------------------------------------------
section "Compact normal form"
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index d0b8445665..d058fc5aa2 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -588,9 +588,18 @@ mkArgInfo env fun rules n_val_args call_cont
| Just (_, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty -- Add strict-type info
, dmd : rest_dmds <- dmds
- , let dmd' = case isLiftedType_maybe arg_ty of
- Just False -> strictifyDmd dmd
- _ -> dmd
+ , let dmd'
+ -- TODO: we should just use isLiftedType_maybe, but that
+ -- function is currently wrong (#20837).
+ | Just rr <- getRuntimeRep_maybe arg_ty
+ , Just False <- isLiftedRuntimeRep_maybe rr
+ -- The type is definitely unlifted, such as:
+ -- - TYPE (BoxedRep Unlifted)
+ -- - TYPE IntRep, TYPE FloatRep, ...
+ = strictifyDmd dmd
+ | otherwise
+ -- Could be definitely lifted, or we're not sure (e.g. levity-polymorphic).
+ = dmd
= dmd' : add_type_strictness fun_ty' rest_dmds
-- If the type is representation-polymorphic, we can't know whether
-- it's strict. isLiftedType_maybe will return Just False only when
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 85cc635791..e3ad6e989c 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -122,7 +122,8 @@ module GHC.Core.Type (
-- *** Levity and boxity
isLiftedType_maybe,
isLiftedTypeKind, isUnliftedTypeKind, isBoxedTypeKind, pickyIsLiftedTypeKind,
- isLiftedRuntimeRep, isUnliftedRuntimeRep, isBoxedRuntimeRep,
+ isLiftedRuntimeRep, isUnliftedRuntimeRep, isLiftedRuntimeRep_maybe,
+ isBoxedRuntimeRep,
isLiftedLevity, isUnliftedLevity,
isUnliftedType, isBoxedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
isAlgType, isDataFamilyAppType,
@@ -130,7 +131,7 @@ module GHC.Core.Type (
isLevityTy, isLevityVar,
isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,
dropRuntimeRepArgs,
- getRuntimeRep,
+ getRuntimeRep, getLevity, getLevity_maybe,
-- * Multiplicity
@@ -258,6 +259,7 @@ import {-# SOURCE #-} GHC.Builtin.Types
( charTy, naturalTy, listTyCon
, typeSymbolKind, liftedTypeKind, unliftedTypeKind
, liftedRepTy, unliftedRepTy, zeroBitRepTy
+ , boxedRepDataConTyCon
, constraintKind, zeroBitTypeKind
, unrestrictedFunTyCon
, manyDataConTy, oneDataConTy )
@@ -731,42 +733,65 @@ isBoxedRuntimeRep_maybe rep
| otherwise
= Nothing
-isLiftedRuntimeRep :: Type -> Bool
--- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep
--- False of type variables (a :: RuntimeRep)
--- and of other reps e.g. (IntRep :: RuntimeRep)
-isLiftedRuntimeRep rep
- | Just [lev] <- isTyConKeyApp_maybe boxedRepDataConKey rep
- = isLiftedLevity lev
- | otherwise
- = False
-
-isUnliftedRuntimeRep :: Type -> Bool
--- PRECONDITION: The type has kind RuntimeRep
--- True of definitely-unlifted RuntimeReps
--- False of (LiftedRep :: RuntimeRep)
--- and of variables (a :: RuntimeRep)
-isUnliftedRuntimeRep rep
- | TyConApp rr_tc args <- coreFullView rep -- NB: args might be non-empty
- -- e.g. TupleRep [r1, .., rn]
+-- | Check whether a type of kind 'RuntimeRep' is lifted, unlifted, or unknown.
+--
+-- @isLiftedRuntimeRep rr@ returns:
+--
+-- * @Just True @ if @rr@ is @LiftedRep :: RuntimeRep@
+-- * @Just False@ if @rr@ is definitely not lifted, e.g. @IntRep@
+-- * @Nothing @ if not known (e.g. it's a type variable or a type family application).
+isLiftedRuntimeRep_maybe :: Type -> Maybe Bool
+isLiftedRuntimeRep_maybe rep
+ | TyConApp rr_tc args <- coreFullView rep
, isPromotedDataCon rr_tc =
-- NB: args might be non-empty e.g. TupleRep [r1, .., rn]
if (rr_tc `hasKey` boxedRepDataConKey)
then case args of
- [lev] -> isUnliftedLevity lev
- _ -> False
- else True
+ [lev] | isLiftedLevity lev -> Just True
+ | isUnliftedLevity lev -> Just False
+ _ -> Nothing
+ else Just False
-- Avoid searching all the unlifted RuntimeRep type cons
-- In the RuntimeRep data type, only LiftedRep is lifted
-- But be careful of type families (F tys) :: RuntimeRep,
-- hence the isPromotedDataCon rr_tc
-isUnliftedRuntimeRep _ = False
+isLiftedRuntimeRep_maybe _ = Nothing
+
+-- | Check whether a type of kind 'RuntimeRep' is lifted.
+--
+-- 'isLiftedRuntimeRep' is:
+--
+-- * True of @LiftedRep :: RuntimeRep@
+-- * False of type variables, type family applications,
+-- and of other reps such as @IntRep :: RuntimeRep@.
+isLiftedRuntimeRep :: Type -> Bool
+isLiftedRuntimeRep rep
+ | Just True <- isLiftedRuntimeRep_maybe rep
+ = True
+ | otherwise
+ = False
--- | An INLINE helper for function such as 'isLiftedRuntimeRep' below.
+-- | Check whether a type of kind 'RuntimeRep' is unlifted.
+--
+-- * True of definitely unlifted 'RuntimeRep's such as
+-- 'UnliftedRep', 'IntRep', 'FloatRep', ...
+-- * False of 'LiftedRep',
+-- * False for type variables and type family applications.
+isUnliftedRuntimeRep :: Type -> Bool
+isUnliftedRuntimeRep rep
+ | Just False <- isLiftedRuntimeRep_maybe rep
+ = True
+ | otherwise
+ = False
+
+-- | An INLINE helper for functions such as 'isLiftedLevity' and 'isUnliftedLevity'.
+--
+-- Checks whether the type is a nullary 'TyCon' application,
+-- for a 'TyCon' with the given 'Unique'.
isNullaryTyConKeyApp :: Unique -> Type -> Bool
isNullaryTyConKeyApp key ty
| Just args <- isTyConKeyApp_maybe key ty
- = assert (null args ) True
+ = assert (null args) True
| otherwise
= False
{-# INLINE isNullaryTyConKeyApp #-}
@@ -2448,7 +2473,7 @@ dropRuntimeRepArgs :: [Type] -> [Type]
dropRuntimeRepArgs = dropWhile isRuntimeRepKindedTy
-- | Extract the RuntimeRep classifier of a type. For instance,
--- @getRuntimeRep_maybe Int = LiftedRep@. Returns 'Nothing' if this is not
+-- @getRuntimeRep_maybe Int = Just LiftedRep@. Returns 'Nothing' if this is not
-- possible.
getRuntimeRep_maybe :: HasDebugCallStack
=> Type -> Maybe Type
@@ -2462,6 +2487,30 @@ getRuntimeRep ty
Just r -> r
Nothing -> pprPanic "getRuntimeRep" (ppr ty <+> dcolon <+> ppr (typeKind ty))
+-- | Extract the 'Levity' of a type. For example, @getLevity_maybe Int = Just Lifted@,
+-- @getLevity (Array# Int) = Just Unlifted@, @getLevity Float# = Nothing@.
+--
+-- Returns 'Nothing' if this is not possible. Does not look through type family applications.
+getLevity_maybe :: HasDebugCallStack => Type -> Maybe Type
+getLevity_maybe ty
+ | Just rep <- getRuntimeRep_maybe ty
+ , Just (tc, [lev]) <- splitTyConApp_maybe rep
+ , tc == boxedRepDataConTyCon
+ = Just lev
+ | otherwise
+ = Nothing
+
+-- | Extract the 'Levity' of a type. For example, @getLevity Int = Lifted@,
+-- or @getLevity (Array# Int) = Unlifted@.
+--
+-- Panics if this is not possible. Does not look through type family applications.
+getLevity :: HasDebugCallStack => Type -> Type
+getLevity ty
+ | Just lev <- getLevity_maybe ty
+ = lev
+ | otherwise
+ = pprPanic "getLevity" (ppr ty <+> dcolon <+> ppr (typeKind ty))
+
isUnboxedTupleType :: Type -> Bool
isUnboxedTupleType ty
= tyConAppTyCon (getRuntimeRep ty) `hasKey` tupleRepDataConKey
diff --git a/compiler/GHC/Core/Type.hs-boot b/compiler/GHC/Core/Type.hs-boot
index 94f9e34f83..f5b9c6f20d 100644
--- a/compiler/GHC/Core/Type.hs-boot
+++ b/compiler/GHC/Core/Type.hs-boot
@@ -27,4 +27,6 @@ mkTYPEapp :: Type -> Type
splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
tyConAppTyCon_maybe :: Type -> Maybe TyCon
+getLevity :: HasDebugCallStack => Type -> Type
+
partitionInvisibleTypes :: TyCon -> [Type] -> ([Type], [Type])
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 381cd4f561..fea3a93ce6 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -123,7 +123,7 @@ import qualified Data.Set as Set
************************************************************************
-}
-exprType :: CoreExpr -> Type
+exprType :: HasDebugCallStack => CoreExpr -> Type
-- ^ Recover the type of a well-typed Core expression. Fails when
-- applied to the actual 'GHC.Core.Type' expression as it cannot
-- really be said to have a type
@@ -229,7 +229,7 @@ Note that there might be existentially quantified coercion variables, too.
-}
-- Not defined with applyTypeToArg because you can't print from GHC.Core.
-applyTypeToArgs :: SDoc -> Type -> [CoreExpr] -> Type
+applyTypeToArgs :: HasDebugCallStack => SDoc -> Type -> [CoreExpr] -> Type
-- ^ A more efficient version of 'applyTypeToArg' when we have several arguments.
-- The first argument is just for debugging, and gives some context
applyTypeToArgs pp_e op_ty args
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 52c79e50a3..4f6e2b7057 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -807,17 +807,19 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
go max_depth my_ty old_ty ind
-- We also follow references
MutVarClosure{var=contents}
- | Just (tycon,[world,contents_ty]) <- tcSplitTyConApp_maybe old_ty
+ | Just (tycon,[lev,world,contents_ty]) <- tcSplitTyConApp_maybe old_ty
-> do
-- Deal with the MutVar# primitive
-- It does not have a constructor at all,
-- so we simulate the following one
-- MutVar# :: contents_ty -> MutVar# s contents_ty
- traceTR (text "Following a MutVar")
- contents_tv <- newVar liftedTypeKind
+ massert (tycon == mutVarPrimTyCon)
massert (isUnliftedType my_ty)
+ traceTR (text "Following a MutVar")
+ let contents_kind = mkTYPEapp (mkTyConApp boxedRepDataConTyCon [lev])
+ contents_tv <- newVar contents_kind
(mutvar_ty,_) <- instScheme $ quantifyType $ mkVisFunTyMany
- contents_ty (mkTyConApp tycon [world,contents_ty])
+ contents_ty (mkTyConApp tycon [lev, world,contents_ty])
addConstraint (mkVisFunTyMany contents_tv my_ty) mutvar_ty
x <- go (pred max_depth) contents_tv contents_ty contents
return (RefWrap my_ty x)
@@ -1039,11 +1041,14 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
case clos of
BlackholeClosure{indirectee=ind} -> go my_ty ind
IndClosure{indirectee=ind} -> go my_ty ind
- MutVarClosure{var=contents} -> do
- tv' <- newVar liftedTypeKind
- world <- newVar liftedTypeKind
- addConstraint my_ty (mkTyConApp mutVarPrimTyCon [world,tv'])
- return [(tv', contents)]
+ MutVarClosure{var=contents}
+ | Just (_tycon,[lev,_world,_contents_ty]) <- tcSplitTyConApp_maybe my_ty
+ -> do
+ massert (_tycon == mutVarPrimTyCon)
+ tv' <- newVar $ mkTYPEapp (mkTyConApp boxedRepDataConTyCon [lev])
+ world <- newVar liftedTypeKind
+ addConstraint my_ty $ mkMutVarPrimTy world tv'
+ return [(tv', contents)]
APClosure {payload=pLoad} -> do -- #19559 (incr)
mapM_ (go my_ty) pLoad
return []
diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs
index 78a01d06d6..4c414df9e9 100644
--- a/compiler/GHC/StgToCmm/Foreign.hs
+++ b/compiler/GHC/StgToCmm/Foreign.hs
@@ -603,9 +603,9 @@ closureField profile off = off + fixedHdrSize profile
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- For certain types passed to foreign calls, we adjust the actual
--- value passed to the call. For ByteArray#, Array#, SmallArray#,
--- and ArrayArray#, we pass the address of the array's payload, not
--- the address of the heap object. For example, consider
+-- value passed to the call. For ByteArray#, Array# and SmallArray#,
+-- we pass the address of the array's payload, not the address of
+-- the heap object. For example, consider:
-- foreign import "c_foo" foo :: ByteArray# -> Int# -> IO ()
-- At a Haskell call like `foo x y`, we'll generate a C call that
-- is more like
@@ -715,8 +715,6 @@ typeToStgFArgType :: Type -> StgFArgType
typeToStgFArgType typ
| tycon == arrayPrimTyCon = StgArrayType
| tycon == mutableArrayPrimTyCon = StgArrayType
- | tycon == arrayArrayPrimTyCon = StgArrayType
- | tycon == mutableArrayArrayPrimTyCon = StgArrayType
| tycon == smallArrayPrimTyCon = StgSmallArrayType
| tycon == smallMutableArrayPrimTyCon = StgSmallArrayType
| tycon == byteArrayPrimTyCon = StgByteArrayType
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index e0af686b47..5c538c45c8 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -176,16 +176,6 @@ emitPrimOp dflags primop = case primop of
opIntoRegs $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
_ -> PrimopCmmEmit_External
- CopyArrayArrayOp -> \case
- [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
- opIntoRegs $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
- _ -> PrimopCmmEmit_External
-
- CopyMutableArrayArrayOp -> \case
- [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
- opIntoRegs $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
- _ -> PrimopCmmEmit_External
-
CloneArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes platform (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
@@ -373,10 +363,6 @@ emitPrimOp dflags primop = case primop of
emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
- UnsafeFreezeArrayArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
- emit $ catAGraphs
- [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
- mkAssign (CmmLocal res) arg ]
UnsafeFreezeSmallArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkSMAP_FROZEN_DIRTY_infoLabel)),
@@ -395,27 +381,6 @@ emitPrimOp dflags primop = case primop of
WriteArrayOp -> \[obj, ix, v] -> opIntoRegs $ \[] ->
doWritePtrArrayOp obj ix v
- IndexArrayArrayOp_ByteArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
- doReadPtrArrayOp res obj ix
- IndexArrayArrayOp_ArrayArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
- doReadPtrArrayOp res obj ix
- ReadArrayArrayOp_ByteArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
- doReadPtrArrayOp res obj ix
- ReadArrayArrayOp_MutableByteArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
- doReadPtrArrayOp res obj ix
- ReadArrayArrayOp_ArrayArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
- doReadPtrArrayOp res obj ix
- ReadArrayArrayOp_MutableArrayArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
- doReadPtrArrayOp res obj ix
- WriteArrayArrayOp_ByteArray -> \[obj,ix,v] -> opIntoRegs $ \[] ->
- doWritePtrArrayOp obj ix v
- WriteArrayArrayOp_MutableByteArray -> \[obj,ix,v] -> opIntoRegs $ \[] ->
- doWritePtrArrayOp obj ix v
- WriteArrayArrayOp_ArrayArray -> \[obj,ix,v] -> opIntoRegs $ \[] ->
- doWritePtrArrayOp obj ix v
- WriteArrayArrayOp_MutableArrayArray -> \[obj,ix,v] -> opIntoRegs $ \[] ->
- doWritePtrArrayOp obj ix v
-
ReadSmallArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] ->
doReadSmallPtrArrayOp res obj ix
IndexSmallArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] ->
@@ -430,8 +395,6 @@ emitPrimOp dflags primop = case primop of
(fixedHdrSizeW profile + bytesToWordsRoundUp platform (pc_OFFSET_StgMutArrPtrs_ptrs (platformConstants platform)))
(bWord platform))
SizeofMutableArrayOp -> emitPrimOp dflags SizeofArrayOp
- SizeofArrayArrayOp -> emitPrimOp dflags SizeofArrayOp
- SizeofMutableArrayArrayOp -> emitPrimOp dflags SizeofArrayOp
SizeofSmallArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
emit $ mkAssign (CmmLocal res)
(cmmLoadIndexW platform arg
@@ -1600,7 +1563,6 @@ emitPrimOp dflags primop = case primop of
ShrinkMutableByteArrayOp_Char -> alwaysExternal
ResizeMutableByteArrayOp_Char -> alwaysExternal
ShrinkSmallMutableArrayOp_Char -> alwaysExternal
- NewArrayArrayOp -> alwaysExternal
NewMutVarOp -> alwaysExternal
AtomicModifyMutVar2Op -> alwaysExternal
AtomicModifyMutVar_Op -> alwaysExternal
@@ -1628,7 +1590,7 @@ emitPrimOp dflags primop = case primop of
ReadMVarOp -> alwaysExternal
TryReadMVarOp -> alwaysExternal
IsEmptyMVarOp -> alwaysExternal
- NewIOPortrOp -> alwaysExternal
+ NewIOPortOp -> alwaysExternal
ReadIOPortOp -> alwaysExternal
WriteIOPortOp -> alwaysExternal
DelayOp -> alwaysExternal
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 6a65d5d383..cc09edd778 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -1828,6 +1828,9 @@ commitFlexi flexi tv zonked_kind
| isRuntimeRepTy zonked_kind
-> do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv)
; return liftedRepTy }
+ | isLevityTy zonked_kind
+ -> do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv)
+ ; return liftedDataConTy }
| isMultiplicityTy zonked_kind
-> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv)
; return manyDataConTy }
View Lorry Controller Status