diff --git a/GHC/CString.hs b/GHC/CString.hs --- a/GHC/CString.hs +++ b/GHC/CString.hs @@ -34,9 +34,8 @@ -- stuff uses Strings in the representation, so to give representations for -- ghc-prim types we need unpackCString# -{- -Note [Inlining unpackCString#] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Inlining unpackCString#] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There's really no point in ever inlining things like unpackCString# as the loop doesn't specialise in an interesting way and we can't deforest the list constructors (we'd want to use unpackFoldrCString# for this). Moreover, it's @@ -57,10 +56,22 @@ * stream fusion rules; e.g. in the `text` library, unstream (S.map safe (S.streamList (GHC.unpackCString# a))) = unpackCString# a + +Moreover, we want to make it CONLIKE, so that: + +* the rules in PrelRules will fire when the string is let-bound. + E.g. the eqString rule in PrelRules + eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2 + +* exprIsConApp_maybe will see the string when we have + let x = unpackCString# "foo"# + ...(case x of algs)... + +All of this goes for unpackCStringUtf8# too. -} unpackCString# :: Addr# -> [Char] -{-# NOINLINE unpackCString# #-} +{-# NOINLINE CONLIKE unpackCString# #-} unpackCString# addr = unpack 0# where @@ -110,7 +121,7 @@ -- There's really no point in inlining this for the same reasons as -- unpackCString. See Note [Inlining unpackCString#] above for details. unpackCStringUtf8# :: Addr# -> [Char] -{-# NOINLINE unpackCStringUtf8# #-} +{-# NOINLINE CONLIKE unpackCStringUtf8# #-} unpackCStringUtf8# addr = unpack 0# where diff --git a/GHC/Classes.hs b/GHC/Classes.hs --- a/GHC/Classes.hs +++ b/GHC/Classes.hs @@ -58,6 +58,7 @@ import GHC.IntWord64 import GHC.Prim import GHC.Tuple +import GHC.CString (unpackCString#) import GHC.Types #include "MachDeps.h" @@ -171,6 +172,15 @@ (x:xs) == (y:ys) = x == y && xs == ys _xs == _ys = False +deriving instance Eq Module + +instance Eq TrName where + TrNameS a == TrNameS b = isTrue# (a `eqAddr#` b) + a == b = toString a == toString b + where + toString (TrNameS s) = unpackCString# s + toString (TrNameD s) = s + deriving instance Eq Bool deriving instance Eq Ordering @@ -226,10 +236,10 @@ #if WORD_SIZE_IN_BITS < 64 instance Eq TyCon where - (==) (TyCon hi1 lo1 _ _) (TyCon hi2 lo2 _ _) + (==) (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _) = isTrue# (hi1 `eqWord64#` hi2) && isTrue# (lo1 `eqWord64#` lo2) instance Ord TyCon where - compare (TyCon hi1 lo1 _ _) (TyCon hi2 lo2 _ _) + compare (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _) | isTrue# (hi1 `gtWord64#` hi2) = GT | isTrue# (hi1 `ltWord64#` hi2) = LT | isTrue# (lo1 `gtWord64#` lo2) = GT @@ -237,10 +247,10 @@ | True = EQ #else instance Eq TyCon where - (==) (TyCon hi1 lo1 _ _) (TyCon hi2 lo2 _ _) + (==) (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _) = isTrue# (hi1 `eqWord#` hi2) && isTrue# (lo1 `eqWord#` lo2) instance Ord TyCon where - compare (TyCon hi1 lo1 _ _) (TyCon hi2 lo2 _ _) + compare (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _) | isTrue# (hi1 `gtWord#` hi2) = GT | isTrue# (hi1 `ltWord#` hi2) = LT | isTrue# (lo1 `gtWord#` lo2) = GT @@ -440,6 +450,9 @@ -- These don't really belong here, but we don't have a better place to -- put them +-- These functions have built-in rules. +{-# NOINLINE [0] divInt# #-} +{-# NOINLINE [0] modInt# #-} divInt# :: Int# -> Int# -> Int# x# `divInt#` y# -- Be careful NOT to overflow if we do any additional arithmetic diff --git a/GHC/Magic.hs b/GHC/Magic.hs --- a/GHC/Magic.hs +++ b/GHC/Magic.hs @@ -3,6 +3,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | @@ -21,10 +23,11 @@ -- ----------------------------------------------------------------------------- -module GHC.Magic ( inline, lazy, oneShot, runRW# ) where +module GHC.Magic ( inline, noinline, lazy, oneShot, runRW# ) where import GHC.Prim import GHC.CString () +import GHC.Types (RuntimeRep, TYPE) -- | The call @inline f@ arranges that 'f' is inlined, regardless of -- its size. More precisely, the call @inline f@ rewrites to the @@ -45,6 +48,13 @@ inline :: a -> a inline x = x +-- | The call @noinline f@ arranges that 'f' will not be inlined. +-- It is removed during CorePrep so that its use imposes no overhead +-- (besides the fact that it blocks inlining.) +{-# NOINLINE noinline #-} +noinline :: a -> a +noinline x = x + -- | The 'lazy' function restrains strictness analysis a little. The -- call @lazy e@ means the same as 'e', but 'lazy' has a magical -- property so far as strictness analysis is concerned: it is lazy in @@ -66,7 +76,7 @@ lazy :: a -> a lazy x = x -- Implementation note: its strictness and unfolding are over-ridden --- by the definition in MkId.lhs; in both cases to nothing at all. +-- by the definition in MkId.hs; in both cases to nothing at all. -- That way, 'lazy' does not get inlined, and the strictness analyser -- sees it as lazy. Then the worker/wrapper phase inlines it. -- Result: happiness @@ -81,16 +91,25 @@ -- that would otherwise be shared are re-evaluated every time they are used. Otherwise, -- the use of `oneShot` is safe. -- --- 'oneShot' is open kinded, i.e. the type variables can refer to unlifted --- types as well. -oneShot :: (a -> b) -> (a -> b) +-- 'oneShot' is representation polymorphic: the type variables may refer to lifted +-- or unlifted types. +oneShot :: forall (q :: RuntimeRep) (r :: RuntimeRep) + (a :: TYPE q) (b :: TYPE r). + (a -> b) -> a -> b oneShot f = f --- Implementation note: This is wired in in MkId.lhs, so the code here is +-- Implementation note: This is wired in in MkId.hs, so the code here is -- mostly there to have a place for the documentation. --- | Apply a function to a 'RealWorld' token. -runRW# :: (State# RealWorld -> (# State# RealWorld, o #)) - -> (# State# RealWorld, o #) +-- | Apply a function to a 'State# RealWorld' token. When manually applying +-- a function to `realWorld#`, it is necessary to use `NOINLINE` to prevent +-- semantically undesirable floating. `runRW#` is inlined, but only very late +-- in compilation after all floating is complete. + +-- 'runRW#' is representation polymorphic: the result may have a lifted or +-- unlifted type. + +runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). + (State# RealWorld -> o) -> o -- See Note [runRW magic] in MkId #if !defined(__HADDOCK_VERSION__) runRW# m = m realWorld# diff --git a/GHC/Prim.hs b/GHC/Prim.hs --- a/GHC/Prim.hs +++ b/GHC/Prim.hs @@ -200,6 +200,7 @@ (*##), (/##), negateDouble#, + fabsDouble#, double2Int#, double2Float#, expDouble#, @@ -234,6 +235,7 @@ timesFloat#, divideFloat#, negateFloat#, + fabsFloat#, float2Int#, expFloat#, logFloat#, @@ -331,6 +333,8 @@ newByteArray#, newPinnedByteArray#, newAlignedPinnedByteArray#, + isMutableByteArrayPinned#, + isByteArrayPinned#, byteArrayContents#, sameMutableByteArray#, shrinkMutableByteArray#, @@ -510,19 +514,7 @@ casMutVar#, -- * Exceptions --- |- Note [Strictness for mask\/unmask\/catch] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Consider this example, which comes from GHC.IO.Handle.Internals: --- wantReadableHandle3 f ma b st --- = case ... of --- DEFAULT -> case ma of MVar a -> ... --- 0# -> maskAsynchExceptions# (\st -> case ma of MVar a -> ...) --- The outer case just decides whether to mask exceptions, but we don\'t want --- thereby to hide the strictness in \'ma\'! Hence the use of strictApply1Dmd. --- --- For catch, we must be extra careful; see --- Note [Exceptions and strictness] in Demand --- - +-- | catch#, @@ -614,6 +606,23 @@ eqStableName#, stableNameToInt#, +-- * Compact normal form +-- | + + + Compact#, + compactNew#, + compactResize#, + compactContains#, + compactContainsAny#, + compactGetFirstBlock#, + compactGetNextBlock#, + compactAllocateBlock#, + compactFixupPointers#, + compactAdd#, + compactAddWithSharing#, + compactSize#, + -- * Unsafe pointer equality -- | @@ -648,6 +657,7 @@ BCO#, addrToAny#, + anyToAddr#, mkApUpd0#, newBCO#, unpackClosure#, @@ -668,8 +678,6 @@ Proxy#, proxy#, seq, - Any, - AnyK, unsafeCoerce#, traceEvent#, traceMarker#, @@ -1502,12 +1510,16 @@ mulIntMayOflo# :: Int# -> Int# -> Int# mulIntMayOflo# = mulIntMayOflo# --- |Rounds towards zero. +-- |Rounds towards zero. The behavior is undefined if the second argument is +-- zero. +-- quotInt# :: Int# -> Int# -> Int# quotInt# = quotInt# --- |Satisfies @(quotInt\# x y) *\# y +\# (remInt\# x y) == x@. +-- |Satisfies @(quotInt\# x y) *\# y +\# (remInt\# x y) == x@. The +-- behavior is undefined if the second argument is zero. +-- remInt# :: Int# -> Int# -> Int# remInt# = remInt# @@ -1849,6 +1861,9 @@ negateDouble# :: Double# -> Double# negateDouble# = negateDouble# +fabsDouble# :: Double# -> Double# +fabsDouble# = fabsDouble# + -- |Truncates a @Double#@ value to the nearest @Int#@. -- Results are undefined if the truncation if truncation yields -- a value outside the range of @Int#@. @@ -1948,6 +1963,9 @@ negateFloat# :: Float# -> Float# negateFloat# = negateFloat# +fabsFloat# :: Float# -> Float# +fabsFloat# = fabsFloat# + -- |Truncates a @Float#@ value to the nearest @Int#@. -- Results are undefined if the truncation if truncation yields -- a value outside the range of @Int#@. @@ -2239,6 +2257,17 @@ newAlignedPinnedByteArray# :: Int# -> Int# -> State# s -> (# State# s,MutableByteArray# s #) newAlignedPinnedByteArray# = newAlignedPinnedByteArray# +-- |Determine whether a @MutableByteArray\#@ is guaranteed not to move +-- during GC. + +isMutableByteArrayPinned# :: MutableByteArray# s -> Int# +isMutableByteArrayPinned# = isMutableByteArrayPinned# + +-- |Determine whether a @ByteArray\#@ is guaranteed not to move during GC. + +isByteArrayPinned# :: ByteArray# -> Int# +isByteArrayPinned# = isByteArrayPinned# + -- |Intended for use with pinned arrays; otherwise very unsafe! byteArrayContents# :: ByteArray# -> Addr# @@ -2507,7 +2536,8 @@ copyAddrToByteArray# :: Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s copyAddrToByteArray# = copyAddrToByteArray# --- |Set the range of the MutableByteArray# to the specified character. +-- |@setByteArray# ba off len c@ sets the byte range @[off, off+len]@ of +-- the @MutableByteArray#@ to the byte @c@. setByteArray# :: MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s setByteArray# = setByteArray# @@ -2875,6 +2905,11 @@ sameMutVar# :: MutVar# s a -> MutVar# s a -> Int# sameMutVar# = sameMutVar# +-- | Modify the contents of a @MutVar\#@. Note that this isn\'t strictly +-- speaking the correct type for this function, it should really be +-- @MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #)@, however +-- we don\'t know about pairs here. + atomicModifyMutVar# :: MutVar# s a -> (a -> b) -> State# s -> (# State# s,c #) atomicModifyMutVar# = atomicModifyMutVar# @@ -3054,7 +3089,7 @@ isCurrentThreadBound# :: State# (RealWorld) -> (# State# (RealWorld),Int# #) isCurrentThreadBound# = isCurrentThreadBound# -noDuplicate# :: State# (RealWorld) -> State# (RealWorld) +noDuplicate# :: State# s -> State# s noDuplicate# = noDuplicate# threadStatus# :: ThreadId# -> State# (RealWorld) -> (# State# (RealWorld),Int#,Int#,Int# #) @@ -3062,6 +3097,11 @@ data Weak# b +-- | @mkWeak# k v finalizer s@ creates a weak reference to value @k@, +-- with an associated reference to some value @v@. If @k@ is still +-- alive then @v@ can be retrieved using @deRefWeak#@. Note that +-- the type of @k@ must be represented by a pointer (i.e. of kind @TYPE \'LiftedRep@ or @TYPE \'UnliftedRep@). + mkWeak# :: o -> b -> (State# (RealWorld) -> (# State# (RealWorld),c #)) -> State# (RealWorld) -> (# State# (RealWorld),Weak# b #) mkWeak# = mkWeak# @@ -3115,6 +3155,91 @@ stableNameToInt# :: StableName# a -> Int# stableNameToInt# = stableNameToInt# +data Compact# + +-- | Create a new Compact with the given size (in bytes, not words). +-- The size is rounded up to a multiple of the allocator block size, +-- and capped to one mega block. + +compactNew# :: Word# -> State# (RealWorld) -> (# State# (RealWorld),Compact# #) +compactNew# = compactNew# + +-- | Set the new allocation size of the compact. This value (in bytes) +-- determines the size of each block in the compact chain. + +compactResize# :: Compact# -> Word# -> State# (RealWorld) -> State# (RealWorld) +compactResize# = compactResize# + +-- | Returns 1# if the object is contained in the compact, 0# otherwise. + +compactContains# :: Compact# -> a -> State# (RealWorld) -> (# State# (RealWorld),Int# #) +compactContains# = compactContains# + +-- | Returns 1# if the object is in any compact at all, 0# otherwise. + +compactContainsAny# :: a -> State# (RealWorld) -> (# State# (RealWorld),Int# #) +compactContainsAny# = compactContainsAny# + +-- | Returns the address and the size (in bytes) of the first block of +-- a compact. + +compactGetFirstBlock# :: Compact# -> State# (RealWorld) -> (# State# (RealWorld),Addr#,Word# #) +compactGetFirstBlock# = compactGetFirstBlock# + +-- | Given a compact and the address of one its blocks, returns the +-- next block and its size, or #nullAddr if the argument was the +-- last block in the compact. + +compactGetNextBlock# :: Compact# -> Addr# -> State# (RealWorld) -> (# State# (RealWorld),Addr#,Word# #) +compactGetNextBlock# = compactGetNextBlock# + +-- | Attempt to allocate a compact block with the given size (in +-- bytes) at the given address. The first argument is a hint to +-- the allocator, allocation might be satisfied at a different +-- address (which is returned). +-- The resulting block is not known to the GC until +-- compactFixupPointers# is called on it, and care must be taken +-- so that the address does not escape or memory will be leaked. +-- + +compactAllocateBlock# :: Word# -> Addr# -> State# (RealWorld) -> (# State# (RealWorld),Addr# #) +compactAllocateBlock# = compactAllocateBlock# + +-- | Given the pointer to the first block of a compact, and the +-- address of the root object in the old address space, fix up +-- the internal pointers inside the compact to account for +-- a different position in memory than when it was serialized. +-- This method must be called exactly once after importing +-- a serialized compact, and returns the new compact and +-- the new adjusted root address. + +compactFixupPointers# :: Addr# -> Addr# -> State# (RealWorld) -> (# State# (RealWorld),Compact#,Addr# #) +compactFixupPointers# = compactFixupPointers# + +-- | Recursively add a closure and its transitive closure to a +-- {\texttt Compact\#}, evaluating any unevaluated components at the +-- same time. Note: {\texttt compactAdd\#} is not thread-safe, so +-- only one thread may call {\texttt compactAdd\#} with a particular +-- {\texttt Compact#} at any given time. The primop does not +-- enforce any mutual exclusion; the caller is expected to +-- arrange this. + +compactAdd# :: Compact# -> a -> State# (RealWorld) -> (# State# (RealWorld),a #) +compactAdd# = compactAdd# + +-- | Like {\texttt compactAdd\#}, but retains sharing and cycles +-- during compaction. + +compactAddWithSharing# :: Compact# -> a -> State# (RealWorld) -> (# State# (RealWorld),a #) +compactAddWithSharing# = compactAddWithSharing# + +-- | Return the size (in bytes) of the total amount of data in the Compact# + +compactSize# :: Compact# -> State# (RealWorld) -> (# State# (RealWorld),Word# #) +compactSize# = compactSize# + +-- | Returns 1# if the given pointers are equal and 0# otherwise. + reallyUnsafePtrEquality# :: a -> a -> Int# reallyUnsafePtrEquality# = reallyUnsafePtrEquality# @@ -3138,6 +3263,30 @@ dataToTag# :: a -> Int# dataToTag# = dataToTag# +-- |- Note [dataToTag#] +-- ~~~~~~~~~~~~~~~~~~~~ +-- The dataToTag# primop should always be applied to an evaluated argument. +-- The way to ensure this is to invoke it via the \'getTag\' wrapper in GHC.Base: +-- getTag :: a -> Int# +-- getTag !x = dataToTag# x +-- +-- But now consider +-- \z. case x of y -> let v = dataToTag# y in ... +-- +-- To improve floating, the FloatOut pass (deliberately) does a +-- binder-swap on the case, to give +-- \z. case x of y -> let v = dataToTag# x in ... +-- +-- Now FloatOut might float that v-binding outside the \z. But that is +-- bad because that might mean x gest evaluated much too early! (CorePrep +-- adds an eval to a dataToTag# call, to ensure that the argument really is +-- evaluated; see CorePrep Note [dataToTag magic].) +-- +-- Solution: make DataToTag into a can_fail primop. That will stop it floating +-- (see Note [PrimOp can_fail and has_side_effects] in PrimOp). It\'s a bit of +-- a hack but never mind. +-- - + tagToEnum# :: Int# -> a tagToEnum# = let x = x in x @@ -3150,6 +3299,20 @@ addrToAny# :: Addr# -> (# a #) addrToAny# = addrToAny# +-- | Retrive the address of any Haskell value. This is +-- essentially an {\texttt unsafeCoerce\#}, but if implemented as such +-- the core lint pass complains and fails to compile. +-- As a primop, it is opaque to core\/stg, and only appears +-- in cmm (where the copy propagation pass will get rid of it). +-- Note that \"a\" must be a value, not a thunk! It\'s too late +-- for strictness analysis to enforce this, so you\'re on your +-- own to guarantee this. Also note that {\texttt Addr\#} is not a GC +-- pointer - up to you to guarantee that it does not become +-- a dangling pointer immediately after you get it. + +anyToAddr# :: a -> State# (RealWorld) -> (# State# (RealWorld),Addr# #) +anyToAddr# = anyToAddr# + -- | Wrap a BCO in a @AP_UPD@ thunk which will be updated with the value of -- the BCO when evaluated. @@ -3164,6 +3327,12 @@ newBCO# :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s,BCO# #) newBCO# = newBCO# +-- | @unpackClosure\# closure@ copies non-pointers and pointers in the +-- payload of the given closure into two new arrays, and returns a pointer to +-- the first word of the closure\'s info table, a pointer array for the +-- pointers in the payload, and a non-pointer array for the non-pointers in +-- the payload. + unpackClosure# :: a -> (# Addr#,Array# b,ByteArray# #) unpackClosure# = unpackClosure# @@ -3217,54 +3386,6 @@ seq :: a -> b -> b seq = seq - --- | The type constructor @Any@ is type to which you can unsafely coerce any --- lifted type, and back. --- --- * It is lifted, and hence represented by a pointer --- --- * It does not claim to be a /data/ type, and that\'s important for --- the code generator, because the code gen may /enter/ a data value --- but never enters a function value. --- --- It\'s also used to instantiate un-constrained type variables after type --- checking. For example, @length@ has type --- --- @length :: forall a. [a] -> Int@ --- --- and the list datacon for the empty list has type --- --- @[] :: forall a. [a]@ --- --- In order to compose these two terms as @length []@ a type --- application is required, but there is no constraint on the --- choice. In this situation GHC uses @Any@: --- --- @length (Any *) ([] (Any *))@ --- --- Above, we print kinds explicitly, as if with --- @-fprint-explicit-kinds@. --- --- Note that @Any@ is kind polymorphic; its kind is thus --- @forall k. k@. - -data Any - --- | The kind @AnyK@ is the kind level counterpart to @Any@. In a --- kind polymorphic setting, a similar example to the length of the empty --- list can be given at the type level: --- --- @type family Length (l :: [k]) :: Nat@ --- @type instance Length [] = Zero@ --- --- When @Length@ is applied to the empty (promoted) list it will have --- the kind @Length AnyK []@. --- --- @AnyK@ is currently not exported and cannot be used directly, but --- you might see it in debug output from the compiler. --- - -data AnyK -- | The function @unsafeCoerce\#@ allows you to side-step the typechecker entirely. That -- is, it allows you to coerce any type into any other type. If you use this function, diff --git a/GHC/PrimopWrappers.hs b/GHC/PrimopWrappers.hs --- a/GHC/PrimopWrappers.hs +++ b/GHC/PrimopWrappers.hs @@ -2,7 +2,7 @@ module GHC.PrimopWrappers where import qualified GHC.Prim import GHC.Tuple () -import GHC.Prim (Char#, Int#, Word#, Float#, Double#, State#, MutableArray#, Array#, SmallMutableArray#, SmallArray#, MutableByteArray#, ByteArray#, Addr#, StablePtr#, MutableArrayArray#, ArrayArray#, MutVar#, RealWorld, TVar#, MVar#, ThreadId#, Weak#, StableName#, BCO#) +import GHC.Prim (Char#, Int#, Word#, Float#, Double#, State#, MutableArray#, Array#, SmallMutableArray#, SmallArray#, MutableByteArray#, ByteArray#, Addr#, StablePtr#, MutableArrayArray#, ArrayArray#, MutVar#, RealWorld, TVar#, MVar#, ThreadId#, Weak#, StableName#, Compact#, BCO#) {-# NOINLINE gtChar# #-} gtChar# :: Char# -> Char# -> Int# gtChar# a1 a2 = (GHC.Prim.gtChar#) a1 a2 @@ -288,6 +288,9 @@ {-# NOINLINE negateDouble# #-} negateDouble# :: Double# -> Double# negateDouble# a1 = (GHC.Prim.negateDouble#) a1 +{-# NOINLINE fabsDouble# #-} +fabsDouble# :: Double# -> Double# +fabsDouble# a1 = (GHC.Prim.fabsDouble#) a1 {-# NOINLINE double2Int# #-} double2Int# :: Double# -> Int# double2Int# a1 = (GHC.Prim.double2Int#) a1 @@ -372,6 +375,9 @@ {-# NOINLINE negateFloat# #-} negateFloat# :: Float# -> Float# negateFloat# a1 = (GHC.Prim.negateFloat#) a1 +{-# NOINLINE fabsFloat# #-} +fabsFloat# :: Float# -> Float# +fabsFloat# a1 = (GHC.Prim.fabsFloat#) a1 {-# NOINLINE float2Int# #-} float2Int# :: Float# -> Int# float2Int# a1 = (GHC.Prim.float2Int#) a1 @@ -525,6 +531,12 @@ {-# NOINLINE newAlignedPinnedByteArray# #-} newAlignedPinnedByteArray# :: Int# -> Int# -> State# s -> (# State# s,MutableByteArray# s #) newAlignedPinnedByteArray# a1 a2 a3 = (GHC.Prim.newAlignedPinnedByteArray#) a1 a2 a3 +{-# NOINLINE isMutableByteArrayPinned# #-} +isMutableByteArrayPinned# :: MutableByteArray# s -> Int# +isMutableByteArrayPinned# a1 = (GHC.Prim.isMutableByteArrayPinned#) a1 +{-# NOINLINE isByteArrayPinned# #-} +isByteArrayPinned# :: ByteArray# -> Int# +isByteArrayPinned# a1 = (GHC.Prim.isByteArrayPinned#) a1 {-# NOINLINE byteArrayContents# #-} byteArrayContents# :: ByteArray# -> Addr# byteArrayContents# a1 = (GHC.Prim.byteArrayContents#) a1 @@ -1093,7 +1105,7 @@ isCurrentThreadBound# :: State# (RealWorld) -> (# State# (RealWorld),Int# #) isCurrentThreadBound# a1 = (GHC.Prim.isCurrentThreadBound#) a1 {-# NOINLINE noDuplicate# #-} -noDuplicate# :: State# (RealWorld) -> State# (RealWorld) +noDuplicate# :: State# s -> State# s noDuplicate# a1 = (GHC.Prim.noDuplicate#) a1 {-# NOINLINE threadStatus# #-} threadStatus# :: ThreadId# -> State# (RealWorld) -> (# State# (RealWorld),Int#,Int#,Int# #) @@ -1134,6 +1146,39 @@ {-# NOINLINE stableNameToInt# #-} stableNameToInt# :: StableName# a -> Int# stableNameToInt# a1 = (GHC.Prim.stableNameToInt#) a1 +{-# NOINLINE compactNew# #-} +compactNew# :: Word# -> State# (RealWorld) -> (# State# (RealWorld),Compact# #) +compactNew# a1 a2 = (GHC.Prim.compactNew#) a1 a2 +{-# NOINLINE compactResize# #-} +compactResize# :: Compact# -> Word# -> State# (RealWorld) -> State# (RealWorld) +compactResize# a1 a2 a3 = (GHC.Prim.compactResize#) a1 a2 a3 +{-# NOINLINE compactContains# #-} +compactContains# :: Compact# -> a -> State# (RealWorld) -> (# State# (RealWorld),Int# #) +compactContains# a1 a2 a3 = (GHC.Prim.compactContains#) a1 a2 a3 +{-# NOINLINE compactContainsAny# #-} +compactContainsAny# :: a -> State# (RealWorld) -> (# State# (RealWorld),Int# #) +compactContainsAny# a1 a2 = (GHC.Prim.compactContainsAny#) a1 a2 +{-# NOINLINE compactGetFirstBlock# #-} +compactGetFirstBlock# :: Compact# -> State# (RealWorld) -> (# State# (RealWorld),Addr#,Word# #) +compactGetFirstBlock# a1 a2 = (GHC.Prim.compactGetFirstBlock#) a1 a2 +{-# NOINLINE compactGetNextBlock# #-} +compactGetNextBlock# :: Compact# -> Addr# -> State# (RealWorld) -> (# State# (RealWorld),Addr#,Word# #) +compactGetNextBlock# a1 a2 a3 = (GHC.Prim.compactGetNextBlock#) a1 a2 a3 +{-# NOINLINE compactAllocateBlock# #-} +compactAllocateBlock# :: Word# -> Addr# -> State# (RealWorld) -> (# State# (RealWorld),Addr# #) +compactAllocateBlock# a1 a2 a3 = (GHC.Prim.compactAllocateBlock#) a1 a2 a3 +{-# NOINLINE compactFixupPointers# #-} +compactFixupPointers# :: Addr# -> Addr# -> State# (RealWorld) -> (# State# (RealWorld),Compact#,Addr# #) +compactFixupPointers# a1 a2 a3 = (GHC.Prim.compactFixupPointers#) a1 a2 a3 +{-# NOINLINE compactAdd# #-} +compactAdd# :: Compact# -> a -> State# (RealWorld) -> (# State# (RealWorld),a #) +compactAdd# a1 a2 a3 = (GHC.Prim.compactAdd#) a1 a2 a3 +{-# NOINLINE compactAddWithSharing# #-} +compactAddWithSharing# :: Compact# -> a -> State# (RealWorld) -> (# State# (RealWorld),a #) +compactAddWithSharing# a1 a2 a3 = (GHC.Prim.compactAddWithSharing#) a1 a2 a3 +{-# NOINLINE compactSize# #-} +compactSize# :: Compact# -> State# (RealWorld) -> (# State# (RealWorld),Word# #) +compactSize# a1 a2 = (GHC.Prim.compactSize#) a1 a2 {-# NOINLINE reallyUnsafePtrEquality# #-} reallyUnsafePtrEquality# :: a -> a -> Int# reallyUnsafePtrEquality# a1 a2 = (GHC.Prim.reallyUnsafePtrEquality#) a1 a2 @@ -1158,6 +1203,9 @@ {-# NOINLINE addrToAny# #-} addrToAny# :: Addr# -> (# a #) addrToAny# a1 = (GHC.Prim.addrToAny#) a1 +{-# NOINLINE anyToAddr# #-} +anyToAddr# :: a -> State# (RealWorld) -> (# State# (RealWorld),Addr# #) +anyToAddr# a1 a2 = (GHC.Prim.anyToAddr#) a1 a2 {-# NOINLINE mkApUpd0# #-} mkApUpd0# :: BCO# -> (# a #) mkApUpd0# a1 = (GHC.Prim.mkApUpd0#) a1 diff --git a/GHC/Types.hs b/GHC/Types.hs --- a/GHC/Types.hs +++ b/GHC/Types.hs @@ -1,5 +1,6 @@ {-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples, - MultiParamTypeClasses, RoleAnnotations, CPP, TypeOperators #-} + MultiParamTypeClasses, RoleAnnotations, CPP, TypeOperators, + PolyKinds #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Types @@ -29,6 +30,7 @@ isTrue#, SPEC(..), Nat, Symbol, + Any, type (~~), Coercible, TYPE, RuntimeRep(..), Type, type (*), type (★), Constraint, -- The historical type * should ideally be written as @@ -37,17 +39,14 @@ VecCount(..), VecElem(..), -- * Runtime type representation - Module(..), TrName(..), TyCon(..) + Module(..), TrName(..), TyCon(..), TypeLitSort(..), + KindRep(..), KindBndr ) where import GHC.Prim infixr 5 : --- Take note: All types defined here must have associated type representations --- defined in Data.Typeable.Internal. --- See Note [Representation of types defined in GHC.Types] below. - {- ********************************************************************* * * Kinds @@ -58,13 +57,13 @@ data Constraint -- | The kind of types with values. For example @Int :: Type@. -type Type = TYPE 'PtrRepLifted +type Type = TYPE 'LiftedRep -- | A backward-compatible (pre-GHC 8.0) synonym for 'Type' -type * = TYPE 'PtrRepLifted +type * = TYPE 'LiftedRep -- | A unicode backward-compatible (pre-GHC 8.0) synonym for 'Type' -type ★ = TYPE 'PtrRepLifted +type ★ = TYPE 'LiftedRep {- ********************************************************************* * * @@ -81,6 +80,23 @@ {- ********************************************************************* * * + Any +* * +********************************************************************* -} + +-- | The type constructor 'Any' is type to which you can unsafely coerce any +-- lifted type, and back. More concretely, for a lifted type @t@ and +-- value @x :: t@, -- @unsafeCoerce (unsafeCoerce x :: Any) :: t@ is equivalent +-- to @x@. +-- +type family Any :: k where { } +-- See Note [Any types] in TysWiredIn. Also, for a bit of history on Any see +-- #10886. Note that this must be a *closed* type family: we need to ensure +-- that this can't reduce to a `data` type for the results discussed in +-- Note [Any types]. + +{- ********************************************************************* +* * Lists NB: lists are built-in syntax, and hence not explicitly exported @@ -210,7 +226,7 @@ -- Nevertheless one can pretend that the following three kinds of instances -- exist. First, as a trivial base-case: -- --- @instance a a@ +-- @instance Coercible a a@ -- -- Furthermore, for every type constructor there is -- an instance that allows to coerce under the type constructor. For @@ -338,7 +354,7 @@ {- ********************************************************************* * * - RuntimeRep + Levity polymorphism * * ********************************************************************* -} @@ -355,9 +371,10 @@ -- a further distinction is made, between lifted types (that contain ⊥), -- and unlifted ones (that don't). data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type - | PtrRepLifted -- ^ lifted; represented by a pointer - | PtrRepUnlifted -- ^ unlifted; represented by a pointer - | VoidRep -- ^ erased entirely + | TupleRep [RuntimeRep] -- ^ An unboxed tuple of the given reps + | SumRep [RuntimeRep] -- ^ An unboxed sum of the given reps + | LiftedRep -- ^ lifted; represented by a pointer + | UnliftedRep -- ^ unlifted; represented by a pointer | IntRep -- ^ signed, word-sized value | WordRep -- ^ unsigned, word-sized value | Int64Rep -- ^ signed, 64-bit value (on 32-bit only) @@ -365,7 +382,6 @@ | AddrRep -- ^ A pointer, but /not/ to a Haskell value | FloatRep -- ^ a 32-bit floating point number | DoubleRep -- ^ a 64-bit floating point number - | UnboxedTupleRep -- ^ An unboxed tuple; this doesn't specify a concrete rep -- See also Note [Wiring in RuntimeRep] in TysWiredIn @@ -376,6 +392,7 @@ | Vec16 | Vec32 | Vec64 +-- Enum, Bounded instances in GHC.Enum -- | Element of a SIMD vector type data VecElem = Int8ElemRep @@ -388,6 +405,7 @@ | Word64ElemRep | FloatElemRep | DoubleElemRep +-- Enum, Bounded instances in GHC.Enum {- ********************************************************************* * * @@ -405,7 +423,7 @@ - We do this for every module (except this module GHC.Types), so we can't depend on anything else (eg string unpacking code) -That's why we have these terribly low-level repesentations. The TrName +That's why we have these terribly low-level representations. The TrName type lets us use the TrNameS constructor when allocating static data; but we also need TrNameD for the case where we are deserialising a TyCon or Module (for example when deserialising a TypeRep), in which case we @@ -422,14 +440,31 @@ = TrNameS Addr# -- Static | TrNameD [Char] -- Dynamic +-- | A de Bruijn index for a binder within a 'KindRep'. +type KindBndr = Int + #if WORD_SIZE_IN_BITS < 64 -data TyCon = TyCon - Word64# Word64# -- Fingerprint - Module -- Module in which this is defined - TrName -- Type constructor name +#define WORD64_TY Word64# #else -data TyCon = TyCon - Word# Word# - Module - TrName +#define WORD64_TY Word# #endif + +-- | The representation produced by GHC for conjuring up the kind of a +-- 'TypeRep'. +data KindRep = KindRepTyConApp TyCon [KindRep] + | KindRepVar !KindBndr + | KindRepApp KindRep KindRep + | KindRepFun KindRep KindRep + | KindRepTYPE !RuntimeRep + | KindRepTypeLitS TypeLitSort Addr# + | KindRepTypeLitD TypeLitSort [Char] + +data TypeLitSort = TypeLitSymbol + | TypeLitNat + +-- Show instance for TyCon found in GHC.Show +data TyCon = TyCon WORD64_TY WORD64_TY -- Fingerprint + Module -- Module in which this is defined + TrName -- Type constructor name + Int# -- How many kind variables do we accept? + KindRep -- A representation of the type's kind diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,6 +1,2 @@ -module Main (main) where - import Distribution.Simple - -main :: IO () main = defaultMain diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,4 +1,42 @@ +## 0.5.1.0 + +- Shipped with GHC 8.2.1 + +- Added to `GHC.Prim`: + + fabsDouble# :: Double# -> Double# + fabsFloat# :: Float# -> Float# + isByteArrayPinned# :: ByteArray# -> Int# + isMutableByteArrayPinned# :: MutableByteArray# s -> Int# + anyToAddr# :: a -> State# (RealWorld) -> (# State# (RealWorld),Addr# #) + +- New primitives for compact regions in `GHC.Prim`: + + Compact# + compactNew# + compactResize# + compactContains# + compactContainsAny# + compactGetFirstBlock# + compactGetNextBlock# + compactAllocateBlock# + compactFixupPointers# + compactAdd# + compactAddWithSharing# + compactSize# + +- Generalised `noDuplicate#` from + + noDuplicate# :: State# (RealWorld) -> State# (RealWorld) + + to + + noDuplicate# :: State# s -> State# s + + ## 0.5.0.0 + +- Shipped with GHC 8.0.1 - `GHC.Classes`: new `class IP (a :: Symbol) b | a -> b` diff --git a/ghc-prim.cabal b/ghc-prim.cabal --- a/ghc-prim.cabal +++ b/ghc-prim.cabal @@ -1,5 +1,5 @@ name: ghc-prim -version: 0.5.0.0 +version: 0.5.1.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE