diff --git a/GHC/Classes.hs b/GHC/Classes.hs --- a/GHC/Classes.hs +++ b/GHC/Classes.hs @@ -119,6 +119,21 @@ -- and 'Eq' may be derived for any datatype whose constituents are also -- instances of 'Eq'. -- +-- The Haskell Report defines no laws for 'Eq'. However, '==' is customarily +-- expected to implement an equivalence relationship where two values comparing +-- equal are indistinguishable by "public" functions, with a "public" function +-- being one not allowing to see implementation details. For example, for a +-- type representing non-normalised natural numbers modulo 100, a "public" +-- function doesn't make the difference between 1 and 201. It is expected to +-- have the following properties: +-- +-- [__Reflexivity__]: @x == x@ = 'True' +-- [__Symmetry__]: @x == y@ = @y == x@ +-- [__Transitivity__]: if @x == y && y == z@ = 'True', then @x == z@ = 'True' +-- [__Substitutivity__]: if @x == y@ = 'True' and @f@ is a "public" function +-- whose return type is an instance of 'Eq', then @f x == f y@ = 'True' +-- [__Negation__]: @x /= y@ = @not (x == y)@ +-- -- Minimal complete definition: either '==' or '/='. -- class Eq a where @@ -207,6 +222,18 @@ (C# x) `eqChar` (C# y) = isTrue# (x `eqChar#` y) (C# x) `neChar` (C# y) = isTrue# (x `neChar#` y) +-- | Note that due to the presence of @NaN@, `Float`'s 'Eq' instance does not +-- satisfy reflexivity. +-- +-- >>> 0/0 == (0/0 :: Float) +-- False +-- +-- Also note that `Float`'s 'Eq' instance does not satisfy substitutivity: +-- +-- >>> 0 == (-0 :: Float) +-- True +-- >>> recip 0 == recip (-0 :: Float) +-- False instance Eq Float where (==) = eqFloat @@ -215,6 +242,18 @@ eqFloat :: Float -> Float -> Bool (F# x) `eqFloat` (F# y) = isTrue# (x `eqFloat#` y) +-- | Note that due to the presence of @NaN@, `Double`'s 'Eq' instance does not +-- satisfy reflexivity. +-- +-- >>> 0/0 == (0/0 :: Double) +-- False +-- +-- Also note that `Double`'s 'Eq' instance does not satisfy substitutivity: +-- +-- >>> 0 == (-0 :: Double) +-- True +-- >>> recip 0 == recip (-0 :: Double) +-- False instance Eq Double where (==) = eqDouble @@ -261,12 +300,31 @@ -- | The 'Ord' class is used for totally ordered datatypes. -- --- Instances of 'Ord' can be derived for any user-defined --- datatype whose constituent types are in 'Ord'. The declared order --- of the constructors in the data declaration determines the ordering --- in derived 'Ord' instances. The 'Ordering' datatype allows a single --- comparison to determine the precise ordering of two objects. +-- Instances of 'Ord' can be derived for any user-defined datatype whose +-- constituent types are in 'Ord'. The declared order of the constructors in +-- the data declaration determines the ordering in derived 'Ord' instances. The +-- 'Ordering' datatype allows a single comparison to determine the precise +-- ordering of two objects. -- +-- The Haskell Report defines no laws for 'Ord'. However, '<=' is customarily +-- expected to implement a non-strict partial order and have the following +-- properties: +-- +-- [__Transitivity__]: if @x <= y && y <= z@ = 'True', then @x <= z@ = 'True' +-- [__Reflexivity__]: @x <= x@ = 'True' +-- [__Antisymmetry__]: if @x <= y && y <= x@ = 'True', then @x == y@ = 'True' +-- +-- Note that the following operator interactions are expected to hold: +-- +-- 1. @x >= y@ = @y <= x@ +-- 2. @x < y@ = @x <= y && x /= y@ +-- 3. @x > y@ = @y < x@ +-- 4. @x < y@ = @compare x y == LT@ +-- 5. @x > y@ = @compare x y == GT@ +-- 6. @x == y@ = @compare x y == EQ@ +-- 7. @min x y == if x <= y then x else y@ = 'True' +-- 8. @max x y == if x >= y then x else y@ = 'True' +-- -- Minimal complete definition: either 'compare' or '<='. -- Using 'compare' can be more efficient for complex types. -- @@ -350,6 +408,19 @@ (C# c1) <= (C# c2) = isTrue# (c1 `leChar#` c2) (C# c1) < (C# c2) = isTrue# (c1 `ltChar#` c2) +-- | Note that due to the presence of @NaN@, `Float`'s 'Ord' instance does not +-- satisfy reflexivity. +-- +-- >>> 0/0 <= (0/0 :: Float) +-- False +-- +-- Also note that, due to the same, `Ord`'s operator interactions are not +-- respected by `Float`'s instance: +-- +-- >>> (0/0 :: Float) > 1 +-- False +-- >>> compare (0/0 :: Float) 1 +-- GT instance Ord Float where (F# x) `compare` (F# y) = if isTrue# (x `ltFloat#` y) then LT @@ -361,6 +432,19 @@ (F# x) >= (F# y) = isTrue# (x `geFloat#` y) (F# x) > (F# y) = isTrue# (x `gtFloat#` y) +-- | Note that due to the presence of @NaN@, `Double`'s 'Ord' instance does not +-- satisfy reflexivity. +-- +-- >>> 0/0 <= (0/0 :: Double) +-- False +-- +-- Also note that, due to the same, `Ord`'s operator interactions are not +-- respected by `Double`'s instance: +-- +-- >>> (0/0 :: Double) > 1 +-- False +-- >>> compare (0/0 :: Double) 1 +-- GT instance Ord Double where (D# x) `compare` (D# y) = if isTrue# (x <## y) then LT diff --git a/GHC/Magic.hs b/GHC/Magic.hs --- a/GHC/Magic.hs +++ b/GHC/Magic.hs @@ -3,7 +3,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- @@ -25,6 +26,10 @@ module GHC.Magic ( inline, noinline, lazy, oneShot, runRW# ) where +-------------------------------------------------- +-- See Note [magicIds] in MkId.hs +-------------------------------------------------- + import GHC.Prim import GHC.CString () import GHC.Types (RuntimeRep, TYPE) @@ -110,11 +115,10 @@ runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o --- See Note [runRW magic] in MkId +-- See Note [runRW magic] in CorePrep +{-# NOINLINE runRW# #-} -- runRW# is inlined manually in CorePrep #if !defined(__HADDOCK_VERSION__) runRW# m = m realWorld# #else runRW# = runRW# -- The realWorld# is too much for haddock #endif -{-# NOINLINE runRW# #-} --- This is inlined manually in CorePrep diff --git a/GHC/Prim.hs b/GHC/Prim.hs --- a/GHC/Prim.hs +++ b/GHC/Prim.hs @@ -44,7 +44,7 @@ -- arithmetic operations, comparisons, and a range of -- conversions. The 8-bit and 16-bit sizes are always -- represented as @Int\#@ and @Word\#@, and the --- operations implemented in terms of the the primops on these +-- operations implemented in terms of the primops on these -- types, with suitable range restrictions on the results (using -- the @narrow$n$Int\#@ and @narrow$n$Word\#@ families -- of primops. The 32-bit sizes are represented using @Int\#@ and @Word\#@ when @WORD\_SIZE\_IN\_BITS@ @@ -131,6 +131,7 @@ Word#, plusWord#, + addWordC#, subWordC#, plusWord2#, minusWord#, @@ -369,6 +370,20 @@ indexWord16Array#, indexWord32Array#, indexWord64Array#, + indexWord8ArrayAsChar#, + indexWord8ArrayAsWideChar#, + indexWord8ArrayAsAddr#, + indexWord8ArrayAsFloat#, + indexWord8ArrayAsDouble#, + indexWord8ArrayAsStablePtr#, + indexWord8ArrayAsInt16#, + indexWord8ArrayAsInt32#, + indexWord8ArrayAsInt64#, + indexWord8ArrayAsInt#, + indexWord8ArrayAsWord16#, + indexWord8ArrayAsWord32#, + indexWord8ArrayAsWord64#, + indexWord8ArrayAsWord#, readCharArray#, readWideCharArray#, readIntArray#, @@ -385,6 +400,20 @@ readWord16Array#, readWord32Array#, readWord64Array#, + readWord8ArrayAsChar#, + readWord8ArrayAsWideChar#, + readWord8ArrayAsAddr#, + readWord8ArrayAsFloat#, + readWord8ArrayAsDouble#, + readWord8ArrayAsStablePtr#, + readWord8ArrayAsInt16#, + readWord8ArrayAsInt32#, + readWord8ArrayAsInt64#, + readWord8ArrayAsInt#, + readWord8ArrayAsWord16#, + readWord8ArrayAsWord32#, + readWord8ArrayAsWord64#, + readWord8ArrayAsWord#, writeCharArray#, writeWideCharArray#, writeIntArray#, @@ -401,6 +430,20 @@ writeWord16Array#, writeWord32Array#, writeWord64Array#, + writeWord8ArrayAsChar#, + writeWord8ArrayAsWideChar#, + writeWord8ArrayAsAddr#, + writeWord8ArrayAsFloat#, + writeWord8ArrayAsDouble#, + writeWord8ArrayAsStablePtr#, + writeWord8ArrayAsInt16#, + writeWord8ArrayAsInt32#, + writeWord8ArrayAsInt64#, + writeWord8ArrayAsInt#, + writeWord8ArrayAsWord16#, + writeWord8ArrayAsWord32#, + writeWord8ArrayAsWord64#, + writeWord8ArrayAsWord#, compareByteArrays#, copyByteArray#, copyMutableByteArray#, @@ -545,7 +588,6 @@ retry#, catchRetry#, catchSTM#, - check#, newTVar#, readTVar#, readTVarIO#, @@ -692,6 +734,8 @@ unsafeCoerce#, traceEvent#, traceMarker#, + getThreadAllocationCounter#, + setThreadAllocationCounter#, -- * Safe coercions -- | @@ -1638,6 +1682,13 @@ plusWord# :: Word# -> Word# -> Word# plusWord# = plusWord# +-- |Add unsigned integers reporting overflow. +-- The first element of the pair is the result. The second element is +-- the carry flag, which is nonzero on overflow. See also @plusWord2#@. + +addWordC# :: Word# -> Word# -> (# Word#,Int# #) +addWordC# = addWordC# + -- |Subtract unsigned integers reporting overflow. -- The first element of the pair is the result. The second element is -- the carry flag, which is nonzero on overflow. @@ -1645,6 +1696,10 @@ subWordC# :: Word# -> Word# -> (# Word#,Int# #) subWordC# = subWordC# +-- |Add unsigned integers, with the high part (carry) in the first +-- component of the returned pair and the low part in the second +-- component of the pair. See also @addWordC#@. + plusWord2# :: Word# -> Word# -> (# Word#,Word# #) plusWord2# = plusWord2# @@ -2116,8 +2171,13 @@ sizeofMutableArray# :: MutableArray# s a -> Int# sizeofMutableArray# = sizeofMutableArray# --- |Read from specified index of immutable array. Result is packaged into --- an unboxed singleton; the result itself is not yet evaluated. +-- |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 +-- array to happen but does not evaluate the element itself. Evaluating +-- the thunk prevents additional thunks from building up on the +-- heap. Avoiding these thunks, in turn, reduces references to the +-- argument array, allowing it to be garbage collected more promptly. indexArray# :: Array# a -> Int# -> (# a #) indexArray# = indexArray# @@ -2454,6 +2514,76 @@ -- |Read 8-bit character; offset in bytes. +indexWord8ArrayAsChar# :: ByteArray# -> Int# -> Char# +indexWord8ArrayAsChar# = indexWord8ArrayAsChar# + +-- |Read 31-bit character; offset in bytes. + +indexWord8ArrayAsWideChar# :: ByteArray# -> Int# -> Char# +indexWord8ArrayAsWideChar# = indexWord8ArrayAsWideChar# + +-- |Read address; offset in bytes. + +indexWord8ArrayAsAddr# :: ByteArray# -> Int# -> Addr# +indexWord8ArrayAsAddr# = indexWord8ArrayAsAddr# + +-- |Read float; offset in bytes. + +indexWord8ArrayAsFloat# :: ByteArray# -> Int# -> Float# +indexWord8ArrayAsFloat# = indexWord8ArrayAsFloat# + +-- |Read double; offset in bytes. + +indexWord8ArrayAsDouble# :: ByteArray# -> Int# -> Double# +indexWord8ArrayAsDouble# = indexWord8ArrayAsDouble# + +-- |Read stable pointer; offset in bytes. + +indexWord8ArrayAsStablePtr# :: ByteArray# -> Int# -> StablePtr# a +indexWord8ArrayAsStablePtr# = indexWord8ArrayAsStablePtr# + +-- |Read 16-bit int; offset in bytes. + +indexWord8ArrayAsInt16# :: ByteArray# -> Int# -> Int# +indexWord8ArrayAsInt16# = indexWord8ArrayAsInt16# + +-- |Read 32-bit int; offset in bytes. + +indexWord8ArrayAsInt32# :: ByteArray# -> Int# -> Int# +indexWord8ArrayAsInt32# = indexWord8ArrayAsInt32# + +-- |Read 64-bit int; offset in bytes. + +indexWord8ArrayAsInt64# :: ByteArray# -> Int# -> Int# +indexWord8ArrayAsInt64# = indexWord8ArrayAsInt64# + +-- |Read int; offset in bytes. + +indexWord8ArrayAsInt# :: ByteArray# -> Int# -> Int# +indexWord8ArrayAsInt# = indexWord8ArrayAsInt# + +-- |Read 16-bit word; offset in bytes. + +indexWord8ArrayAsWord16# :: ByteArray# -> Int# -> Word# +indexWord8ArrayAsWord16# = indexWord8ArrayAsWord16# + +-- |Read 32-bit word; offset in bytes. + +indexWord8ArrayAsWord32# :: ByteArray# -> Int# -> Word# +indexWord8ArrayAsWord32# = indexWord8ArrayAsWord32# + +-- |Read 64-bit word; offset in bytes. + +indexWord8ArrayAsWord64# :: ByteArray# -> Int# -> Word# +indexWord8ArrayAsWord64# = indexWord8ArrayAsWord64# + +-- |Read word; offset in bytes. + +indexWord8ArrayAsWord# :: ByteArray# -> Int# -> Word# +indexWord8ArrayAsWord# = indexWord8ArrayAsWord# + +-- |Read 8-bit character; offset in bytes. + readCharArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Char# #) readCharArray# = readCharArray# @@ -2508,6 +2638,48 @@ readWord64Array# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) readWord64Array# = readWord64Array# +readWord8ArrayAsChar# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Char# #) +readWord8ArrayAsChar# = readWord8ArrayAsChar# + +readWord8ArrayAsWideChar# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Char# #) +readWord8ArrayAsWideChar# = readWord8ArrayAsWideChar# + +readWord8ArrayAsAddr# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Addr# #) +readWord8ArrayAsAddr# = readWord8ArrayAsAddr# + +readWord8ArrayAsFloat# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Float# #) +readWord8ArrayAsFloat# = readWord8ArrayAsFloat# + +readWord8ArrayAsDouble# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Double# #) +readWord8ArrayAsDouble# = readWord8ArrayAsDouble# + +readWord8ArrayAsStablePtr# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,StablePtr# a #) +readWord8ArrayAsStablePtr# = readWord8ArrayAsStablePtr# + +readWord8ArrayAsInt16# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Int# #) +readWord8ArrayAsInt16# = readWord8ArrayAsInt16# + +readWord8ArrayAsInt32# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Int# #) +readWord8ArrayAsInt32# = readWord8ArrayAsInt32# + +readWord8ArrayAsInt64# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Int# #) +readWord8ArrayAsInt64# = readWord8ArrayAsInt64# + +readWord8ArrayAsInt# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Int# #) +readWord8ArrayAsInt# = readWord8ArrayAsInt# + +readWord8ArrayAsWord16# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) +readWord8ArrayAsWord16# = readWord8ArrayAsWord16# + +readWord8ArrayAsWord32# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) +readWord8ArrayAsWord32# = readWord8ArrayAsWord32# + +readWord8ArrayAsWord64# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) +readWord8ArrayAsWord64# = readWord8ArrayAsWord64# + +readWord8ArrayAsWord# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) +readWord8ArrayAsWord# = readWord8ArrayAsWord# + -- |Write 8-bit character; offset in bytes. writeCharArray# :: MutableByteArray# s -> Int# -> Char# -> State# s -> State# s @@ -2560,6 +2732,48 @@ writeWord64Array# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s writeWord64Array# = writeWord64Array# +writeWord8ArrayAsChar# :: MutableByteArray# s -> Int# -> Char# -> State# s -> State# s +writeWord8ArrayAsChar# = writeWord8ArrayAsChar# + +writeWord8ArrayAsWideChar# :: MutableByteArray# s -> Int# -> Char# -> State# s -> State# s +writeWord8ArrayAsWideChar# = writeWord8ArrayAsWideChar# + +writeWord8ArrayAsAddr# :: MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s +writeWord8ArrayAsAddr# = writeWord8ArrayAsAddr# + +writeWord8ArrayAsFloat# :: MutableByteArray# s -> Int# -> Float# -> State# s -> State# s +writeWord8ArrayAsFloat# = writeWord8ArrayAsFloat# + +writeWord8ArrayAsDouble# :: MutableByteArray# s -> Int# -> Double# -> State# s -> State# s +writeWord8ArrayAsDouble# = writeWord8ArrayAsDouble# + +writeWord8ArrayAsStablePtr# :: MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s +writeWord8ArrayAsStablePtr# = writeWord8ArrayAsStablePtr# + +writeWord8ArrayAsInt16# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s +writeWord8ArrayAsInt16# = writeWord8ArrayAsInt16# + +writeWord8ArrayAsInt32# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s +writeWord8ArrayAsInt32# = writeWord8ArrayAsInt32# + +writeWord8ArrayAsInt64# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s +writeWord8ArrayAsInt64# = writeWord8ArrayAsInt64# + +writeWord8ArrayAsInt# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s +writeWord8ArrayAsInt# = writeWord8ArrayAsInt# + +writeWord8ArrayAsWord16# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s +writeWord8ArrayAsWord16# = writeWord8ArrayAsWord16# + +writeWord8ArrayAsWord32# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s +writeWord8ArrayAsWord32# = writeWord8ArrayAsWord32# + +writeWord8ArrayAsWord64# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s +writeWord8ArrayAsWord64# = writeWord8ArrayAsWord64# + +writeWord8ArrayAsWord# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s +writeWord8ArrayAsWord# = writeWord8ArrayAsWord# + -- |@compareByteArrays# src1 src1_ofs src2 src2_ofs n@ compares -- @n@ bytes starting at offset @src1_ofs@ in the first -- @ByteArray#@ @src1@ to the range of @n@ bytes @@ -3037,9 +3251,6 @@ catchSTM# :: (State# (RealWorld) -> (# State# (RealWorld),a #)) -> (b -> State# (RealWorld) -> (# State# (RealWorld),a #)) -> State# (RealWorld) -> (# State# (RealWorld),a #) catchSTM# = catchSTM# -check# :: (State# (RealWorld) -> (# State# (RealWorld),a #)) -> State# (RealWorld) -> State# (RealWorld) -check# = check# - -- |Create a new @TVar\#@ holding a specified initial value. newTVar# :: a -> State# s -> (# State# s,TVar# s a #) @@ -3364,7 +3575,7 @@ -- \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 +-- bad because that might mean x gets 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].) -- @@ -3413,13 +3624,12 @@ newBCO# :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s,BCO# #) newBCO# = newBCO# --- | @unpackClosure\# closure@ copies non-pointers and pointers in the +-- | @unpackClosure\# closure@ copies the closure 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. +-- the first word of the closure\'s info table, a non-pointer array for the raw +-- bytes of the closure, and a pointer array for the pointers in the payload. -unpackClosure# :: a -> (# Addr#,Array# b,ByteArray# #) +unpackClosure# :: a -> (# Addr#,ByteArray#,Array# b #) unpackClosure# = unpackClosure# getApStackVal# :: a -> Int# -> (# Int#,b #) @@ -3525,6 +3735,16 @@ traceMarker# :: Addr# -> State# s -> State# s traceMarker# = traceMarker# + +-- | Retrieves the allocation counter for the current thread. + +getThreadAllocationCounter# :: State# (RealWorld) -> (# State# (RealWorld),Int# #) +getThreadAllocationCounter# = getThreadAllocationCounter# + +-- | Sets the allocation counter for the current thread to the given value. + +setThreadAllocationCounter# :: Int# -> State# (RealWorld) -> State# (RealWorld) +setThreadAllocationCounter# = setThreadAllocationCounter# -- | The function @coerce@ allows you to safely convert between values of -- types that have the same representation with no run-time overhead. In the diff --git a/GHC/PrimopWrappers.hs b/GHC/PrimopWrappers.hs --- a/GHC/PrimopWrappers.hs +++ b/GHC/PrimopWrappers.hs @@ -114,6 +114,9 @@ {-# NOINLINE plusWord# #-} plusWord# :: Word# -> Word# -> Word# plusWord# a1 a2 = (GHC.Prim.plusWord#) a1 a2 +{-# NOINLINE addWordC# #-} +addWordC# :: Word# -> Word# -> (# Word#,Int# #) +addWordC# a1 a2 = (GHC.Prim.addWordC#) a1 a2 {-# NOINLINE subWordC# #-} subWordC# :: Word# -> Word# -> (# Word#,Int# #) subWordC# a1 a2 = (GHC.Prim.subWordC#) a1 a2 @@ -639,6 +642,48 @@ {-# NOINLINE indexWord64Array# #-} indexWord64Array# :: ByteArray# -> Int# -> Word# indexWord64Array# a1 a2 = (GHC.Prim.indexWord64Array#) a1 a2 +{-# NOINLINE indexWord8ArrayAsChar# #-} +indexWord8ArrayAsChar# :: ByteArray# -> Int# -> Char# +indexWord8ArrayAsChar# a1 a2 = (GHC.Prim.indexWord8ArrayAsChar#) a1 a2 +{-# NOINLINE indexWord8ArrayAsWideChar# #-} +indexWord8ArrayAsWideChar# :: ByteArray# -> Int# -> Char# +indexWord8ArrayAsWideChar# a1 a2 = (GHC.Prim.indexWord8ArrayAsWideChar#) a1 a2 +{-# NOINLINE indexWord8ArrayAsAddr# #-} +indexWord8ArrayAsAddr# :: ByteArray# -> Int# -> Addr# +indexWord8ArrayAsAddr# a1 a2 = (GHC.Prim.indexWord8ArrayAsAddr#) a1 a2 +{-# NOINLINE indexWord8ArrayAsFloat# #-} +indexWord8ArrayAsFloat# :: ByteArray# -> Int# -> Float# +indexWord8ArrayAsFloat# a1 a2 = (GHC.Prim.indexWord8ArrayAsFloat#) a1 a2 +{-# NOINLINE indexWord8ArrayAsDouble# #-} +indexWord8ArrayAsDouble# :: ByteArray# -> Int# -> Double# +indexWord8ArrayAsDouble# a1 a2 = (GHC.Prim.indexWord8ArrayAsDouble#) a1 a2 +{-# NOINLINE indexWord8ArrayAsStablePtr# #-} +indexWord8ArrayAsStablePtr# :: ByteArray# -> Int# -> StablePtr# a +indexWord8ArrayAsStablePtr# a1 a2 = (GHC.Prim.indexWord8ArrayAsStablePtr#) a1 a2 +{-# NOINLINE indexWord8ArrayAsInt16# #-} +indexWord8ArrayAsInt16# :: ByteArray# -> Int# -> Int# +indexWord8ArrayAsInt16# a1 a2 = (GHC.Prim.indexWord8ArrayAsInt16#) a1 a2 +{-# NOINLINE indexWord8ArrayAsInt32# #-} +indexWord8ArrayAsInt32# :: ByteArray# -> Int# -> Int# +indexWord8ArrayAsInt32# a1 a2 = (GHC.Prim.indexWord8ArrayAsInt32#) a1 a2 +{-# NOINLINE indexWord8ArrayAsInt64# #-} +indexWord8ArrayAsInt64# :: ByteArray# -> Int# -> Int# +indexWord8ArrayAsInt64# a1 a2 = (GHC.Prim.indexWord8ArrayAsInt64#) a1 a2 +{-# NOINLINE indexWord8ArrayAsInt# #-} +indexWord8ArrayAsInt# :: ByteArray# -> Int# -> Int# +indexWord8ArrayAsInt# a1 a2 = (GHC.Prim.indexWord8ArrayAsInt#) a1 a2 +{-# NOINLINE indexWord8ArrayAsWord16# #-} +indexWord8ArrayAsWord16# :: ByteArray# -> Int# -> Word# +indexWord8ArrayAsWord16# a1 a2 = (GHC.Prim.indexWord8ArrayAsWord16#) a1 a2 +{-# NOINLINE indexWord8ArrayAsWord32# #-} +indexWord8ArrayAsWord32# :: ByteArray# -> Int# -> Word# +indexWord8ArrayAsWord32# a1 a2 = (GHC.Prim.indexWord8ArrayAsWord32#) a1 a2 +{-# NOINLINE indexWord8ArrayAsWord64# #-} +indexWord8ArrayAsWord64# :: ByteArray# -> Int# -> Word# +indexWord8ArrayAsWord64# a1 a2 = (GHC.Prim.indexWord8ArrayAsWord64#) a1 a2 +{-# NOINLINE indexWord8ArrayAsWord# #-} +indexWord8ArrayAsWord# :: ByteArray# -> Int# -> Word# +indexWord8ArrayAsWord# a1 a2 = (GHC.Prim.indexWord8ArrayAsWord#) a1 a2 {-# NOINLINE readCharArray# #-} readCharArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Char# #) readCharArray# a1 a2 a3 = (GHC.Prim.readCharArray#) a1 a2 a3 @@ -687,6 +732,48 @@ {-# NOINLINE readWord64Array# #-} readWord64Array# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) readWord64Array# a1 a2 a3 = (GHC.Prim.readWord64Array#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsChar# #-} +readWord8ArrayAsChar# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Char# #) +readWord8ArrayAsChar# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsChar#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsWideChar# #-} +readWord8ArrayAsWideChar# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Char# #) +readWord8ArrayAsWideChar# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsWideChar#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsAddr# #-} +readWord8ArrayAsAddr# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Addr# #) +readWord8ArrayAsAddr# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsAddr#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsFloat# #-} +readWord8ArrayAsFloat# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Float# #) +readWord8ArrayAsFloat# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsFloat#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsDouble# #-} +readWord8ArrayAsDouble# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Double# #) +readWord8ArrayAsDouble# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsDouble#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsStablePtr# #-} +readWord8ArrayAsStablePtr# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,StablePtr# a #) +readWord8ArrayAsStablePtr# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsStablePtr#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsInt16# #-} +readWord8ArrayAsInt16# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Int# #) +readWord8ArrayAsInt16# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsInt16#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsInt32# #-} +readWord8ArrayAsInt32# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Int# #) +readWord8ArrayAsInt32# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsInt32#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsInt64# #-} +readWord8ArrayAsInt64# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Int# #) +readWord8ArrayAsInt64# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsInt64#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsInt# #-} +readWord8ArrayAsInt# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Int# #) +readWord8ArrayAsInt# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsInt#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsWord16# #-} +readWord8ArrayAsWord16# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) +readWord8ArrayAsWord16# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsWord16#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsWord32# #-} +readWord8ArrayAsWord32# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) +readWord8ArrayAsWord32# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsWord32#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsWord64# #-} +readWord8ArrayAsWord64# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) +readWord8ArrayAsWord64# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsWord64#) a1 a2 a3 +{-# NOINLINE readWord8ArrayAsWord# #-} +readWord8ArrayAsWord# :: MutableByteArray# s -> Int# -> State# s -> (# State# s,Word# #) +readWord8ArrayAsWord# a1 a2 a3 = (GHC.Prim.readWord8ArrayAsWord#) a1 a2 a3 {-# NOINLINE writeCharArray# #-} writeCharArray# :: MutableByteArray# s -> Int# -> Char# -> State# s -> State# s writeCharArray# a1 a2 a3 a4 = (GHC.Prim.writeCharArray#) a1 a2 a3 a4 @@ -735,6 +822,48 @@ {-# NOINLINE writeWord64Array# #-} writeWord64Array# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s writeWord64Array# a1 a2 a3 a4 = (GHC.Prim.writeWord64Array#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsChar# #-} +writeWord8ArrayAsChar# :: MutableByteArray# s -> Int# -> Char# -> State# s -> State# s +writeWord8ArrayAsChar# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsChar#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsWideChar# #-} +writeWord8ArrayAsWideChar# :: MutableByteArray# s -> Int# -> Char# -> State# s -> State# s +writeWord8ArrayAsWideChar# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsWideChar#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsAddr# #-} +writeWord8ArrayAsAddr# :: MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s +writeWord8ArrayAsAddr# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsAddr#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsFloat# #-} +writeWord8ArrayAsFloat# :: MutableByteArray# s -> Int# -> Float# -> State# s -> State# s +writeWord8ArrayAsFloat# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsFloat#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsDouble# #-} +writeWord8ArrayAsDouble# :: MutableByteArray# s -> Int# -> Double# -> State# s -> State# s +writeWord8ArrayAsDouble# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsDouble#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsStablePtr# #-} +writeWord8ArrayAsStablePtr# :: MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s +writeWord8ArrayAsStablePtr# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsStablePtr#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsInt16# #-} +writeWord8ArrayAsInt16# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s +writeWord8ArrayAsInt16# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsInt16#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsInt32# #-} +writeWord8ArrayAsInt32# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s +writeWord8ArrayAsInt32# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsInt32#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsInt64# #-} +writeWord8ArrayAsInt64# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s +writeWord8ArrayAsInt64# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsInt64#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsInt# #-} +writeWord8ArrayAsInt# :: MutableByteArray# s -> Int# -> Int# -> State# s -> State# s +writeWord8ArrayAsInt# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsInt#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsWord16# #-} +writeWord8ArrayAsWord16# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s +writeWord8ArrayAsWord16# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsWord16#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsWord32# #-} +writeWord8ArrayAsWord32# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s +writeWord8ArrayAsWord32# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsWord32#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsWord64# #-} +writeWord8ArrayAsWord64# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s +writeWord8ArrayAsWord64# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsWord64#) a1 a2 a3 a4 +{-# NOINLINE writeWord8ArrayAsWord# #-} +writeWord8ArrayAsWord# :: MutableByteArray# s -> Int# -> Word# -> State# s -> State# s +writeWord8ArrayAsWord# a1 a2 a3 a4 = (GHC.Prim.writeWord8ArrayAsWord#) a1 a2 a3 a4 {-# NOINLINE compareByteArrays# #-} compareByteArrays# :: ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# compareByteArrays# a1 a2 a3 a4 a5 = (GHC.Prim.compareByteArrays#) a1 a2 a3 a4 a5 @@ -1062,9 +1191,6 @@ {-# NOINLINE catchSTM# #-} catchSTM# :: (State# (RealWorld) -> (# State# (RealWorld),a #)) -> (b -> State# (RealWorld) -> (# State# (RealWorld),a #)) -> State# (RealWorld) -> (# State# (RealWorld),a #) catchSTM# a1 a2 a3 = (GHC.Prim.catchSTM#) a1 a2 a3 -{-# NOINLINE check# #-} -check# :: (State# (RealWorld) -> (# State# (RealWorld),a #)) -> State# (RealWorld) -> State# (RealWorld) -check# a1 a2 = (GHC.Prim.check#) a1 a2 {-# NOINLINE newTVar# #-} newTVar# :: a -> State# s -> (# State# s,TVar# s a #) newTVar# a1 a2 = (GHC.Prim.newTVar#) a1 a2 @@ -1246,7 +1372,7 @@ newBCO# :: ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s,BCO# #) newBCO# a1 a2 a3 a4 a5 a6 = (GHC.Prim.newBCO#) a1 a2 a3 a4 a5 a6 {-# NOINLINE unpackClosure# #-} -unpackClosure# :: a -> (# Addr#,Array# b,ByteArray# #) +unpackClosure# :: a -> (# Addr#,ByteArray#,Array# b #) unpackClosure# a1 = (GHC.Prim.unpackClosure#) a1 {-# NOINLINE getApStackVal# #-} getApStackVal# :: a -> Int# -> (# Int#,b #) @@ -1266,6 +1392,12 @@ {-# NOINLINE traceMarker# #-} traceMarker# :: Addr# -> State# s -> State# s traceMarker# a1 a2 = (GHC.Prim.traceMarker#) a1 a2 +{-# NOINLINE getThreadAllocationCounter# #-} +getThreadAllocationCounter# :: State# (RealWorld) -> (# State# (RealWorld),Int# #) +getThreadAllocationCounter# a1 = (GHC.Prim.getThreadAllocationCounter#) a1 +{-# NOINLINE setThreadAllocationCounter# #-} +setThreadAllocationCounter# :: Int# -> State# (RealWorld) -> State# (RealWorld) +setThreadAllocationCounter# a1 a2 = (GHC.Prim.setThreadAllocationCounter#) a1 a2 {-# NOINLINE prefetchByteArray3# #-} prefetchByteArray3# :: ByteArray# -> Int# -> State# s -> State# s prefetchByteArray3# a1 a2 a3 = (GHC.Prim.prefetchByteArray3#) a1 a2 a3 diff --git a/GHC/Types.hs b/GHC/Types.hs --- a/GHC/Types.hs +++ b/GHC/Types.hs @@ -32,7 +32,7 @@ Nat, Symbol, Any, type (~~), Coercible, - TYPE, RuntimeRep(..), Type, type (*), type (★), Constraint, + TYPE, RuntimeRep(..), Type, Constraint, -- The historical type * should ideally be written as -- `type *`, without the parentheses. But that's a true -- pain to parse, and for little gain. @@ -59,12 +59,6 @@ -- | The kind of types with values. For example @Int :: Type@. type Type = TYPE 'LiftedRep --- | A backward-compatible (pre-GHC 8.0) synonym for 'Type' -type * = TYPE 'LiftedRep - --- | A unicode backward-compatible (pre-GHC 8.0) synonym for 'Type' -type ★ = TYPE 'LiftedRep - {- ********************************************************************* * * Nat and Symbol @@ -260,7 +254,7 @@ -- @type role Set nominal@ -- -- For more details about this feature, please refer to --- +-- -- by Joachim Breitner, Richard A. Eisenberg, Simon Peyton Jones and Stephanie Weirich. -- -- @since 4.7.0.0 diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,88 +1,2 @@ - --- We need to do some ugly hacks here because of GHC magic - -module Main (main) where - -import Control.Monad -import Data.List -import Data.Maybe -import Distribution.PackageDescription import Distribution.Simple -import Distribution.Simple.LocalBuildInfo -import Distribution.Simple.Program -import Distribution.Simple.Utils -import Distribution.Text -import System.Cmd -import System.FilePath -import System.Exit -import System.Directory - -main :: IO () -main = do let hooks = simpleUserHooks { - regHook = addPrimModule - $ regHook simpleUserHooks, - buildHook = build_primitive_sources - $ buildHook simpleUserHooks, - haddockHook = addPrimModuleForHaddock - $ build_primitive_sources - $ haddockHook simpleUserHooks } - defaultMainWithHooks hooks - -type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO () - -addPrimModule :: Hook a -> Hook a -addPrimModule f pd lbi uhs x = - do let -- I'm not sure which one of these we actually need to change. - -- It seems bad that there are two. - pd' = addPrimModuleToPD pd - lpd = addPrimModuleToPD (localPkgDescr lbi) - lbi' = lbi { localPkgDescr = lpd } - f pd' lbi' uhs x - -addPrimModuleForHaddock :: Hook a -> Hook a -addPrimModuleForHaddock f pd lbi uhs x = - do let pc = withPrograms lbi - pc' = userSpecifyArgs "haddock" ["GHC/Prim.hs"] pc - lbi' = lbi { withPrograms = pc' } - f pd lbi' uhs x - -addPrimModuleToPD :: PackageDescription -> PackageDescription -addPrimModuleToPD pd = - case library pd of - Just lib -> - let ems = fromJust (simpleParse "GHC.Prim") : exposedModules lib - lib' = lib { exposedModules = ems } - in pd { library = Just lib' } - Nothing -> - error "Expected a library, but none found" - -build_primitive_sources :: Hook a -> Hook a -build_primitive_sources f pd lbi uhs x - = do when (compilerFlavor (compiler lbi) == GHC) $ do - let genprimopcode = joinPath ["..", "..", "utils", - "genprimopcode", "genprimopcode"] - primops = joinPath ["..", "..", "compiler", "prelude", - "primops.txt"] - primhs = joinPath ["GHC", "Prim.hs"] - primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"] - primhs_tmp = addExtension primhs "tmp" - primopwrappers_tmp = addExtension primopwrappers "tmp" - maybeExit $ system (genprimopcode ++ " --make-haskell-source < " - ++ primops ++ " > " ++ primhs_tmp) - maybeUpdateFile primhs_tmp primhs - maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < " - ++ primops ++ " > " ++ primopwrappers_tmp) - maybeUpdateFile primopwrappers_tmp primopwrappers - f pd lbi uhs x - --- Replace a file only if the new version is different from the old. --- This prevents make from doing unnecessary work after we run 'setup makefile' -maybeUpdateFile :: FilePath -> FilePath -> IO () -maybeUpdateFile source target = do - r <- rawSystem "cmp" ["-s" {-quiet-}, source, target] - case r of - ExitSuccess -> removeFile source - ExitFailure _ -> do exists <- doesFileExist target - when exists $ removeFile target - renameFile source target - +main = defaultMain diff --git a/cbits/atomic.c b/cbits/atomic.c --- a/cbits/atomic.c +++ b/cbits/atomic.c @@ -107,7 +107,44 @@ // FetchNandByteArrayOp_Int -// Workaround for http://llvm.org/bugs/show_bug.cgi?id=8842 +// Note [__sync_fetch_and_nand usage] +// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +// +// The __sync_fetch_and_nand builtin is a bit of a disaster. It was introduced +// in GCC long ago with silly semantics. Specifically: +// +// *ptr = ~(tmp & value) +// +// Clang introduced the builtin with the same semantics. +// +// In GCC 4.4 the operation's semantics were rightly changed to, +// +// *ptr = ~tmp & value +// +// and the -Wsync-nand warning was added warning users of the operation about +// the change. +// +// Clang took this change as a reason to remove support for the +// builtin in 2010. Then, in 2014 Clang re-added support with the new +// semantics. However, the warning flag was given a different name +// (-Wsync-fetch-and-nand-semantics-changed) for added fun. +// +// Consequently, we are left with a bit of a mess: GHC requires GCC >4.4 +// (enforced by the FP_GCC_VERSION autoconf check), so we thankfully don't need +// to support the operation's older broken semantics. However, we need to take +// care to explicitly disable -Wsync-nand wherever possible, lest the build +// fails with -Werror. Furthermore, we need to emulate the operation when +// building with some Clang versions (shipped by some Mac OS X releases) which +// lack support for the builtin. +// +// In the words of Bob Dylan: everything is broken. +// +// See also: +// +// * https://bugs.llvm.org/show_bug.cgi?id=8842 +// * https://ghc.haskell.org/trac/ghc/ticket/9678 +// + #define CAS_NAND(x, val) \ { \ __typeof__ (*(x)) tmp = *(x); \ @@ -117,14 +154,33 @@ return tmp; \ } +// N.B. __has_builtin is only provided by clang +#if !defined(__has_builtin) +#define __has_builtin(x) 0 +#endif + +#if defined(__clang__) && !__has_builtin(__sync_fetch_and_nand) +#define USE_SYNC_FETCH_AND_NAND 0 +#else +#define USE_SYNC_FETCH_AND_NAND 1 +#endif + +// Otherwise this fails with -Werror +#pragma GCC diagnostic push +#if defined(__clang__) +#pragma GCC diagnostic ignored "-Wsync-fetch-and-nand-semantics-changed" +#elif defined(__GNUC__) +#pragma GCC diagnostic ignored "-Wsync-nand" +#endif + extern StgWord hs_atomic_nand8(StgWord x, StgWord val); StgWord hs_atomic_nand8(StgWord x, StgWord val) { -#ifdef __clang__ - CAS_NAND((volatile StgWord8 *) x, (StgWord8) val) -#else +#if USE_SYNC_FETCH_AND_NAND return __sync_fetch_and_nand((volatile StgWord8 *) x, (StgWord8) val); +#else + CAS_NAND((volatile StgWord8 *) x, (StgWord8) val) #endif } @@ -132,10 +188,10 @@ StgWord hs_atomic_nand16(StgWord x, StgWord val) { -#ifdef __clang__ - CAS_NAND((volatile StgWord16 *) x, (StgWord16) val); -#else +#if USE_SYNC_FETCH_AND_NAND return __sync_fetch_and_nand((volatile StgWord16 *) x, (StgWord16) val); +#else + CAS_NAND((volatile StgWord16 *) x, (StgWord16) val); #endif } @@ -143,10 +199,10 @@ StgWord hs_atomic_nand32(StgWord x, StgWord val) { -#ifdef __clang__ - CAS_NAND((volatile StgWord32 *) x, (StgWord32) val); -#else +#if USE_SYNC_FETCH_AND_NAND return __sync_fetch_and_nand((volatile StgWord32 *) x, (StgWord32) val); +#else + CAS_NAND((volatile StgWord32 *) x, (StgWord32) val); #endif } @@ -155,13 +211,15 @@ StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val) { -#ifdef __clang__ - CAS_NAND((volatile StgWord64 *) x, val); -#else +#if USE_SYNC_FETCH_AND_NAND return __sync_fetch_and_nand((volatile StgWord64 *) x, val); +#else + CAS_NAND((volatile StgWord64 *) x, val); #endif } #endif + +#pragma GCC diagnostic pop // FetchOrByteArrayOp_Int diff --git a/cbits/ctz.c b/cbits/ctz.c --- a/cbits/ctz.c +++ b/cbits/ctz.c @@ -36,7 +36,7 @@ get inlined by GCC but rather a short `__ctzdi2` runtime function is inserted when needed into compiled object files. - This workaround forces GCC on 32bit x86 to to express `hs_ctz64` in + This workaround forces GCC on 32bit x86 to express `hs_ctz64` in terms of the 32bit `__builtin_ctz()` (this is no loss, as there's no 64bit BSF instruction on i686 anyway) and thus avoid the problematic out-of-line runtime function. diff --git a/cbits/pdep.c b/cbits/pdep.c --- a/cbits/pdep.c +++ b/cbits/pdep.c @@ -1,8 +1,6 @@ #include "Rts.h" #include "MachDeps.h" -extern StgWord64 hs_pdep64(StgWord64 src, StgWord64 mask); - StgWord64 hs_pdep64(StgWord64 src, StgWord64 mask) { @@ -26,21 +24,18 @@ return result; } -extern StgWord hs_pdep32(StgWord src, StgWord mask); StgWord hs_pdep32(StgWord src, StgWord mask) { return hs_pdep64(src, mask); } -extern StgWord hs_pdep16(StgWord src, StgWord mask); StgWord hs_pdep16(StgWord src, StgWord mask) { return hs_pdep64(src, mask); } -extern StgWord hs_pdep8(StgWord src, StgWord mask); StgWord hs_pdep8(StgWord src, StgWord mask) { diff --git a/cbits/pext.c b/cbits/pext.c --- a/cbits/pext.c +++ b/cbits/pext.c @@ -1,8 +1,6 @@ #include "Rts.h" #include "MachDeps.h" -extern StgWord64 hs_pext64(StgWord64 src, StgWord64 mask); - StgWord64 hs_pext64(StgWord64 src, StgWord64 mask) { @@ -22,21 +20,18 @@ return result; } -extern StgWord hs_pext32(StgWord src, StgWord mask); StgWord hs_pext32(StgWord src, StgWord mask) { return hs_pext64(src, mask); } -extern StgWord hs_pext16(StgWord src, StgWord mask); StgWord hs_pext16(StgWord src, StgWord mask) { return hs_pext64(src, mask); } -extern StgWord hs_pext8(StgWord src, StgWord mask); StgWord hs_pext8(StgWord src, StgWord mask) { diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,4 +1,15 @@ -## 0.5.2.0 +## 0.5.3 *August 2018* + +- Shipped with GHC 8.6.1 + +- Added to `GHC.Prim`: + addWordC# :: Word# -> Word# -> (# Word#, Int# #) + +- `unpackClosure#` can now unpack any valid Haskell closure. + Previously it returned empty pointer and non-pointer arrays + for thunks. + +## 0.5.2.0 *March 2018* - Shipped with GHC 8.4.1 diff --git a/ghc-prim.cabal b/ghc-prim.cabal --- a/ghc-prim.cabal +++ b/ghc-prim.cabal @@ -1,7 +1,6 @@ cabal-version: 2.2 name: ghc-prim -version: 0.5.2.0 - +version: 0.5.3 license: BSD-3-Clause license-file: LICENSE category: GHC