[Git][ghc/ghc][wip/int64-everywhere] 2 commits: Make fixed-size `Int32#` and `Int64#`
John Ericson
gitlab at gitlab.haskell.org
Mon Jul 6 18:41:38 UTC 2020
John Ericson pushed to branch wip/int64-everywhere at Glasgow Haskell Compiler / GHC
Commits:
753932b2 by John Ericson at 2020-07-06T14:40:32-04:00
Make fixed-size `Int32#` and `Int64#`
The boxed Int64 uses Int64#, but Int32# still uses Int#. The 32-bit case
is less pressing to change because it is not a source of brittle
CPP---it is the same thing on all platforms.
We need Int64/Word64 constant folding to avoid the let/app restriction on Core, so
that is implemented now. 32-bit constant unfolding and 32-bit literals
are left as follow-up.
This is the bulk of #11953
- - - - -
8d518022 by John Ericson at 2020-07-06T14:40:57-04:00
Inline INT64 and WORD64 macros in primops.txt.pp
The definition is now unconditional so there is no reason for that CPP.
- - - - -
28 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Utils/Outputable.hs
- includes/stg/Prim.h
- libraries/base/GHC/Exts.hs
- libraries/base/GHC/Float.hs
- libraries/base/GHC/Float/ConversionUtils.hs
- libraries/base/GHC/Float/RealFracMethods.hs
- libraries/base/GHC/Int.hs
- libraries/base/GHC/StaticPtr.hs
- libraries/base/GHC/Word.hs
- libraries/binary
- libraries/bytestring
- libraries/ghc-bignum/src/GHC/Num/BigNat.hs
- libraries/ghc-bignum/src/GHC/Num/Integer.hs
- libraries/ghc-prim/GHC/Classes.hs
- − libraries/ghc-prim/GHC/IntWord64.hs
- libraries/ghc-prim/GHC/Prim/Ext.hs
- libraries/ghc-prim/GHC/Types.hs
- libraries/ghc-prim/cbits/atomic.c
- − libraries/ghc-prim/cbits/longlong.c
- libraries/ghc-prim/ghc-prim.cabal
- rts/package.conf.in
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -62,8 +62,8 @@
-- 3-tuple in the list of 3-tuples. That is, the vector attribute allows us to
-- define a family of types or primops. Vector support also adds three new
-- keywords: VECTOR, SCALAR, and VECTUPLE. These keywords are expanded to types
--- derived from the 3-tuple. For the 3-tuple <Int64,INT64,2>, VECTOR expands to
--- Int64X2#, SCALAR expands to INT64, and VECTUPLE expands to (# INT64, INT64
+-- derived from the 3-tuple. For the 3-tuple <Int64,Int64#,2>, VECTOR expands to
+-- Int64X2#, SCALAR expands to Int64#, and VECTUPLE expands to (# Int64#, Int64#
-- #).
defaults
@@ -118,8 +118,6 @@ defaults
-- description fields should be legal latex. Descriptions can contain
-- matched pairs of embedded curly brackets.
-#include "MachDeps.h"
-
section "The word size story."
{Haskell98 specifies that signed integers (type {\tt Int})
must contain at least 30 bits. GHC always implements {\tt
@@ -141,22 +139,12 @@ section "The word size story."
In addition, GHC supports families of explicit-sized integers
and words at 8, 16, 32, and 64 bits, with the usual
arithmetic operations, comparisons, and a range of
- conversions. The 8-bit and 16-bit sizes are always
+ conversions. The fixed-size integers and words are always
represented as {\tt Int\#} and {\tt Word\#}, and the
operations implemented in terms of the primops on these
types, with suitable range restrictions on the results (using
- the {\tt narrow$n$Int\#} and {\tt narrow$n$Word\#} families
- of primops. The 32-bit sizes are represented using {\tt
- Int\#} and {\tt Word\#} when {\tt WORD\_SIZE\_IN\_BITS}
- $\geq$ 32; otherwise, these are represented using distinct
- primitive types {\tt Int32\#} and {\tt Word32\#}. These (when
- needed) have a complete set of corresponding operations;
- however, nearly all of these are implemented as external C
- functions rather than as primops. Exactly the same story
- applies to the 64-bit sizes. All of these details are hidden
- under the {\tt PrelInt} and {\tt PrelWord} modules, which use
- {\tt \#if}-defs to invoke the appropriate types and
- operators.
+ the {\tt intToInt$n$\#} and {\tt wordToWord$n$\#} families of
+ primops.
Word size also matters for the families of primops for
indexing/reading/writing fixed-size quantities at offsets
@@ -179,18 +167,11 @@ section "The word size story."
so are not available in this case. }
-- Define synonyms for indexing ops.
+-- TODO use Int32# once we have `data Int<N> = I<N># Int<N>#` for all N.
#define INT32 Int#
#define WORD32 Word#
-#if WORD_SIZE_IN_BITS < 64
-#define INT64 Int64#
-#define WORD64 Word64#
-#else
-#define INT64 Int#
-#define WORD64 Word#
-#endif
-
-- This type won't be exported directly (since there is no concrete
-- syntax for this sort of export) so we'll have to manually patch
-- export lists in both GHC and Haddock.
@@ -235,8 +216,8 @@ section "Int8#"
primtype Int8#
-primop Int8Extend "extendInt8#" GenPrimOp Int8# -> Int#
-primop Int8Narrow "narrowInt8#" GenPrimOp Int# -> Int8#
+primop Int8ToInt "int8ToInt#" GenPrimOp Int8# -> Int#
+primop IntToInt8 "intToInt8#" GenPrimOp Int# -> Int8#
primop Int8NegOp "negateInt8#" Monadic Int8# -> Int8#
@@ -271,13 +252,13 @@ primop Int8NeOp "neInt8#" Compare Int8# -> Int8# -> Int#
------------------------------------------------------------------------
section "Word8#"
- {Operations on 8-bit unsigned integers.}
+ {Operations on 8-bit unsigned words.}
------------------------------------------------------------------------
primtype Word8#
-primop Word8Extend "extendWord8#" GenPrimOp Word8# -> Word#
-primop Word8Narrow "narrowWord8#" GenPrimOp Word# -> Word8#
+primop Word8ToWord "word8ToWord#" GenPrimOp Word8# -> Word#
+primop WordToWord8 "wordToWord8#" GenPrimOp Word# -> Word8#
primop Word8NotOp "notWord8#" Monadic Word8# -> Word8#
@@ -317,8 +298,8 @@ section "Int16#"
primtype Int16#
-primop Int16Extend "extendInt16#" GenPrimOp Int16# -> Int#
-primop Int16Narrow "narrowInt16#" GenPrimOp Int# -> Int16#
+primop Int16ToInt "int16ToInt#" GenPrimOp Int16# -> Int#
+primop IntToInt16 "intToInt16#" GenPrimOp Int# -> Int16#
primop Int16NegOp "negateInt16#" Monadic Int16# -> Int16#
@@ -353,13 +334,13 @@ primop Int16NeOp "neInt16#" Compare Int16# -> Int16# -> Int#
------------------------------------------------------------------------
section "Word16#"
- {Operations on 16-bit unsigned integers.}
+ {Operations on 16-bit unsigned words.}
------------------------------------------------------------------------
primtype Word16#
-primop Word16Extend "extendWord16#" GenPrimOp Word16# -> Word#
-primop Word16Narrow "narrowWord16#" GenPrimOp Word# -> Word16#
+primop Word16ToWord "word16ToWord#" GenPrimOp Word16# -> Word#
+primop WordToWord16 "wordToWord16#" GenPrimOp Word# -> Word16#
primop Word16NotOp "notWord16#" Monadic Word16# -> Word16#
@@ -392,26 +373,213 @@ primop Word16LeOp "leWord16#" Compare Word16# -> Word16# -> Int#
primop Word16LtOp "ltWord16#" Compare Word16# -> Word16# -> Int#
primop Word16NeOp "neWord16#" Compare Word16# -> Word16# -> Int#
-#if WORD_SIZE_IN_BITS < 64
+------------------------------------------------------------------------
+section "Int32#"
+ {Operations on 32-bit integers.}
+------------------------------------------------------------------------
+
+primtype Int32#
+
+primop Int32ToInt "int32ToInt#" GenPrimOp Int32# -> Int#
+primop IntToInt32 "intToInt32#" GenPrimOp Int# -> Int32#
+
+primop Int32NegOp "negateInt32#" Monadic Int32# -> Int32#
+
+primop Int32AddOp "plusInt32#" Dyadic Int32# -> Int32# -> Int32#
+ with
+ commutable = True
+
+primop Int32SubOp "subInt32#" Dyadic Int32# -> Int32# -> Int32#
+
+primop Int32MulOp "timesInt32#" Dyadic Int32# -> Int32# -> Int32#
+ with
+ commutable = True
+
+primop Int32QuotOp "quotInt32#" Dyadic Int32# -> Int32# -> Int32#
+ with
+ can_fail = True
+
+primop Int32RemOp "remInt32#" Dyadic Int32# -> Int32# -> Int32#
+ with
+ can_fail = True
+
+primop Int32QuotRemOp "quotRemInt32#" GenPrimOp Int32# -> Int32# -> (# Int32#, Int32# #)
+ with
+ can_fail = True
+
+primop Int32SllOp "uncheckedIShiftL32#" GenPrimOp Int32# -> Int# -> Int32#
+primop Int32SraOp "uncheckedIShiftRA32#" GenPrimOp Int32# -> Int# -> Int32#
+primop Int32SrlOp "uncheckedIShiftRL32#" GenPrimOp Int32# -> Int# -> Int32#
+
+primop Int32ToWord32Op "int32ToWord32#" GenPrimOp Int32# -> Word32#
+ with code_size = 0
+
+primop Int32EqOp "eqInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32GeOp "geInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32GtOp "gtInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32LeOp "leInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32LtOp "ltInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32NeOp "neInt32#" Compare Int32# -> Int32# -> Int#
+
+------------------------------------------------------------------------
+section "Word32#"
+ {Operations on 32-bit unsigned words.}
+------------------------------------------------------------------------
+
+primtype Word32#
+
+primop Word32ToWord "word32ToWord#" GenPrimOp Word32# -> Word#
+primop WordToWord32 "wordToWord32#" GenPrimOp Word# -> Word32#
+
+primop Word32AddOp "plusWord32#" Dyadic Word32# -> Word32# -> Word32#
+ with
+ commutable = True
+
+primop Word32SubOp "subWord32#" Dyadic Word32# -> Word32# -> Word32#
+
+primop Word32MulOp "timesWord32#" Dyadic Word32# -> Word32# -> Word32#
+ with
+ commutable = True
+
+primop Word32QuotOp "quotWord32#" Dyadic Word32# -> Word32# -> Word32#
+ with
+ can_fail = True
+
+primop Word32RemOp "remWord32#" Dyadic Word32# -> Word32# -> Word32#
+ with
+ can_fail = True
+
+primop Word32QuotRemOp "quotRemWord32#" GenPrimOp Word32# -> Word32# -> (# Word32#, Word32# #)
+ with
+ can_fail = True
+
+primop Word32AndOp "and32#" Dyadic Word32# -> Word32# -> Word32#
+ with commutable = True
+
+primop Word32OrOp "or32#" Dyadic Word32# -> Word32# -> Word32#
+ with commutable = True
+
+primop Word32XorOp "xor32#" Dyadic Word32# -> Word32# -> Word32#
+ with commutable = True
+
+primop Word32NotOp "not32#" Monadic Word32# -> Word32#
+
+primop Word32SllOp "uncheckedShiftL32#" GenPrimOp Word32# -> Int# -> Word32#
+primop Word32SrlOp "uncheckedShiftRL32#" GenPrimOp Word32# -> Int# -> Word32#
+
+primop Word32ToInt32Op "word32ToInt32#" GenPrimOp Word32# -> Int32#
+ with code_size = 0
+
+primop Word32EqOp "eqWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32GeOp "geWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32GtOp "gtWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32LeOp "leWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32LtOp "ltWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32NeOp "neWord32#" Compare Word32# -> Word32# -> Int#
+
------------------------------------------------------------------------
section "Int64#"
- {Operations on 64-bit unsigned words. This type is only used
- if plain {\tt Int\#} has less than 64 bits. In any case, the operations
- are not primops; they are implemented (if needed) as ccalls instead.}
+ {Operations on 64-bit integers.}
------------------------------------------------------------------------
primtype Int64#
+primop Int64ToInt "int64ToInt#" GenPrimOp Int64# -> Int#
+primop IntToInt64 "intToInt64#" GenPrimOp Int# -> Int64#
+
+primop Int64NegOp "negateInt64#" Monadic Int64# -> Int64#
+
+primop Int64AddOp "plusInt64#" Dyadic Int64# -> Int64# -> Int64#
+ with
+ commutable = True
+
+primop Int64SubOp "subInt64#" Dyadic Int64# -> Int64# -> Int64#
+
+primop Int64MulOp "timesInt64#" Dyadic Int64# -> Int64# -> Int64#
+ with
+ commutable = True
+
+primop Int64QuotOp "quotInt64#" Dyadic Int64# -> Int64# -> Int64#
+ with
+ can_fail = True
+
+primop Int64RemOp "remInt64#" Dyadic Int64# -> Int64# -> Int64#
+ with
+ can_fail = True
+
+primop Int64QuotRemOp "quotRemInt64#" GenPrimOp Int64# -> Int64# -> (# Int64#, Int64# #)
+ with
+ can_fail = True
+
+primop Int64SllOp "uncheckedIShiftL64#" GenPrimOp Int64# -> Int# -> Int64#
+primop Int64SraOp "uncheckedIShiftRA64#" GenPrimOp Int64# -> Int# -> Int64#
+primop Int64SrlOp "uncheckedIShiftRL64#" GenPrimOp Int64# -> Int# -> Int64#
+
+primop Int64ToWord64Op "int64ToWord64#" GenPrimOp Int64# -> Word64#
+ with code_size = 0
+
+primop Int64EqOp "eqInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64GeOp "geInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64GtOp "gtInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64LeOp "leInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64LtOp "ltInt64#" Compare Int64# -> Int64# -> Int#
+primop Int64NeOp "neInt64#" Compare Int64# -> Int64# -> Int#
+
------------------------------------------------------------------------
section "Word64#"
- {Operations on 64-bit unsigned words. This type is only used
- if plain {\tt Word\#} has less than 64 bits. In any case, the operations
- are not primops; they are implemented (if needed) as ccalls instead.}
+ {Operations on 64-bit unsigned words.}
------------------------------------------------------------------------
primtype Word64#
-#endif
+primop Word64ToWord "word64ToWord#" GenPrimOp Word64# -> Word#
+primop WordToWord64 "wordToWord64#" GenPrimOp Word# -> Word64#
+
+primop Word64AddOp "plusWord64#" Dyadic Word64# -> Word64# -> Word64#
+ with
+ commutable = True
+
+primop Word64SubOp "subWord64#" Dyadic Word64# -> Word64# -> Word64#
+
+primop Word64MulOp "timesWord64#" Dyadic Word64# -> Word64# -> Word64#
+ with
+ commutable = True
+
+primop Word64QuotOp "quotWord64#" Dyadic Word64# -> Word64# -> Word64#
+ with
+ can_fail = True
+
+primop Word64RemOp "remWord64#" Dyadic Word64# -> Word64# -> Word64#
+ with
+ can_fail = True
+
+primop Word64QuotRemOp "quotRemWord64#" GenPrimOp Word64# -> Word64# -> (# Word64#, Word64# #)
+ with
+ can_fail = True
+
+primop Word64AndOp "and64#" Dyadic Word64# -> Word64# -> Word64#
+ with commutable = True
+
+primop Word64OrOp "or64#" Dyadic Word64# -> Word64# -> Word64#
+ with commutable = True
+
+primop Word64XorOp "xor64#" Dyadic Word64# -> Word64# -> Word64#
+ with commutable = True
+
+primop Word64NotOp "not64#" Monadic Word64# -> Word64#
+
+primop Word64SllOp "uncheckedShiftL64#" GenPrimOp Word64# -> Int# -> Word64#
+primop Word64SrlOp "uncheckedShiftRL64#" GenPrimOp Word64# -> Int# -> Word64#
+
+primop Word64ToInt64Op "word64ToInt64#" GenPrimOp Word64# -> Int64#
+ with code_size = 0
+
+primop Word64EqOp "eqWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64GeOp "geWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64GtOp "gtWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64LeOp "leWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64LtOp "ltWord64#" Compare Word64# -> Word64# -> Int#
+primop Word64NeOp "neWord64#" Compare Word64# -> Word64# -> Int#
------------------------------------------------------------------------
section "Int#"
@@ -484,19 +652,19 @@ primop IntQuotRemOp "quotRemInt#" GenPrimOp
{Rounds towards zero.}
with can_fail = True
-primop AndIOp "andI#" Dyadic Int# -> Int# -> Int#
+primop IntAndOp "andI#" Dyadic Int# -> Int# -> Int#
{Bitwise "and".}
with commutable = True
-primop OrIOp "orI#" Dyadic Int# -> Int# -> Int#
+primop IntOrOp "orI#" Dyadic Int# -> Int# -> Int#
{Bitwise "or".}
with commutable = True
-primop XorIOp "xorI#" Dyadic Int# -> Int# -> Int#
+primop IntXorOp "xorI#" Dyadic Int# -> Int# -> Int#
{Bitwise "xor".}
with commutable = True
-primop NotIOp "notI#" Monadic Int# -> Int#
+primop IntNotOp "notI#" Monadic Int# -> Int#
{Bitwise "not", also known as the binary complement.}
primop IntNegOp "negateInt#" Monadic Int# -> Int#
@@ -556,13 +724,13 @@ primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double#
primop Word2FloatOp "word2Float#" GenPrimOp Word# -> Float#
primop Word2DoubleOp "word2Double#" GenPrimOp Word# -> Double#
-primop ISllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int#
+primop IntSllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int#
{Shift left. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
-primop ISraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
+primop IntSraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
{Shift right arithmetic. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
-primop ISrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
+primop IntSrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
{Shift right logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
@@ -622,21 +790,21 @@ primop WordQuotRem2Op "quotRemWord2#" GenPrimOp
Requires that high word < divisor.}
with can_fail = True
-primop AndOp "and#" Dyadic Word# -> Word# -> Word#
+primop WordAndOp "and#" Dyadic Word# -> Word# -> Word#
with commutable = True
-primop OrOp "or#" Dyadic Word# -> Word# -> Word#
+primop WordOrOp "or#" Dyadic Word# -> Word# -> Word#
with commutable = True
-primop XorOp "xor#" Dyadic Word# -> Word# -> Word#
+primop WordXorOp "xor#" Dyadic Word# -> Word# -> Word#
with commutable = True
-primop NotOp "not#" Monadic Word# -> Word#
+primop WordNotOp "not#" Monadic Word# -> Word#
-primop SllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word#
+primop WordSllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word#
{Shift left logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
-primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
+primop WordSrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
{Shift right logical. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
@@ -656,7 +824,7 @@ primop PopCnt16Op "popCnt16#" Monadic Word# -> Word#
{Count the number of set bits in the lower 16 bits of a word.}
primop PopCnt32Op "popCnt32#" Monadic Word# -> Word#
{Count the number of set bits in the lower 32 bits of a word.}
-primop PopCnt64Op "popCnt64#" GenPrimOp WORD64 -> Word#
+primop PopCnt64Op "popCnt64#" GenPrimOp Word64# -> Word#
{Count the number of set bits in a 64-bit word.}
primop PopCntOp "popCnt#" Monadic Word# -> Word#
{Count the number of set bits in a word.}
@@ -667,7 +835,7 @@ primop Pdep16Op "pdep16#" Dyadic Word# -> Word# -> Word#
{Deposit bits to lower 16 bits of a word at locations specified by a mask.}
primop Pdep32Op "pdep32#" Dyadic Word# -> Word# -> Word#
{Deposit bits to lower 32 bits of a word at locations specified by a mask.}
-primop Pdep64Op "pdep64#" GenPrimOp WORD64 -> WORD64 -> WORD64
+primop Pdep64Op "pdep64#" GenPrimOp Word64# -> Word64# -> Word64#
{Deposit bits to a word at locations specified by a mask.}
primop PdepOp "pdep#" Dyadic Word# -> Word# -> Word#
{Deposit bits to a word at locations specified by a mask.}
@@ -678,7 +846,7 @@ primop Pext16Op "pext16#" Dyadic Word# -> Word# -> Word#
{Extract bits from lower 16 bits of a word at locations specified by a mask.}
primop Pext32Op "pext32#" Dyadic Word# -> Word# -> Word#
{Extract bits from lower 32 bits of a word at locations specified by a mask.}
-primop Pext64Op "pext64#" GenPrimOp WORD64 -> WORD64 -> WORD64
+primop Pext64Op "pext64#" GenPrimOp Word64# -> Word64# -> Word64#
{Extract bits from a word at locations specified by a mask.}
primop PextOp "pext#" Dyadic Word# -> Word# -> Word#
{Extract bits from a word at locations specified by a mask.}
@@ -689,7 +857,7 @@ primop Clz16Op "clz16#" Monadic Word# -> Word#
{Count leading zeros in the lower 16 bits of a word.}
primop Clz32Op "clz32#" Monadic Word# -> Word#
{Count leading zeros in the lower 32 bits of a word.}
-primop Clz64Op "clz64#" GenPrimOp WORD64 -> Word#
+primop Clz64Op "clz64#" GenPrimOp Word64# -> Word#
{Count leading zeros in a 64-bit word.}
primop ClzOp "clz#" Monadic Word# -> Word#
{Count leading zeros in a word.}
@@ -700,7 +868,7 @@ primop Ctz16Op "ctz16#" Monadic Word# -> Word#
{Count trailing zeros in the lower 16 bits of a word.}
primop Ctz32Op "ctz32#" Monadic Word# -> Word#
{Count trailing zeros in the lower 32 bits of a word.}
-primop Ctz64Op "ctz64#" GenPrimOp WORD64 -> Word#
+primop Ctz64Op "ctz64#" GenPrimOp Word64# -> Word#
{Count trailing zeros in a 64-bit word.}
primop CtzOp "ctz#" Monadic Word# -> Word#
{Count trailing zeros in a word.}
@@ -709,7 +877,7 @@ primop BSwap16Op "byteSwap16#" Monadic Word# -> Word#
{Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. }
primop BSwap32Op "byteSwap32#" Monadic Word# -> Word#
{Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. }
-primop BSwap64Op "byteSwap64#" Monadic WORD64 -> WORD64
+primop BSwap64Op "byteSwap64#" Monadic Word64# -> Word64#
{Swap bytes in a 64 bits of a word.}
primop BSwapOp "byteSwap#" Monadic Word# -> Word#
{Swap bytes in a word.}
@@ -720,7 +888,7 @@ primop BRev16Op "bitReverse16#" Monadic Word# -> Word#
{Reverse the order of the bits in a 16-bit word.}
primop BRev32Op "bitReverse32#" Monadic Word# -> Word#
{Reverse the order of the bits in a 32-bit word.}
-primop BRev64Op "bitReverse64#" Monadic WORD64 -> WORD64
+primop BRev64Op "bitReverse64#" Monadic Word64# -> Word64#
{Reverse the order of the bits in a 64-bit word.}
primop BRevOp "bitReverse#" Monadic Word# -> Word#
{Reverse the order of the bits in a word.}
@@ -899,7 +1067,7 @@ primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp
with out_of_line = True
primop DoubleDecode_Int64Op "decodeDouble_Int64#" GenPrimOp
- Double# -> (# INT64, Int# #)
+ Double# -> (# Int64#, Int# #)
{Decode {\tt Double\#} into mantissa and base-2 exponent.}
with out_of_line = True
@@ -1540,7 +1708,7 @@ primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
with can_fail = True
primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
- ByteArray# -> Int# -> INT64
+ ByteArray# -> Int# -> Int64#
{Read 64-bit integer; offset in 64-bit words.}
with can_fail = True
@@ -1560,7 +1728,7 @@ primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
with can_fail = True
primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
- ByteArray# -> Int# -> WORD64
+ ByteArray# -> Int# -> Word64#
{Read 64-bit word; offset in 64-bit words.}
with can_fail = True
@@ -1605,7 +1773,7 @@ primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp
with can_fail = True
primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp
- ByteArray# -> Int# -> INT64
+ ByteArray# -> Int# -> Int64#
{Read 64-bit int; offset in bytes.}
with can_fail = True
@@ -1625,7 +1793,7 @@ primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp
with can_fail = True
primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp
- ByteArray# -> Int# -> WORD64
+ ByteArray# -> Int# -> Word64#
{Read 64-bit word; offset in bytes.}
with can_fail = True
@@ -1694,7 +1862,7 @@ primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp
can_fail = True
primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp
- MutableByteArray# s -> Int# -> State# s -> (# State# s, INT64 #)
+ MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #)
with has_side_effects = True
can_fail = True
@@ -1714,7 +1882,7 @@ primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp
can_fail = True
primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp
- MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD64 #)
+ MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #)
with has_side_effects = True
can_fail = True
@@ -1759,7 +1927,7 @@ primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp
can_fail = True
primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp
- MutableByteArray# s -> Int# -> State# s -> (# State# s, INT64 #)
+ MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #)
with has_side_effects = True
can_fail = True
@@ -1779,7 +1947,7 @@ primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp
can_fail = True
primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp
- MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD64 #)
+ MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #)
with has_side_effects = True
can_fail = True
@@ -1846,7 +2014,7 @@ primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp
can_fail = True
primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp
- MutableByteArray# s -> Int# -> INT64 -> State# s -> State# s
+ MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s
with can_fail = True
has_side_effects = True
@@ -1866,7 +2034,7 @@ primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
can_fail = True
primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp
- MutableByteArray# s -> Int# -> WORD64 -> State# s -> State# s
+ MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s
with has_side_effects = True
can_fail = True
@@ -1911,7 +2079,7 @@ primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp
can_fail = True
primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp
- MutableByteArray# s -> Int# -> INT64 -> State# s -> State# s
+ MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s
with has_side_effects = True
can_fail = True
@@ -1931,7 +2099,7 @@ primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp
can_fail = True
primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp
- MutableByteArray# s -> Int# -> WORD64 -> State# s -> State# s
+ MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s
with has_side_effects = True
can_fail = True
@@ -2290,7 +2458,7 @@ primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp
with can_fail = True
primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp
- Addr# -> Int# -> INT64
+ Addr# -> Int# -> Int64#
with can_fail = True
primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp
@@ -2306,7 +2474,7 @@ primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp
with can_fail = True
primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp
- Addr# -> Int# -> WORD64
+ Addr# -> Int# -> Word64#
with can_fail = True
primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
@@ -2367,7 +2535,7 @@ primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp
can_fail = True
primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp
- Addr# -> Int# -> State# s -> (# State# s, INT64 #)
+ Addr# -> Int# -> State# s -> (# State# s, Int64# #)
with has_side_effects = True
can_fail = True
@@ -2387,7 +2555,7 @@ primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp
can_fail = True
primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp
- Addr# -> Int# -> State# s -> (# State# s, WORD64 #)
+ Addr# -> Int# -> State# s -> (# State# s, Word64# #)
with has_side_effects = True
can_fail = True
@@ -2447,7 +2615,7 @@ primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp
can_fail = True
primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp
- Addr# -> Int# -> INT64 -> State# s -> State# s
+ Addr# -> Int# -> Int64# -> State# s -> State# s
with has_side_effects = True
can_fail = True
@@ -2467,7 +2635,7 @@ primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
can_fail = True
primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
- Addr# -> Int# -> WORD64 -> State# s -> State# s
+ Addr# -> Int# -> Word64# -> State# s -> State# s
with has_side_effects = True
can_fail = True
@@ -3447,7 +3615,7 @@ primop TraceMarkerOp "traceMarker#" GenPrimOp
out_of_line = True
primop SetThreadAllocationCounter "setThreadAllocationCounter#" GenPrimOp
- INT64 -> State# RealWorld -> State# RealWorld
+ Int64# -> State# RealWorld -> State# RealWorld
{ Sets the allocation counter for the current thread to the given value. }
with
has_side_effects = True
@@ -3478,20 +3646,20 @@ section "SIMD Vectors"
------------------------------------------------------------------------
#define ALL_VECTOR_TYPES \
- [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,INT64,2> \
- ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,INT64,4> \
- ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,INT64,8> \
- ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,WORD32,4>,<Word64,WORD64,2> \
- ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,WORD32,8>,<Word64,WORD64,4> \
- ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,WORD32,16>,<Word64,WORD64,8> \
+ [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,Int64#,2> \
+ ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,Int64#,4> \
+ ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,Int64#,8> \
+ ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,WORD32,4>,<Word64,Word64#,2> \
+ ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,WORD32,8>,<Word64,Word64#,4> \
+ ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,WORD32,16>,<Word64,Word64#,8> \
,<Float,Float#,4>,<Double,Double#,2> \
,<Float,Float#,8>,<Double,Double#,4> \
,<Float,Float#,16>,<Double,Double#,8>]
#define SIGNED_VECTOR_TYPES \
- [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,INT64,2> \
- ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,INT64,4> \
- ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,INT64,8> \
+ [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,Int64#,2> \
+ ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,Int64#,4> \
+ ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,Int64#,8> \
,<Float,Float#,4>,<Double,Double#,2> \
,<Float,Float#,8>,<Double,Double#,4> \
,<Float,Float#,16>,<Double,Double#,8>]
@@ -3502,12 +3670,12 @@ section "SIMD Vectors"
,<Float,Float#,16>,<Double,Double#,8>]
#define INT_VECTOR_TYPES \
- [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,INT64,2> \
- ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,INT64,4> \
- ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,INT64,8> \
- ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,WORD32,4>,<Word64,WORD64,2> \
- ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,WORD32,8>,<Word64,WORD64,4> \
- ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,WORD32,16>,<Word64,WORD64,8>]
+ [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,Int64#,2> \
+ ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,Int64#,4> \
+ ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,Int64#,8> \
+ ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,WORD32,4>,<Word64,Word64#,2> \
+ ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,WORD32,8>,<Word64,Word64#,4> \
+ ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,WORD32,16>,<Word64,Word64#,8>]
primtype VECTOR
with llvm_only = True
=====================================
compiler/GHC/Core/Opt/ConstantFold.hs
=====================================
@@ -66,6 +66,7 @@ import GHC.Core.Coercion (mkUnbranchedAxInstCo,mkSymCo,Role(..))
import Control.Applicative ( Alternative(..) )
import Control.Monad
+import Data.Functor (($>))
import Data.Bits as Bits
import qualified Data.ByteString as BS
import Data.Int
@@ -95,6 +96,77 @@ primOpRules nm = \case
TagToEnumOp -> mkPrimOpRule nm 2 [ tagToEnumRule ]
DataToTagOp -> mkPrimOpRule nm 2 [ dataToTagRule ]
+ -- Int64 operations
+ Int64AddOp -> mkPrimOpRule nm 2 [ binaryLit (int64Op2 (+))
+ , identity zeroI64
+ , numFoldingRules Int64AddOp $ const int64PrimOps
+ ]
+ Int64SubOp -> mkPrimOpRule nm 2 [ binaryLit (int64Op2 (-))
+ , rightIdentity zeroI64
+ , equalArgs $> Lit zeroI64
+ , numFoldingRules Int64SubOp $ const int64PrimOps
+ ]
+ Int64MulOp -> mkPrimOpRule nm 2 [ binaryLit (int64Op2 (*))
+ , zeroElem $ \_ -> zeroI64
+ , identity oneI64
+ , numFoldingRules Int64MulOp $ const int64PrimOps
+ ]
+ Int64QuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int64Op2 quot)
+ , leftZero $ \_ -> zeroI64
+ , rightIdentity oneI64
+ , equalArgs $> Lit oneI64 ]
+ Int64RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int64Op2 rem)
+ , leftZero $ \_ -> zeroI64
+ , do l <- getLiteral 1
+ guard $ l == oneI64
+ pure $ Lit zeroI64
+ , equalArgs $> Lit zeroI64
+ , equalArgs $> Lit zeroI64 ]
+ Int64NegOp -> mkPrimOpRule nm 1 [ unaryLit negOp
+ , inversePrimOp Int64NegOp ]
+ Int64SllOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL)
+ , rightIdentity zeroI64 ]
+ Int64SraOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR)
+ , rightIdentity zeroI64 ]
+ Int64SrlOp -> mkPrimOpRule nm 2 [ shiftRule shiftRightLogical
+ , rightIdentity zeroI64 ]
+
+ -- Word64 operations
+ Word64AddOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (+))
+ , identity zeroW64
+ , numFoldingRules Word64AddOp $ const word64PrimOps
+ ]
+ Word64SubOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (-))
+ , rightIdentity zeroW64
+ , equalArgs $> Lit zeroW64
+ , numFoldingRules Word64SubOp $ const word64PrimOps
+ ]
+ Word64MulOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (*))
+ , identity oneW64
+ , numFoldingRules Word64MulOp $ const word64PrimOps
+ ]
+ Word64QuotOp-> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word64Op2 quot)
+ , rightIdentity oneW64 ]
+ Word64RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word64Op2 rem)
+ , leftZero $ \_ -> zeroW64
+ , do l <- getLiteral 1
+ guard $ l == oneW64
+ pure $ Lit zeroW64
+ , equalArgs $> Lit zeroW64 ]
+ Word64AndOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (.&.))
+ , idempotent
+ , zeroElem $ \_ -> zeroW64 ]
+ Word64OrOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (.|.))
+ , idempotent
+ , identity zeroW64 ]
+ Word64XorOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 xor)
+ , identity zeroW64
+ , equalArgs $> Lit zeroW64 ]
+ Word64NotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
+ , inversePrimOp Word64NotOp ]
+ Word64SllOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ]
+ Word64SrlOp -> mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ]
+
-- Int operations
IntAddOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (+))
, identityPlatform zeroi
@@ -127,24 +199,24 @@ primOpRules nm = \case
retLit zeroi
, equalArgs >> retLit zeroi
, equalArgs >> retLit zeroi ]
- AndIOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.&.))
+ IntAndOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.&.))
, idempotent
, zeroElem zeroi ]
- OrIOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.))
+ IntOrOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.))
, idempotent
, identityPlatform zeroi ]
- XorIOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 xor)
+ IntXorOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 xor)
, identityPlatform zeroi
, equalArgs >> retLit zeroi ]
- NotIOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
- , inversePrimOp NotIOp ]
+ IntNotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
+ , inversePrimOp IntNotOp ]
IntNegOp -> mkPrimOpRule nm 1 [ unaryLit negOp
, inversePrimOp IntNegOp ]
- ISllOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL)
+ IntSllOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL)
, rightIdentityPlatform zeroi ]
- ISraOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR)
+ IntSraOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftR)
, rightIdentityPlatform zeroi ]
- ISrlOp -> mkPrimOpRule nm 2 [ shiftRule shiftRightLogical
+ IntSrlOp -> mkPrimOpRule nm 2 [ shiftRule shiftRightLogical
, rightIdentityPlatform zeroi ]
-- Word operations
@@ -175,21 +247,25 @@ primOpRules nm = \case
guard (l == onew platform)
retLit zerow
, equalArgs >> retLit zerow ]
- AndOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.))
+ WordAndOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.))
, idempotent
, zeroElem zerow ]
- OrOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.))
+ WordOrOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.))
, idempotent
, identityPlatform zerow ]
- XorOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)
+ WordXorOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)
, identityPlatform zerow
, equalArgs >> retLit zerow ]
- NotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
- , inversePrimOp NotOp ]
- SllOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ]
- SrlOp -> mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ]
+ WordNotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp
+ , inversePrimOp WordNotOp ]
+ WordSllOp -> mkPrimOpRule nm 2 [ shiftRule (const Bits.shiftL) ]
+ WordSrlOp -> mkPrimOpRule nm 2 [ shiftRule shiftRightLogical ]
-- coercions
+ Word64ToInt64Op-> mkPrimOpRule nm 1 [ liftLitPlatform $ const word64ToInt64Lit
+ , inversePrimOp Int64ToWord64Op ]
+ Int64ToWord64Op-> mkPrimOpRule nm 1 [ liftLitPlatform $ const int64ToWord64Lit
+ , inversePrimOp Word64ToInt64Op ]
Word2IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform word2IntLit
, inversePrimOp Int2WordOp ]
Int2WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform int2WordLit
@@ -198,34 +274,34 @@ primOpRules nm = \case
, subsumedByPrimOp Narrow8IntOp
, Narrow8IntOp `subsumesPrimOp` Narrow16IntOp
, Narrow8IntOp `subsumesPrimOp` Narrow32IntOp
- , narrowSubsumesAnd AndIOp Narrow8IntOp 8 ]
+ , narrowSubsumesAnd IntAndOp Narrow8IntOp 8 ]
Narrow16IntOp -> mkPrimOpRule nm 1 [ liftLit narrow16IntLit
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, Narrow16IntOp `subsumesPrimOp` Narrow32IntOp
- , narrowSubsumesAnd AndIOp Narrow16IntOp 16 ]
+ , narrowSubsumesAnd IntAndOp Narrow16IntOp 16 ]
Narrow32IntOp -> mkPrimOpRule nm 1 [ liftLit narrow32IntLit
, subsumedByPrimOp Narrow8IntOp
, subsumedByPrimOp Narrow16IntOp
, subsumedByPrimOp Narrow32IntOp
, removeOp32
- , narrowSubsumesAnd AndIOp Narrow32IntOp 32 ]
+ , narrowSubsumesAnd IntAndOp Narrow32IntOp 32 ]
Narrow8WordOp -> mkPrimOpRule nm 1 [ liftLit narrow8WordLit
, subsumedByPrimOp Narrow8WordOp
, Narrow8WordOp `subsumesPrimOp` Narrow16WordOp
, Narrow8WordOp `subsumesPrimOp` Narrow32WordOp
- , narrowSubsumesAnd AndOp Narrow8WordOp 8 ]
+ , narrowSubsumesAnd WordAndOp Narrow8WordOp 8 ]
Narrow16WordOp -> mkPrimOpRule nm 1 [ liftLit narrow16WordLit
, subsumedByPrimOp Narrow8WordOp
, subsumedByPrimOp Narrow16WordOp
, Narrow16WordOp `subsumesPrimOp` Narrow32WordOp
- , narrowSubsumesAnd AndOp Narrow16WordOp 16 ]
+ , narrowSubsumesAnd WordAndOp Narrow16WordOp 16 ]
Narrow32WordOp -> mkPrimOpRule nm 1 [ liftLit narrow32WordLit
, subsumedByPrimOp Narrow8WordOp
, subsumedByPrimOp Narrow16WordOp
, subsumedByPrimOp Narrow32WordOp
, removeOp32
- , narrowSubsumesAnd AndOp Narrow32WordOp 32 ]
+ , narrowSubsumesAnd WordAndOp Narrow32WordOp 32 ]
OrdOp -> mkPrimOpRule nm 1 [ liftLit char2IntLit
, inversePrimOp ChrOp ]
ChrOp -> mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs
@@ -379,6 +455,12 @@ onei platform = mkLitInt platform 1
zerow platform = mkLitWord platform 0
onew platform = mkLitWord platform 1
+zeroI64, oneI64, zeroW64, oneW64 :: Literal
+zeroI64 = mkLitInt64 0
+oneI64 = mkLitInt64 1
+zeroW64 = mkLitWord64 0
+oneW64 = mkLitWord64 1
+
zerof, onef, twof, zerod, oned, twod :: Literal
zerof = mkLitFloat 0.0
onef = mkLitFloat 1.0
@@ -420,6 +502,14 @@ complementOp env (LitNumber nt i) =
Just (Lit (mkLitNumberWrap (roPlatform env) nt (complement i)))
complementOp _ _ = Nothing
+int64Op2
+ :: (Integral a, Integral b)
+ => (a -> b -> Integer)
+ -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
+int64Op2 op _ (LitNumber LitNumInt64 i1) (LitNumber LitNumInt64 i2) =
+ int64Result (fromInteger i1 `op` fromInteger i2)
+int64Op2 _ _ _ _ = Nothing -- Could find LitLit
+
intOp2 :: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
@@ -460,6 +550,14 @@ retLitNoC l = do platform <- getPlatform
let ty = literalType lit
return $ mkCoreUbxTup [ty, ty] [Lit lit, Lit (zeroi platform)]
+word64Op2
+ :: (Integral a, Integral b)
+ => (a -> b -> Integer)
+ -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
+word64Op2 op _ (LitNumber LitNumWord64 i1) (LitNumber LitNumWord64 i2) =
+ word64Result (fromInteger i1 `op` fromInteger i2)
+word64Op2 _ _ _ _ = Nothing -- Could find LitLit
+
wordOp2 :: (Integral a, Integral b)
=> (a -> b -> Integer)
-> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
@@ -477,8 +575,8 @@ wordOpC2 _ _ _ _ = Nothing
shiftRule :: (Platform -> Integer -> Int -> Integer) -> RuleM CoreExpr
-- Shifts take an Int; hence third arg of op is Int
-- Used for shift primops
--- ISllOp, ISraOp, ISrlOp :: Word# -> Int# -> Word#
--- SllOp, SrlOp :: Word# -> Int# -> Word#
+-- IntSllOp, IntSraOp, IntSrlOp :: Word# -> Int# -> Word#
+-- SllOp, SrlOp :: Word# -> Int# -> Word#
shiftRule shift_op
= do { platform <- getPlatform
; [e1, Lit (LitNumber LitNumInt shift_len)] <- getArgs
@@ -604,6 +702,14 @@ isMaxBound platform (LitNumber nt i) = case nt of
LitNumInteger -> False
isMaxBound _ _ = False
+-- | Create an Int literal expression while ensuring the given Integer is in the
+-- target Int range
+int64Result :: Integer -> Maybe CoreExpr
+int64Result result = Just (int64Result' result)
+
+int64Result' :: Integer -> CoreExpr
+int64Result' result = Lit (mkLitInt64Wrap result)
+
-- | Create an Int literal expression while ensuring the given Integer is in the
-- target Int range
intResult :: Platform -> Integer -> Maybe CoreExpr
@@ -622,6 +728,14 @@ intCResult platform result = Just (mkPair [Lit lit, Lit c])
(lit, b) = mkLitIntWrapC platform result
c = if b then onei platform else zeroi platform
+-- | Create a Word literal expression while ensuring the given Integer is in the
+-- target Word range
+word64Result :: Integer -> Maybe CoreExpr
+word64Result result = Just (word64Result' result)
+
+word64Result' :: Integer -> CoreExpr
+word64Result' result = Lit (mkLitWord64Wrap result)
+
-- | Create a Word literal expression while ensuring the given Integer is in the
-- target Word range
wordResult :: Platform -> Integer -> Maybe CoreExpr
@@ -753,7 +867,7 @@ transform the invalid shift into an "obviously incorrect" value.
There are two cases:
-- Shifting fixed-width things: the primops ISll, Sll, etc
+- Shifting fixed-width things: the primops IntSll, Sll, etc
These are handled by shiftRule.
We are happy to shift by any amount up to wordSize but no more.
@@ -1283,7 +1397,7 @@ builtinRules enableBignumRules
[arg, Lit (LitNumber LitNumInt d)] <- getArgs
Just n <- return $ exactLog2 d
platform <- getPlatform
- return $ Var (mkPrimOpId ISraOp) `App` arg `App` mkIntVal platform n
+ return $ Var (mkPrimOpId IntSraOp) `App` arg `App` mkIntVal platform n
],
mkBasicRule modIntName 2 $ msum
@@ -1293,7 +1407,7 @@ builtinRules enableBignumRules
[arg, Lit (LitNumber LitNumInt d)] <- getArgs
Just _ <- return $ exactLog2 d
platform <- getPlatform
- return $ Var (mkPrimOpId AndIOp)
+ return $ Var (mkPrimOpId IntAndOp)
`App` arg `App` mkIntVal platform (d - 1)
]
]
@@ -1978,16 +2092,22 @@ pattern (:-:) :: Arg CoreBndr -> Arg CoreBndr -> CoreExpr
pattern x :-: y <- BinOpApp x (isSubOp -> True) y
isSubOp :: PrimOp -> Bool
+isSubOp Int64SubOp = True
+isSubOp Word64SubOp = True
isSubOp IntSubOp = True
isSubOp WordSubOp = True
isSubOp _ = False
isAddOp :: PrimOp -> Bool
+isAddOp Int64AddOp = True
+isAddOp Word64AddOp = True
isAddOp IntAddOp = True
isAddOp WordAddOp = True
isAddOp _ = False
isMulOp :: PrimOp -> Bool
+isMulOp Int64MulOp = True
+isMulOp Word64MulOp = True
isMulOp IntMulOp = True
isMulOp WordMulOp = True
isMulOp _ = False
@@ -2002,6 +2122,22 @@ data PrimOps = PrimOps
, mkL :: Integer -> CoreExpr -- ^ Create a literal value
}
+int64PrimOps :: PrimOps
+int64PrimOps = PrimOps
+ { add = \x y -> BinOpApp x Int64AddOp y
+ , sub = \x y -> BinOpApp x Int64SubOp y
+ , mul = \x y -> BinOpApp x Int64MulOp y
+ , mkL = int64Result'
+ }
+
+word64PrimOps :: PrimOps
+word64PrimOps = PrimOps
+ { add = \x y -> BinOpApp x Word64AddOp y
+ , sub = \x y -> BinOpApp x Word64SubOp y
+ , mul = \x y -> BinOpApp x Word64MulOp y
+ , mkL = word64Result'
+ }
+
intPrimOps :: Platform -> PrimOps
intPrimOps platform = PrimOps
{ add = \x y -> BinOpApp x IntAddOp y
@@ -2099,8 +2235,8 @@ adjustDyadicRight op lit
IntAddOp -> Just (\y -> y-lit )
WordSubOp -> Just (\y -> y+lit )
IntSubOp -> Just (\y -> y+lit )
- XorOp -> Just (\y -> y `xor` lit)
- XorIOp -> Just (\y -> y `xor` lit)
+ WordXorOp -> Just (\y -> y `xor` lit)
+ IntXorOp -> Just (\y -> y `xor` lit)
_ -> Nothing
adjustDyadicLeft :: Integer -> PrimOp -> Maybe (Integer -> Integer)
@@ -2111,8 +2247,8 @@ adjustDyadicLeft lit op
IntAddOp -> Just (\y -> y-lit )
WordSubOp -> Just (\y -> lit-y )
IntSubOp -> Just (\y -> lit-y )
- XorOp -> Just (\y -> y `xor` lit)
- XorIOp -> Just (\y -> y `xor` lit)
+ WordXorOp -> Just (\y -> y `xor` lit)
+ IntXorOp -> Just (\y -> y `xor` lit)
_ -> Nothing
@@ -2120,8 +2256,8 @@ adjustUnary :: PrimOp -> Maybe (Integer -> Integer)
-- Given (op x) return a function 'f' s.t. f (op x) = x
adjustUnary op
= case op of
- NotOp -> Just (\y -> complement y)
- NotIOp -> Just (\y -> complement y)
+ WordNotOp -> Just (\y -> complement y)
+ IntNotOp -> Just (\y -> complement y)
IntNegOp -> Just (\y -> negate y )
_ -> Nothing
=====================================
compiler/GHC/HsToCore/Match/Literal.hs
=====================================
@@ -96,8 +96,8 @@ dsLit l = do
HsCharPrim _ c -> return (Lit (LitChar c))
HsIntPrim _ i -> return (Lit (mkLitIntWrap platform i))
HsWordPrim _ w -> return (Lit (mkLitWordWrap platform w))
- HsInt64Prim _ i -> return (Lit (mkLitInt64Wrap platform i))
- HsWord64Prim _ w -> return (Lit (mkLitWord64Wrap platform w))
+ HsInt64Prim _ i -> return (Lit (mkLitInt64Wrap i))
+ HsWord64Prim _ w -> return (Lit (mkLitWord64Wrap w))
HsFloatPrim _ f -> return (Lit (LitFloat (fl_value f)))
HsDoublePrim _ d -> return (Lit (LitDouble (fl_value d)))
HsChar _ c -> return (mkCharExpr c)
@@ -493,8 +493,8 @@ hsLitKey :: Platform -> HsLit GhcTc -> Literal
-- HsLit does not.
hsLitKey platform (HsIntPrim _ i) = mkLitIntWrap platform i
hsLitKey platform (HsWordPrim _ w) = mkLitWordWrap platform w
-hsLitKey platform (HsInt64Prim _ i) = mkLitInt64Wrap platform i
-hsLitKey platform (HsWord64Prim _ w) = mkLitWord64Wrap platform w
+hsLitKey _ (HsInt64Prim _ i) = mkLitInt64Wrap i
+hsLitKey _ (HsWord64Prim _ w) = mkLitWord64Wrap w
hsLitKey _ (HsCharPrim _ c) = mkLitChar c
hsLitKey _ (HsFloatPrim _ f) = mkLitFloat (fl_value f)
hsLitKey _ (HsDoublePrim _ d) = mkLitDouble (fl_value d)
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1067,6 +1067,10 @@ emitPrimOp dflags = \case
-- The rest just translate straightforwardly
+ Int64ToWord64Op -> \args -> opNop args
+ Word64ToInt64Op -> \args -> opNop args
+ Int32ToWord32Op -> \args -> opNop args
+ Word32ToInt32Op -> \args -> opNop args
Int2WordOp -> \args -> opNop args
Word2IntOp -> \args -> opNop args
Int2AddrOp -> \args -> opNop args
@@ -1135,12 +1139,12 @@ emitPrimOp dflags = \case
AddrEqOp -> \args -> opTranslate args (mo_wordEq platform)
AddrNeOp -> \args -> opTranslate args (mo_wordNe platform)
- AndOp -> \args -> opTranslate args (mo_wordAnd platform)
- OrOp -> \args -> opTranslate args (mo_wordOr platform)
- XorOp -> \args -> opTranslate args (mo_wordXor platform)
- NotOp -> \args -> opTranslate args (mo_wordNot platform)
- SllOp -> \args -> opTranslate args (mo_wordShl platform)
- SrlOp -> \args -> opTranslate args (mo_wordUShr platform)
+ WordAndOp -> \args -> opTranslate args (mo_wordAnd platform)
+ WordOrOp -> \args -> opTranslate args (mo_wordOr platform)
+ WordXorOp -> \args -> opTranslate args (mo_wordXor platform)
+ WordNotOp -> \args -> opTranslate args (mo_wordNot platform)
+ WordSllOp -> \args -> opTranslate args (mo_wordShl platform)
+ WordSrlOp -> \args -> opTranslate args (mo_wordUShr platform)
AddrRemOp -> \args -> opTranslate args (mo_wordURem platform)
@@ -1157,13 +1161,13 @@ emitPrimOp dflags = \case
IntGtOp -> \args -> opTranslate args (mo_wordSGt platform)
IntLtOp -> \args -> opTranslate args (mo_wordSLt platform)
- AndIOp -> \args -> opTranslate args (mo_wordAnd platform)
- OrIOp -> \args -> opTranslate args (mo_wordOr platform)
- XorIOp -> \args -> opTranslate args (mo_wordXor platform)
- NotIOp -> \args -> opTranslate args (mo_wordNot platform)
- ISllOp -> \args -> opTranslate args (mo_wordShl platform)
- ISraOp -> \args -> opTranslate args (mo_wordSShr platform)
- ISrlOp -> \args -> opTranslate args (mo_wordUShr platform)
+ IntAndOp -> \args -> opTranslate args (mo_wordAnd platform)
+ IntOrOp -> \args -> opTranslate args (mo_wordOr platform)
+ IntXorOp -> \args -> opTranslate args (mo_wordXor platform)
+ IntNotOp -> \args -> opTranslate args (mo_wordNot platform)
+ IntSllOp -> \args -> opTranslate args (mo_wordShl platform)
+ IntSraOp -> \args -> opTranslate args (mo_wordSShr platform)
+ IntSrlOp -> \args -> opTranslate args (mo_wordUShr platform)
-- Native word unsigned ops
@@ -1183,8 +1187,8 @@ emitPrimOp dflags = \case
-- Int8# signed ops
- Int8Extend -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth platform))
- Int8Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W8)
+ Int8ToInt -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth platform))
+ IntToInt8 -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W8)
Int8NegOp -> \args -> opTranslate args (MO_S_Neg W8)
Int8AddOp -> \args -> opTranslate args (MO_Add W8)
Int8SubOp -> \args -> opTranslate args (MO_Sub W8)
@@ -1201,8 +1205,8 @@ emitPrimOp dflags = \case
-- Word8# unsigned ops
- Word8Extend -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth platform))
- Word8Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W8)
+ Word8ToWord -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth platform))
+ WordToWord8 -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W8)
Word8NotOp -> \args -> opTranslate args (MO_Not W8)
Word8AddOp -> \args -> opTranslate args (MO_Add W8)
Word8SubOp -> \args -> opTranslate args (MO_Sub W8)
@@ -1219,8 +1223,8 @@ emitPrimOp dflags = \case
-- Int16# signed ops
- Int16Extend -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth platform))
- Int16Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W16)
+ Int16ToInt -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth platform))
+ IntToInt16 -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W16)
Int16NegOp -> \args -> opTranslate args (MO_S_Neg W16)
Int16AddOp -> \args -> opTranslate args (MO_Add W16)
Int16SubOp -> \args -> opTranslate args (MO_Sub W16)
@@ -1237,8 +1241,8 @@ emitPrimOp dflags = \case
-- Word16# unsigned ops
- Word16Extend -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth platform))
- Word16Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W16)
+ Word16ToWord -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth platform))
+ WordToWord16 -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W16)
Word16NotOp -> \args -> opTranslate args (MO_Not W16)
Word16AddOp -> \args -> opTranslate args (MO_Add W16)
Word16SubOp -> \args -> opTranslate args (MO_Sub W16)
@@ -1253,6 +1257,98 @@ emitPrimOp dflags = \case
Word16LtOp -> \args -> opTranslate args (MO_U_Lt W16)
Word16NeOp -> \args -> opTranslate args (MO_Ne W16)
+-- Int32# signed ops
+
+ Int32ToInt -> \args -> opTranslate args (MO_SS_Conv W32 (wordWidth platform))
+ IntToInt32 -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W32)
+ Int32NegOp -> \args -> opTranslate args (MO_S_Neg W32)
+ Int32AddOp -> \args -> opTranslate args (MO_Add W32)
+ Int32SubOp -> \args -> opTranslate args (MO_Sub W32)
+ Int32MulOp -> \args -> opTranslate args (MO_Mul W32)
+ Int32QuotOp -> \args -> opTranslate args (MO_S_Quot W32)
+ Int32RemOp -> \args -> opTranslate args (MO_S_Rem W32)
+
+ Int32SllOp -> \args -> opTranslate args (MO_Shl W32)
+ Int32SraOp -> \args -> opTranslate args (MO_S_Shr W32)
+ Int32SrlOp -> \args -> opTranslate args (MO_U_Shr W32)
+
+ Int32EqOp -> \args -> opTranslate args (MO_Eq W32)
+ Int32GeOp -> \args -> opTranslate args (MO_S_Ge W32)
+ Int32GtOp -> \args -> opTranslate args (MO_S_Gt W32)
+ Int32LeOp -> \args -> opTranslate args (MO_S_Le W32)
+ Int32LtOp -> \args -> opTranslate args (MO_S_Lt W32)
+ Int32NeOp -> \args -> opTranslate args (MO_Ne W32)
+
+-- Word32# unsigned ops
+
+ Word32ToWord -> \args -> opTranslate args (MO_UU_Conv W32 (wordWidth platform))
+ WordToWord32 -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W32)
+ Word32AddOp -> \args -> opTranslate args (MO_Add W32)
+ Word32SubOp -> \args -> opTranslate args (MO_Sub W32)
+ Word32MulOp -> \args -> opTranslate args (MO_Mul W32)
+ Word32QuotOp -> \args -> opTranslate args (MO_U_Quot W32)
+ Word32RemOp -> \args -> opTranslate args (MO_U_Rem W32)
+
+ Word32AndOp -> \args -> opTranslate args (MO_And W32)
+ Word32OrOp -> \args -> opTranslate args (MO_Or W32)
+ Word32XorOp -> \args -> opTranslate args (MO_Xor W32)
+ Word32NotOp -> \args -> opTranslate args (MO_Not W32)
+ Word32SllOp -> \args -> opTranslate args (MO_Shl W32)
+ Word32SrlOp -> \args -> opTranslate args (MO_U_Shr W32)
+
+ Word32EqOp -> \args -> opTranslate args (MO_Eq W32)
+ Word32GeOp -> \args -> opTranslate args (MO_U_Ge W32)
+ Word32GtOp -> \args -> opTranslate args (MO_U_Gt W32)
+ Word32LeOp -> \args -> opTranslate args (MO_U_Le W32)
+ Word32LtOp -> \args -> opTranslate args (MO_U_Lt W32)
+ Word32NeOp -> \args -> opTranslate args (MO_Ne W32)
+
+-- Int64# signed ops
+
+ Int64ToInt -> \args -> opTranslate args (MO_SS_Conv W64 (wordWidth platform))
+ IntToInt64 -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W64)
+ Int64NegOp -> \args -> opTranslate args (MO_S_Neg W64)
+ Int64AddOp -> \args -> opTranslate args (MO_Add W64)
+ Int64SubOp -> \args -> opTranslate args (MO_Sub W64)
+ Int64MulOp -> \args -> opTranslate args (MO_Mul W64)
+ Int64QuotOp -> \args -> opTranslate args (MO_S_Quot W64)
+ Int64RemOp -> \args -> opTranslate args (MO_S_Rem W64)
+
+ Int64SllOp -> \args -> opTranslate args (MO_Shl W64)
+ Int64SraOp -> \args -> opTranslate args (MO_S_Shr W64)
+ Int64SrlOp -> \args -> opTranslate args (MO_U_Shr W64)
+
+ Int64EqOp -> \args -> opTranslate args (MO_Eq W64)
+ Int64GeOp -> \args -> opTranslate args (MO_S_Ge W64)
+ Int64GtOp -> \args -> opTranslate args (MO_S_Gt W64)
+ Int64LeOp -> \args -> opTranslate args (MO_S_Le W64)
+ Int64LtOp -> \args -> opTranslate args (MO_S_Lt W64)
+ Int64NeOp -> \args -> opTranslate args (MO_Ne W64)
+
+-- Word64# unsigned ops
+
+ Word64ToWord -> \args -> opTranslate args (MO_UU_Conv W64 (wordWidth platform))
+ WordToWord64 -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W64)
+ Word64AddOp -> \args -> opTranslate args (MO_Add W64)
+ Word64SubOp -> \args -> opTranslate args (MO_Sub W64)
+ Word64MulOp -> \args -> opTranslate args (MO_Mul W64)
+ Word64QuotOp -> \args -> opTranslate args (MO_U_Quot W64)
+ Word64RemOp -> \args -> opTranslate args (MO_U_Rem W64)
+
+ Word64AndOp -> \args -> opTranslate args (MO_And W64)
+ Word64OrOp -> \args -> opTranslate args (MO_Or W64)
+ Word64XorOp -> \args -> opTranslate args (MO_Xor W64)
+ Word64NotOp -> \args -> opTranslate args (MO_Not W64)
+ Word64SllOp -> \args -> opTranslate args (MO_Shl W64)
+ Word64SrlOp -> \args -> opTranslate args (MO_U_Shr W64)
+
+ Word64EqOp -> \args -> opTranslate args (MO_Eq W64)
+ Word64GeOp -> \args -> opTranslate args (MO_U_Ge W64)
+ Word64GtOp -> \args -> opTranslate args (MO_U_Gt W64)
+ Word64LeOp -> \args -> opTranslate args (MO_U_Le W64)
+ Word64LtOp -> \args -> opTranslate args (MO_U_Lt W64)
+ Word64NeOp -> \args -> opTranslate args (MO_Ne W64)
+
-- Char# ops
CharEqOp -> \args -> opTranslate args (MO_Eq (wordWidth platform))
@@ -1357,6 +1453,16 @@ emitPrimOp dflags = \case
then Left (MO_S_QuotRem W16)
else Right (genericIntQuotRemOp W16)
+ Int32QuotRemOp -> \args -> opCallishHandledLater args $
+ if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
+ then Left (MO_S_QuotRem W32)
+ else Right (genericIntQuotRemOp W32)
+
+ Int64QuotRemOp -> \args -> opCallishHandledLater args $
+ if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
+ then Left (MO_S_QuotRem W64)
+ else Right (genericIntQuotRemOp W64)
+
WordQuotRemOp -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
then Left (MO_U_QuotRem (wordWidth platform))
@@ -1377,6 +1483,16 @@ emitPrimOp dflags = \case
then Left (MO_U_QuotRem W16)
else Right (genericWordQuotRemOp W16)
+ Word32QuotRemOp -> \args -> opCallishHandledLater args $
+ if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
+ then Left (MO_U_QuotRem W32)
+ else Right (genericWordQuotRemOp W32)
+
+ Word64QuotRemOp -> \args -> opCallishHandledLater args $
+ if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
+ then Left (MO_U_QuotRem W64)
+ else Right (genericWordQuotRemOp W64)
+
WordAdd2Op -> \args -> opCallishHandledLater args $
if (ncg && (x86ish || ppc)) || llvm
then Left (MO_Add2 (wordWidth platform))
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -1503,14 +1503,21 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstr_RDR,
eqInt_RDR , ltInt_RDR , geInt_RDR , gtInt_RDR , leInt_RDR ,
eqInt8_RDR , ltInt8_RDR , geInt8_RDR , gtInt8_RDR , leInt8_RDR ,
eqInt16_RDR , ltInt16_RDR , geInt16_RDR , gtInt16_RDR , leInt16_RDR ,
+ eqInt32_RDR , ltInt32_RDR , geInt32_RDR , gtInt32_RDR , leInt32_RDR ,
+ eqInt64_RDR , ltInt64_RDR , geInt64_RDR , gtInt64_RDR , leInt64_RDR ,
eqWord_RDR , ltWord_RDR , geWord_RDR , gtWord_RDR , leWord_RDR ,
eqWord8_RDR , ltWord8_RDR , geWord8_RDR , gtWord8_RDR , leWord8_RDR ,
eqWord16_RDR, ltWord16_RDR, geWord16_RDR, gtWord16_RDR, leWord16_RDR,
+ eqWord32_RDR, ltWord32_RDR, geWord32_RDR, gtWord32_RDR, leWord32_RDR,
+ eqWord64_RDR, ltWord64_RDR, geWord64_RDR, gtWord64_RDR, leWord64_RDR,
eqAddr_RDR , ltAddr_RDR , geAddr_RDR , gtAddr_RDR , leAddr_RDR ,
eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR ,
eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR,
- extendWord8_RDR, extendInt8_RDR,
- extendWord16_RDR, extendInt16_RDR :: RdrName
+ word8ToWord_RDR , int8ToInt_RDR ,
+ word16ToWord_RDR, int16ToInt_RDR,
+ word32ToWord_RDR, int32ToInt_RDR,
+ word64ToWord_RDR, int64ToInt_RDR
+ :: RdrName
gfoldl_RDR = varQual_RDR gENERICS (fsLit "gfoldl")
gunfold_RDR = varQual_RDR gENERICS (fsLit "gunfold")
toConstr_RDR = varQual_RDR gENERICS (fsLit "toConstr")
@@ -1551,6 +1558,18 @@ leInt16_RDR = varQual_RDR gHC_PRIM (fsLit "leInt16#")
gtInt16_RDR = varQual_RDR gHC_PRIM (fsLit "gtInt16#" )
geInt16_RDR = varQual_RDR gHC_PRIM (fsLit "geInt16#")
+eqInt32_RDR = varQual_RDR gHC_PRIM (fsLit "eqInt32#")
+ltInt32_RDR = varQual_RDR gHC_PRIM (fsLit "ltInt32#" )
+leInt32_RDR = varQual_RDR gHC_PRIM (fsLit "leInt32#")
+gtInt32_RDR = varQual_RDR gHC_PRIM (fsLit "gtInt32#" )
+geInt32_RDR = varQual_RDR gHC_PRIM (fsLit "geInt32#")
+
+eqInt64_RDR = varQual_RDR gHC_PRIM (fsLit "eqInt64#")
+ltInt64_RDR = varQual_RDR gHC_PRIM (fsLit "ltInt64#" )
+leInt64_RDR = varQual_RDR gHC_PRIM (fsLit "leInt64#")
+gtInt64_RDR = varQual_RDR gHC_PRIM (fsLit "gtInt64#" )
+geInt64_RDR = varQual_RDR gHC_PRIM (fsLit "geInt64#")
+
eqWord_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord#")
ltWord_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord#")
leWord_RDR = varQual_RDR gHC_PRIM (fsLit "leWord#")
@@ -1569,6 +1588,18 @@ leWord16_RDR = varQual_RDR gHC_PRIM (fsLit "leWord16#")
gtWord16_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord16#" )
geWord16_RDR = varQual_RDR gHC_PRIM (fsLit "geWord16#")
+eqWord32_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord32#")
+ltWord32_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord32#" )
+leWord32_RDR = varQual_RDR gHC_PRIM (fsLit "leWord32#")
+gtWord32_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord32#" )
+geWord32_RDR = varQual_RDR gHC_PRIM (fsLit "geWord32#")
+
+eqWord64_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord64#")
+ltWord64_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord64#" )
+leWord64_RDR = varQual_RDR gHC_PRIM (fsLit "leWord64#")
+gtWord64_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord64#" )
+geWord64_RDR = varQual_RDR gHC_PRIM (fsLit "geWord64#")
+
eqAddr_RDR = varQual_RDR gHC_PRIM (fsLit "eqAddr#")
ltAddr_RDR = varQual_RDR gHC_PRIM (fsLit "ltAddr#")
leAddr_RDR = varQual_RDR gHC_PRIM (fsLit "leAddr#")
@@ -1587,12 +1618,17 @@ leDouble_RDR = varQual_RDR gHC_PRIM (fsLit "<=##")
gtDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">##" )
geDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">=##")
-extendWord8_RDR = varQual_RDR gHC_PRIM (fsLit "extendWord8#")
-extendInt8_RDR = varQual_RDR gHC_PRIM (fsLit "extendInt8#")
+word8ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word8ToWord#")
+int8ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int8ToInt#")
-extendWord16_RDR = varQual_RDR gHC_PRIM (fsLit "extendWord16#")
-extendInt16_RDR = varQual_RDR gHC_PRIM (fsLit "extendInt16#")
+word16ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word16ToWord#")
+int16ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int16ToInt#")
+word32ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word32ToWord#")
+int32ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int32ToInt#")
+
+word64ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word64ToWord#")
+int64ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int64ToInt#")
{-
************************************************************************
@@ -2258,12 +2294,20 @@ ordOpTbl
, eqInt8_RDR , geInt8_RDR , gtInt8_RDR ))
,(int16PrimTy , (ltInt16_RDR , leInt16_RDR
, eqInt16_RDR , geInt16_RDR , gtInt16_RDR ))
+ ,(int32PrimTy , (ltInt32_RDR , leInt32_RDR
+ , eqInt32_RDR , geInt32_RDR , gtInt32_RDR ))
+ ,(int64PrimTy , (ltInt64_RDR , leInt64_RDR
+ , eqInt64_RDR , geInt64_RDR , gtInt64_RDR ))
,(wordPrimTy , (ltWord_RDR , leWord_RDR
, eqWord_RDR , geWord_RDR , gtWord_RDR ))
,(word8PrimTy , (ltWord8_RDR , leWord8_RDR
, eqWord8_RDR , geWord8_RDR , gtWord8_RDR ))
,(word16PrimTy, (ltWord16_RDR, leWord16_RDR
, eqWord16_RDR, geWord16_RDR, gtWord16_RDR ))
+ ,(word32PrimTy, (ltWord32_RDR, leWord32_RDR
+ , eqWord32_RDR, geWord32_RDR, gtWord32_RDR ))
+ ,(word64PrimTy, (ltWord64_RDR, leWord64_RDR
+ , eqWord64_RDR, geWord64_RDR, gtWord64_RDR ))
,(addrPrimTy , (ltAddr_RDR , leAddr_RDR
, eqAddr_RDR , geAddr_RDR , gtAddr_RDR ))
,(floatPrimTy , (ltFloat_RDR , leFloat_RDR
@@ -2283,16 +2327,28 @@ boxConTbl =
, (doublePrimTy, nlHsApp (nlHsVar $ getRdrName doubleDataCon))
, (int8PrimTy,
nlHsApp (nlHsVar $ getRdrName intDataCon)
- . nlHsApp (nlHsVar extendInt8_RDR))
+ . nlHsApp (nlHsVar int8ToInt_RDR))
, (word8PrimTy,
nlHsApp (nlHsVar $ getRdrName wordDataCon)
- . nlHsApp (nlHsVar extendWord8_RDR))
+ . nlHsApp (nlHsVar word8ToWord_RDR))
, (int16PrimTy,
nlHsApp (nlHsVar $ getRdrName intDataCon)
- . nlHsApp (nlHsVar extendInt16_RDR))
+ . nlHsApp (nlHsVar int16ToInt_RDR))
, (word16PrimTy,
nlHsApp (nlHsVar $ getRdrName wordDataCon)
- . nlHsApp (nlHsVar extendWord16_RDR))
+ . nlHsApp (nlHsVar word16ToWord_RDR))
+ , (int32PrimTy,
+ nlHsApp (nlHsVar $ getRdrName intDataCon)
+ . nlHsApp (nlHsVar int32ToInt_RDR))
+ , (word32PrimTy,
+ nlHsApp (nlHsVar $ getRdrName wordDataCon)
+ . nlHsApp (nlHsVar word32ToWord_RDR))
+ , (int64PrimTy,
+ nlHsApp (nlHsVar $ getRdrName intDataCon)
+ . nlHsApp (nlHsVar int64ToInt_RDR))
+ , (word64PrimTy,
+ nlHsApp (nlHsVar $ getRdrName wordDataCon)
+ . nlHsApp (nlHsVar word64ToWord_RDR))
]
@@ -2312,10 +2368,14 @@ postfixModTbl
primConvTbl :: [(Type, String)]
primConvTbl =
- [ (int8PrimTy, "narrowInt8#")
- , (word8PrimTy, "narrowWord8#")
- , (int16PrimTy, "narrowInt16#")
- , (word16PrimTy, "narrowWord16#")
+ [ (int8PrimTy, "intToInt8#")
+ , (word8PrimTy, "wordToWord8#")
+ , (int16PrimTy, "intToInt16#")
+ , (word16PrimTy, "wordToWord16#")
+ , (int32PrimTy, "intToInt32#")
+ , (word32PrimTy, "wordToWord32#")
+ , (int64PrimTy, "intToInt64#")
+ , (word64PrimTy, "wordToWord64#")
]
litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]
=====================================
compiler/GHC/Tc/Instance/Typeable.hs
=====================================
@@ -623,8 +623,8 @@ mkTyConRepTyConRHS :: TypeableStuff -> TypeRepTodo
-> LHsExpr GhcTc
mkTyConRepTyConRHS (Stuff {..}) todo tycon kind_rep
= nlHsDataCon trTyConDataCon
- `nlHsApp` nlHsLit (word64 platform high)
- `nlHsApp` nlHsLit (word64 platform low)
+ `nlHsApp` nlHsLit (word64 high)
+ `nlHsApp` nlHsLit (word64 low)
`nlHsApp` mod_rep_expr todo
`nlHsApp` trNameLit (mkFastString tycon_str)
`nlHsApp` nlHsLit (int n_kind_vars)
@@ -645,10 +645,8 @@ mkTyConRepTyConRHS (Stuff {..}) todo tycon kind_rep
int :: Int -> HsLit GhcTc
int n = HsIntPrim (SourceText $ show n) (toInteger n)
-word64 :: Platform -> Word64 -> HsLit GhcTc
-word64 platform n = case platformWordSize platform of
- PW4 -> HsWord64Prim NoSourceText (toInteger n)
- PW8 -> HsWordPrim NoSourceText (toInteger n)
+word64 :: Word64 -> HsLit GhcTc
+word64 n = HsWord64Prim NoSourceText (toInteger n)
{-
Note [Representing TyCon kinds: KindRep]
=====================================
compiler/GHC/Types/Literal.hs
=====================================
@@ -39,6 +39,7 @@ module GHC.Types.Literal
, litValue, isLitValue, isLitValue_maybe, mapLitValue
-- ** Coercions
+ , word64ToInt64Lit, int64ToWord64Lit
, word2IntLit, int2WordLit
, narrowLit
, narrow8IntLit, narrow16IntLit, narrow32IntLit
@@ -287,17 +288,28 @@ Int/Word range.
wrapLitNumber :: Platform -> Literal -> Literal
wrapLitNumber platform v@(LitNumber nt i) = case nt of
LitNumInt -> case platformWordSize platform of
- PW4 -> LitNumber nt (toInteger (fromIntegral i :: Int32))
- PW8 -> LitNumber nt (toInteger (fromIntegral i :: Int64))
+ PW4 -> int32
+ PW8 -> int64
LitNumWord -> case platformWordSize platform of
- PW4 -> LitNumber nt (toInteger (fromIntegral i :: Word32))
- PW8 -> LitNumber nt (toInteger (fromIntegral i :: Word64))
- LitNumInt64 -> LitNumber nt (toInteger (fromIntegral i :: Int64))
- LitNumWord64 -> LitNumber nt (toInteger (fromIntegral i :: Word64))
+ PW4 -> word32
+ PW8 -> word64
+ LitNumInt64 -> int64
+ LitNumWord64 -> word64
LitNumInteger -> v
LitNumNatural -> v
+ where
+ int32 = LitNumber nt $ wrapInt32 i
+ word32 = LitNumber nt $ wrapWord32 i
+ int64 = LitNumber nt $ wrapInt64 i
+ word64 = LitNumber nt $ wrapWord64 i
wrapLitNumber _ x = x
+wrapInt32, wrapWord32, wrapInt64, wrapWord64 :: Integer -> Integer
+wrapInt32 i = toInteger (fromIntegral i :: Int32)
+wrapWord32 i = toInteger (fromIntegral i :: Int32)
+wrapInt64 i = toInteger (fromIntegral i :: Int64)
+wrapWord64 i = toInteger (fromIntegral i :: Int64)
+
-- | Create a numeric 'Literal' of the given type
mkLitNumberWrap :: Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap platform nt i = wrapLitNumber platform (LitNumber nt i)
@@ -372,8 +384,8 @@ mkLitInt64 x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x)
-- | Creates a 'Literal' of type @Int64#@.
-- If the argument is out of the range, it is wrapped.
-mkLitInt64Wrap :: Platform -> Integer -> Literal
-mkLitInt64Wrap platform i = wrapLitNumber platform $ mkLitInt64Unchecked i
+mkLitInt64Wrap :: Integer -> Literal
+mkLitInt64Wrap = mkLitInt64Unchecked . wrapInt64
-- | Creates a 'Literal' of type @Int64#@ without checking its range.
mkLitInt64Unchecked :: Integer -> Literal
@@ -385,8 +397,8 @@ mkLitWord64 x = ASSERT2( inWord64Range x, integer x ) (mkLitWord64Unchecked x)
-- | Creates a 'Literal' of type @Word64#@.
-- If the argument is out of the range, it is wrapped.
-mkLitWord64Wrap :: Platform -> Integer -> Literal
-mkLitWord64Wrap platform i = wrapLitNumber platform $ mkLitWord64Unchecked i
+mkLitWord64Wrap :: Integer -> Literal
+mkLitWord64Wrap = mkLitWord64Unchecked . wrapWord64
-- | Creates a 'Literal' of type @Word64#@ without checking its range.
mkLitWord64Unchecked :: Integer -> Literal
@@ -478,7 +490,30 @@ narrow8IntLit, narrow16IntLit, narrow32IntLit,
float2DoubleLit, double2FloatLit
:: Literal -> Literal
+maxBoundInt64, maxBoundWord64 :: Integer
+maxBoundInt64 = toInteger (maxBound :: Int64)
+maxBoundWord64 = toInteger (maxBound :: Word64)
+
+word64ToInt64Lit, int64ToWord64Lit :: Literal -> Literal
+
+word64ToInt64Lit (LitNumber LitNumWord64 w)
+ -- Map Word64 range [max_int64+1, max_word64]
+ -- to Int64 range [min_int64 , -1]
+ -- Range [0,max_int64] has the same representation with both Int64 and Word64
+ | w > maxBoundInt64 = mkLitInt64 $ w - maxBoundWord64 - 1
+ | otherwise = mkLitInt64 w
+word64ToInt64Lit l = pprPanic "word64ToInt64Lit" (ppr l)
+
+int64ToWord64Lit (LitNumber LitNumInt64 i)
+ -- Map Int64 range [min_int64 , -1]
+ -- to Word64 range [max_int64+1, max_word64]
+ -- Range [0,max_int64] has the same representation with both Int64 and Word64
+ | i < 0 = mkLitWord64 $ 1 + maxBoundWord64 + i
+ | otherwise = mkLitWord64 i
+int64ToWord64Lit l = pprPanic "int64ToWord64Lit" (ppr l)
+
word2IntLit, int2WordLit :: Platform -> Literal -> Literal
+
word2IntLit platform (LitNumber LitNumWord w)
-- Map Word range [max_int+1, max_word]
-- to Int range [min_int , -1]
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -54,10 +54,12 @@ module GHC.Utils.Outputable (
pprInfixVar, pprPrefixVar,
pprHsChar, pprHsString, pprHsBytes,
- primFloatSuffix, primCharSuffix, primWordSuffix, primDoubleSuffix,
- primInt64Suffix, primWord64Suffix, primIntSuffix,
+ primFloatSuffix, primCharSuffix, primDoubleSuffix,
+ primInt64Suffix, primWord64Suffix,
+ primIntSuffix, primWordSuffix,
- pprPrimChar, pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64,
+ pprPrimChar, pprPrimInt, pprPrimWord,
+ pprPrimInt64, pprPrimWord64,
pprFastFilePath, pprFilePathString,
@@ -1014,8 +1016,9 @@ pprHsBytes bs = let escaped = concatMap escape $ BS.unpack bs
-- Postfix modifiers for unboxed literals.
-- See Note [Printing of literals in Core] in "GHC.Types.Literal".
-primCharSuffix, primFloatSuffix, primIntSuffix :: SDoc
-primDoubleSuffix, primWordSuffix, primInt64Suffix, primWord64Suffix :: SDoc
+primCharSuffix, primFloatSuffix, primDoubleSuffix,
+ primIntSuffix, primWordSuffix,
+ primInt64Suffix, primWord64Suffix :: SDoc
primCharSuffix = char '#'
primFloatSuffix = char '#'
primIntSuffix = char '#'
@@ -1026,7 +1029,8 @@ primWord64Suffix = text "L##"
-- | Special combinator for showing unboxed literals.
pprPrimChar :: Char -> SDoc
-pprPrimInt, pprPrimWord, pprPrimInt64, pprPrimWord64 :: Integer -> SDoc
+pprPrimInt, pprPrimWord,
+ pprPrimInt64, pprPrimWord64 :: Integer -> SDoc
pprPrimChar c = pprHsChar c <> primCharSuffix
pprPrimInt i = integer i <> primIntSuffix
pprPrimWord w = word w <> primWordSuffix
=====================================
includes/stg/Prim.h
=====================================
@@ -68,8 +68,6 @@ StgWord16 hs_bitrev16(StgWord16 x);
StgWord32 hs_bitrev32(StgWord32 x);
StgWord64 hs_bitrev64(StgWord64 x);
-/* TODO: longlong.c */
-
/* libraries/ghc-prim/cbits/pdep.c */
StgWord64 hs_pdep64(StgWord64 src, StgWord64 mask);
StgWord hs_pdep32(StgWord src, StgWord mask);
=====================================
libraries/base/GHC/Exts.hs
=====================================
@@ -34,8 +34,6 @@ module GHC.Exts
module GHC.Prim,
module GHC.Prim.Ext,
shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
- uncheckedShiftL64#, uncheckedShiftRL64#,
- uncheckedIShiftL64#, uncheckedIShiftRA64#,
isTrue#,
-- * Compat wrapper
@@ -111,8 +109,8 @@ import GHC.Prim hiding ( coerce, TYPE )
import qualified GHC.Prim
import qualified GHC.Prim.Ext
import GHC.Base hiding ( coerce )
-import GHC.Word
-import GHC.Int
+import GHC.Word ()
+import GHC.Int ()
import GHC.Ptr
import GHC.Stack
=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -1421,11 +1421,7 @@ castWord64ToDouble :: Word64 -> Double
castWord64ToDouble (W64# w) = D# (stgWord64ToDouble w)
foreign import prim "stg_word64ToDoublezh"
-#if WORD_SIZE_IN_BITS == 64
- stgWord64ToDouble :: Word# -> Double#
-#else
stgWord64ToDouble :: Word64# -> Double#
-#endif
-- | @'castFloatToWord64' f@ does a bit-for-bit copy from a floating-point value
@@ -1438,8 +1434,4 @@ castDoubleToWord64 :: Double -> Word64
castDoubleToWord64 (D# d#) = W64# (stgDoubleToWord64 d#)
foreign import prim "stg_doubleToWord64zh"
-#if WORD_SIZE_IN_BITS == 64
- stgDoubleToWord64 :: Double# -> Word#
-#else
stgDoubleToWord64 :: Double# -> Word64#
-#endif
=====================================
libraries/base/GHC/Float/ConversionUtils.hs
=====================================
@@ -23,9 +23,6 @@ module GHC.Float.ConversionUtils ( elimZerosInteger, elimZerosInt# ) where
import GHC.Base
import GHC.Num.Integer
-#if WORD_SIZE_IN_BITS < 64
-import GHC.IntWord64
-#endif
default ()
=====================================
libraries/base/GHC/Float/RealFracMethods.hs
=====================================
@@ -1,5 +1,5 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK not-home #-}
-----------------------------------------------------------------------------
@@ -19,8 +19,6 @@
--
-----------------------------------------------------------------------------
-#include "MachDeps.h"
-
module GHC.Float.RealFracMethods
( -- * Double methods
-- ** Integer results
@@ -59,30 +57,6 @@ import GHC.Num.Integer
import GHC.Base
import GHC.Num ()
-#if WORD_SIZE_IN_BITS < 64
-
-import GHC.IntWord64
-
-#define TO64 integerToInt64#
-#define FROM64 integerFromInt64#
-#define MINUS64 minusInt64#
-#define NEGATE64 negateInt64#
-
-#else
-
-#define TO64 integerToInt#
-#define FROM64 IS
-#define MINUS64 ( -# )
-#define NEGATE64 negateInt#
-
-uncheckedIShiftRA64# :: Int# -> Int# -> Int#
-uncheckedIShiftRA64# = uncheckedIShiftRA#
-
-uncheckedIShiftL64# :: Int# -> Int# -> Int#
-uncheckedIShiftL64# = uncheckedIShiftL#
-
-#endif
-
default ()
------------------------------------------------------------------------------
@@ -237,21 +211,21 @@ properFractionDoubleInteger v@(D# x) =
case negateInt# e of
s | isTrue# (s ># 52#) -> (0, v)
| m < 0 ->
- case TO64 (integerNegate m) of
+ case integerToInt64# (integerNegate m) of
n ->
case n `uncheckedIShiftRA64#` s of
k ->
- (FROM64 (NEGATE64 k),
- case MINUS64 n (k `uncheckedIShiftL64#` s) of
+ (integerFromInt64# (negateInt64# k),
+ case subInt64# n (k `uncheckedIShiftL64#` s) of
r ->
- D# (integerEncodeDouble# (FROM64 (NEGATE64 r)) e))
+ D# (integerEncodeDouble# (integerFromInt64# (negateInt64# r)) e))
| otherwise ->
- case TO64 m of
+ case integerToInt64# m of
n ->
case n `uncheckedIShiftRA64#` s of
- k -> (FROM64 k,
- case MINUS64 n (k `uncheckedIShiftL64#` s) of
- r -> D# (integerEncodeDouble# (FROM64 r) e))
+ k -> (integerFromInt64# k,
+ case subInt64# n (k `uncheckedIShiftL64#` s) of
+ r -> D# (integerEncodeDouble# (integerFromInt64# r) e))
| otherwise -> (integerShiftL# m (int2Word# e), D# 0.0##)
{-# INLINE truncateDoubleInteger #-}
@@ -271,8 +245,8 @@ floorDoubleInteger (D# x) =
case negateInt# e of
s | isTrue# (s ># 52#) -> if m < 0 then (-1) else 0
| otherwise ->
- case TO64 m of
- n -> FROM64 (n `uncheckedIShiftRA64#` s)
+ case integerToInt64# m of
+ n -> integerFromInt64# (n `uncheckedIShiftRA64#` s)
| otherwise -> integerShiftL# m (int2Word# e)
{-# INLINE ceilingDoubleInteger #-}
@@ -313,8 +287,8 @@ double2Integer (D# x) =
case integerDecodeDouble# x of
(# m, e #)
| isTrue# (e <# 0#) ->
- case TO64 m of
- n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e)
+ case integerToInt64# m of
+ n -> integerFromInt64# (n `uncheckedIShiftRA64#` negateInt# e)
| otherwise -> integerShiftL# m (int2Word# e)
{-# INLINE float2Integer #-}
=====================================
libraries/base/GHC/Int.hs
=====================================
@@ -34,10 +34,6 @@ module GHC.Int (
import Data.Bits
import Data.Maybe
-#if WORD_SIZE_IN_BITS < 64
-import GHC.IntWord64
-#endif
-
import GHC.Base
import GHC.Enum
import GHC.Num
@@ -694,8 +690,6 @@ instance Ix Int32 where
-- type Int64
------------------------------------------------------------------------
-#if WORD_SIZE_IN_BITS < 64
-
data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64#
-- ^ 64-bit signed integer type
@@ -735,7 +729,7 @@ instance Show Int64 where
-- | @since 2.01
instance Num Int64 where
(I64# x#) + (I64# y#) = I64# (x# `plusInt64#` y#)
- (I64# x#) - (I64# y#) = I64# (x# `minusInt64#` y#)
+ (I64# x#) - (I64# y#) = I64# (x# `subInt64#` y#)
(I64# x#) * (I64# y#) = I64# (x# `timesInt64#` y#)
negate (I64# x#) = I64# (negateInt64# x#)
abs x | x >= 0 = x
@@ -807,9 +801,9 @@ divInt64#, modInt64# :: Int64# -> Int64# -> Int64#
-- Define div in terms of quot, being careful to avoid overflow (#7233)
x# `divInt64#` y#
| isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero)
- = ((x# `minusInt64#` one) `quotInt64#` y#) `minusInt64#` one
+ = ((x# `subInt64#` one) `quotInt64#` y#) `subInt64#` one
| isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
- = ((x# `plusInt64#` one) `quotInt64#` y#) `minusInt64#` one
+ = ((x# `plusInt64#` one) `quotInt64#` y#) `subInt64#` one
| otherwise
= x# `quotInt64#` y#
where
@@ -895,210 +889,14 @@ a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64#
-- No RULES for RealFrac methods if Int is smaller than Int64, we can't
-- go through Int and whether going through Integer is faster is uncertain.
-#else
-
--- Int64 is represented in the same way as Int.
--- Operations may assume and must ensure that it holds only values
--- from its logical range.
-
-data {-# CTYPE "HsInt64" #-} Int64 = I64# Int#
--- ^ 64-bit signed integer type
-
--- See GHC.Classes#matching_overloaded_methods_in_rules
--- | @since 2.01
-instance Eq Int64 where
- (==) = eqInt64
- (/=) = neInt64
-
-eqInt64, neInt64 :: Int64 -> Int64 -> Bool
-eqInt64 (I64# x) (I64# y) = isTrue# (x ==# y)
-neInt64 (I64# x) (I64# y) = isTrue# (x /=# y)
-{-# INLINE [1] eqInt64 #-}
-{-# INLINE [1] neInt64 #-}
-
--- | @since 2.01
-instance Ord Int64 where
- (<) = ltInt64
- (<=) = leInt64
- (>=) = geInt64
- (>) = gtInt64
-
-{-# INLINE [1] gtInt64 #-}
-{-# INLINE [1] geInt64 #-}
-{-# INLINE [1] ltInt64 #-}
-{-# INLINE [1] leInt64 #-}
-gtInt64, geInt64, ltInt64, leInt64 :: Int64 -> Int64 -> Bool
-(I64# x) `gtInt64` (I64# y) = isTrue# (x ># y)
-(I64# x) `geInt64` (I64# y) = isTrue# (x >=# y)
-(I64# x) `ltInt64` (I64# y) = isTrue# (x <# y)
-(I64# x) `leInt64` (I64# y) = isTrue# (x <=# y)
-
--- | @since 2.01
-instance Show Int64 where
- showsPrec p x = showsPrec p (fromIntegral x :: Int)
-
--- | @since 2.01
-instance Num Int64 where
- (I64# x#) + (I64# y#) = I64# (x# +# y#)
- (I64# x#) - (I64# y#) = I64# (x# -# y#)
- (I64# x#) * (I64# y#) = I64# (x# *# y#)
- negate (I64# x#) = I64# (negateInt# x#)
- abs x | x >= 0 = x
- | otherwise = negate x
- signum x | x > 0 = 1
- signum 0 = 0
- signum _ = -1
- fromInteger i = I64# (integerToInt# i)
-
--- | @since 2.01
-instance Enum Int64 where
- succ x
- | x /= maxBound = x + 1
- | otherwise = succError "Int64"
- pred x
- | x /= minBound = x - 1
- | otherwise = predError "Int64"
- toEnum (I# i#) = I64# i#
- fromEnum (I64# x#) = I# x#
- enumFrom = boundedEnumFrom
- enumFromThen = boundedEnumFromThen
-
--- | @since 2.01
-instance Integral Int64 where
- quot x@(I64# x#) y@(I64# y#)
- | y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
- | otherwise = I64# (x# `quotInt#` y#)
- rem (I64# x#) y@(I64# y#)
- | y == 0 = divZeroError
- -- The quotRem CPU instruction fails for minBound `quotRem` -1,
- -- but minBound `rem` -1 is well-defined (0). We therefore
- -- special-case it.
- | y == (-1) = 0
- | otherwise = I64# (x# `remInt#` y#)
- div x@(I64# x#) y@(I64# y#)
- | y == 0 = divZeroError
- | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
- | otherwise = I64# (x# `divInt#` y#)
- mod (I64# x#) y@(I64# y#)
- | y == 0 = divZeroError
- -- The divMod CPU instruction fails for minBound `divMod` -1,
- -- but minBound `mod` -1 is well-defined (0). We therefore
- -- special-case it.
- | y == (-1) = 0
- | otherwise = I64# (x# `modInt#` y#)
- quotRem x@(I64# x#) y@(I64# y#)
- | y == 0 = divZeroError
- -- Note [Order of tests]
- | y == (-1) && x == minBound = (overflowError, 0)
- | otherwise = case x# `quotRemInt#` y# of
- (# q, r #) ->
- (I64# q, I64# r)
- divMod x@(I64# x#) y@(I64# y#)
- | y == 0 = divZeroError
- -- Note [Order of tests]
- | y == (-1) && x == minBound = (overflowError, 0)
- | otherwise = case x# `divModInt#` y# of
- (# d, m #) ->
- (I64# d, I64# m)
- toInteger (I64# x#) = IS x#
-
--- | @since 2.01
-instance Read Int64 where
- readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
-
--- | @since 2.01
-instance Bits Int64 where
- {-# INLINE shift #-}
- {-# INLINE bit #-}
- {-# INLINE testBit #-}
- {-# INLINE popCount #-}
-
- (I64# x#) .&. (I64# y#) = I64# (x# `andI#` y#)
- (I64# x#) .|. (I64# y#) = I64# (x# `orI#` y#)
- (I64# x#) `xor` (I64# y#) = I64# (x# `xorI#` y#)
- complement (I64# x#) = I64# (notI# x#)
- (I64# x#) `shift` (I# i#)
- | isTrue# (i# >=# 0#) = I64# (x# `iShiftL#` i#)
- | otherwise = I64# (x# `iShiftRA#` negateInt# i#)
- (I64# x#) `shiftL` (I# i#)
- | isTrue# (i# >=# 0#) = I64# (x# `iShiftL#` i#)
- | otherwise = overflowError
- (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL#` i#)
- (I64# x#) `shiftR` (I# i#)
- | isTrue# (i# >=# 0#) = I64# (x# `iShiftRA#` i#)
- | otherwise = overflowError
- (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA#` i#)
- (I64# x#) `rotate` (I# i#)
- | isTrue# (i'# ==# 0#)
- = I64# x#
- | otherwise
- = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
- (x'# `uncheckedShiftRL#` (64# -# i'#))))
- where
- !x'# = int2Word# x#
- !i'# = word2Int# (int2Word# i# `and#` 63##)
- bitSizeMaybe i = Just (finiteBitSize i)
- bitSize i = finiteBitSize i
- isSigned _ = True
- popCount (I64# x#) = I# (word2Int# (popCnt64# (int2Word# x#)))
- bit = bitDefault
- testBit = testBitDefault
-
-{-# RULES
-"fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x#
-"fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#)
- #-}
-
-{-# RULES
-"properFraction/Float->(Int64,Float)"
- properFraction = \x ->
- case properFraction x of {
- (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Float) }
-"truncate/Float->Int64"
- truncate = (fromIntegral :: Int -> Int64) . (truncate :: Float -> Int)
-"floor/Float->Int64"
- floor = (fromIntegral :: Int -> Int64) . (floor :: Float -> Int)
-"ceiling/Float->Int64"
- ceiling = (fromIntegral :: Int -> Int64) . (ceiling :: Float -> Int)
-"round/Float->Int64"
- round = (fromIntegral :: Int -> Int64) . (round :: Float -> Int)
- #-}
-
-{-# RULES
-"properFraction/Double->(Int64,Double)"
- properFraction = \x ->
- case properFraction x of {
- (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Double) }
-"truncate/Double->Int64"
- truncate = (fromIntegral :: Int -> Int64) . (truncate :: Double -> Int)
-"floor/Double->Int64"
- floor = (fromIntegral :: Int -> Int64) . (floor :: Double -> Int)
-"ceiling/Double->Int64"
- ceiling = (fromIntegral :: Int -> Int64) . (ceiling :: Double -> Int)
-"round/Double->Int64"
- round = (fromIntegral :: Int -> Int64) . (round :: Double -> Int)
- #-}
-
-uncheckedIShiftL64# :: Int# -> Int# -> Int#
-uncheckedIShiftL64# = uncheckedIShiftL#
-
-uncheckedIShiftRA64# :: Int# -> Int# -> Int#
-uncheckedIShiftRA64# = uncheckedIShiftRA#
-#endif
-- | @since 4.6.0.0
instance FiniteBits Int64 where
{-# INLINE countLeadingZeros #-}
{-# INLINE countTrailingZeros #-}
finiteBitSize _ = 64
-#if WORD_SIZE_IN_BITS < 64
countLeadingZeros (I64# x#) = I# (word2Int# (clz64# (int64ToWord64# x#)))
countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int64ToWord64# x#)))
-#else
- countLeadingZeros (I64# x#) = I# (word2Int# (clz64# (int2Word# x#)))
- countTrailingZeros (I64# x#) = I# (word2Int# (ctz64# (int2Word# x#)))
-#endif
-- | @since 2.01
instance Real Int64 where
=====================================
libraries/base/GHC/StaticPtr.hs
=====================================
@@ -59,14 +59,9 @@ import GHC.Word (Word64(..))
#include "MachDeps.h"
-- | A reference to a value of type @a at .
-#if WORD_SIZE_IN_BITS < 64
data StaticPtr a = StaticPtr Word64# Word64# -- The flattened Fingerprint is
-- convenient in the compiler.
StaticPtrInfo a
-#else
-data StaticPtr a = StaticPtr Word# Word#
- StaticPtrInfo a
-#endif
-- | Dereferences a static pointer.
deRefStaticPtr :: StaticPtr a -> a
deRefStaticPtr (StaticPtr _ _ _ v) = v
=====================================
libraries/base/GHC/Word.hs
=====================================
@@ -49,10 +49,6 @@ module GHC.Word (
import Data.Bits
import Data.Maybe
-#if WORD_SIZE_IN_BITS < 64
-import GHC.IntWord64
-#endif
-
import GHC.Base
import GHC.Enum
import GHC.Num
@@ -685,8 +681,6 @@ byteSwap32 (W32# w#) = W32# (narrow32Word# (byteSwap32# w#))
-- type Word64
------------------------------------------------------------------------
-#if WORD_SIZE_IN_BITS < 64
-
data {-# CTYPE "HsWord64" #-} Word64 = W64# Word64#
-- ^ 64-bit unsigned integer type
@@ -722,7 +716,7 @@ gtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool
-- | @since 2.01
instance Num Word64 where
(W64# x#) + (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `plusInt64#` word64ToInt64# y#))
- (W64# x#) - (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `minusInt64#` word64ToInt64# y#))
+ (W64# x#) - (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `subInt64#` word64ToInt64# y#))
(W64# x#) * (W64# y#) = W64# (int64ToWord64# (word64ToInt64# x# `timesInt64#` word64ToInt64# y#))
negate (W64# x#) = W64# (int64ToWord64# (negateInt64# (word64ToInt64# x#)))
abs x = x
@@ -828,184 +822,13 @@ a `shiftRL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0##
"fromIntegral/Word64->Word64" fromIntegral = id :: Word64 -> Word64
#-}
-#else
-
--- Word64 is represented in the same way as Word.
--- Operations may assume and must ensure that it holds only values
--- from its logical range.
-
-data {-# CTYPE "HsWord64" #-} Word64 = W64# Word#
--- ^ 64-bit unsigned integer type
-
--- See GHC.Classes#matching_overloaded_methods_in_rules
--- | @since 2.01
-instance Eq Word64 where
- (==) = eqWord64
- (/=) = neWord64
-
-eqWord64, neWord64 :: Word64 -> Word64 -> Bool
-eqWord64 (W64# x) (W64# y) = isTrue# (x `eqWord#` y)
-neWord64 (W64# x) (W64# y) = isTrue# (x `neWord#` y)
-{-# INLINE [1] eqWord64 #-}
-{-# INLINE [1] neWord64 #-}
-
--- | @since 2.01
-instance Ord Word64 where
- (<) = ltWord64
- (<=) = leWord64
- (>=) = geWord64
- (>) = gtWord64
-
-{-# INLINE [1] gtWord64 #-}
-{-# INLINE [1] geWord64 #-}
-{-# INLINE [1] ltWord64 #-}
-{-# INLINE [1] leWord64 #-}
-gtWord64, geWord64, ltWord64, leWord64 :: Word64 -> Word64 -> Bool
-(W64# x) `gtWord64` (W64# y) = isTrue# (x `gtWord#` y)
-(W64# x) `geWord64` (W64# y) = isTrue# (x `geWord#` y)
-(W64# x) `ltWord64` (W64# y) = isTrue# (x `ltWord#` y)
-(W64# x) `leWord64` (W64# y) = isTrue# (x `leWord#` y)
-
--- | @since 2.01
-instance Num Word64 where
- (W64# x#) + (W64# y#) = W64# (x# `plusWord#` y#)
- (W64# x#) - (W64# y#) = W64# (x# `minusWord#` y#)
- (W64# x#) * (W64# y#) = W64# (x# `timesWord#` y#)
- negate (W64# x#) = W64# (int2Word# (negateInt# (word2Int# x#)))
- abs x = x
- signum 0 = 0
- signum _ = 1
- fromInteger i = W64# (integerToWord# i)
-
--- | @since 2.01
-instance Enum Word64 where
- succ x
- | x /= maxBound = x + 1
- | otherwise = succError "Word64"
- pred x
- | x /= minBound = x - 1
- | otherwise = predError "Word64"
- toEnum i@(I# i#)
- | i >= 0 = W64# (int2Word# i#)
- | otherwise = toEnumError "Word64" i (minBound::Word64, maxBound::Word64)
- fromEnum x@(W64# x#)
- | x <= fromIntegral (maxBound::Int)
- = I# (word2Int# x#)
- | otherwise = fromEnumError "Word64" x
-
-#if WORD_SIZE_IN_BITS < 64
- enumFrom = integralEnumFrom
- enumFromThen = integralEnumFromThen
- enumFromTo = integralEnumFromTo
- enumFromThenTo = integralEnumFromThenTo
-#else
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINABLE enumFrom #-}
- enumFrom w
- = map wordToWord64
- $ enumFrom (word64ToWord w)
-
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINABLE enumFromThen #-}
- enumFromThen w s
- = map wordToWord64
- $ enumFromThen (word64ToWord w) (word64ToWord s)
-
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINABLE enumFromTo #-}
- enumFromTo w1 w2
- = map wordToWord64
- $ enumFromTo (word64ToWord w1) (word64ToWord w2)
-
- -- See Note [Stable Unfolding for list producers] in GHC.Enum
- {-# INLINABLE enumFromThenTo #-}
- enumFromThenTo w1 s w2
- = map wordToWord64
- $ enumFromThenTo (word64ToWord w1) (word64ToWord s) (word64ToWord w2)
-
-word64ToWord :: Word64 -> Word
-word64ToWord (W64# w#) = (W# w#)
-
-wordToWord64 :: Word -> Word64
-wordToWord64 (W# w#) = (W64# w#)
-#endif
-
-
--- | @since 2.01
-instance Integral Word64 where
- quot (W64# x#) y@(W64# y#)
- | y /= 0 = W64# (x# `quotWord#` y#)
- | otherwise = divZeroError
- rem (W64# x#) y@(W64# y#)
- | y /= 0 = W64# (x# `remWord#` y#)
- | otherwise = divZeroError
- div (W64# x#) y@(W64# y#)
- | y /= 0 = W64# (x# `quotWord#` y#)
- | otherwise = divZeroError
- mod (W64# x#) y@(W64# y#)
- | y /= 0 = W64# (x# `remWord#` y#)
- | otherwise = divZeroError
- quotRem (W64# x#) y@(W64# y#)
- | y /= 0 = case x# `quotRemWord#` y# of
- (# q, r #) ->
- (W64# q, W64# r)
- | otherwise = divZeroError
- divMod (W64# x#) y@(W64# y#)
- | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#))
- | otherwise = divZeroError
- toInteger (W64# x#)
- | isTrue# (i# >=# 0#) = IS i#
- | otherwise = integerFromWord# x#
- where
- !i# = word2Int# x#
-
--- | @since 2.01
-instance Bits Word64 where
- {-# INLINE shift #-}
- {-# INLINE bit #-}
- {-# INLINE testBit #-}
- {-# INLINE popCount #-}
-
- (W64# x#) .&. (W64# y#) = W64# (x# `and#` y#)
- (W64# x#) .|. (W64# y#) = W64# (x# `or#` y#)
- (W64# x#) `xor` (W64# y#) = W64# (x# `xor#` y#)
- complement (W64# x#) = W64# (x# `xor#` mb#)
- where !(W64# mb#) = maxBound
- (W64# x#) `shift` (I# i#)
- | isTrue# (i# >=# 0#) = W64# (x# `shiftL#` i#)
- | otherwise = W64# (x# `shiftRL#` negateInt# i#)
- (W64# x#) `shiftL` (I# i#)
- | isTrue# (i# >=# 0#) = W64# (x# `shiftL#` i#)
- | otherwise = overflowError
- (W64# x#) `unsafeShiftL` (I# i#) = W64# (x# `uncheckedShiftL#` i#)
- (W64# x#) `shiftR` (I# i#)
- | isTrue# (i# >=# 0#) = W64# (x# `shiftRL#` i#)
- | otherwise = overflowError
- (W64# x#) `unsafeShiftR` (I# i#) = W64# (x# `uncheckedShiftRL#` i#)
- (W64# x#) `rotate` (I# i#)
- | isTrue# (i'# ==# 0#) = W64# x#
- | otherwise = W64# ((x# `uncheckedShiftL#` i'#) `or#`
- (x# `uncheckedShiftRL#` (64# -# i'#)))
- where
- !i'# = word2Int# (int2Word# i# `and#` 63##)
- bitSizeMaybe i = Just (finiteBitSize i)
- bitSize i = finiteBitSize i
- isSigned _ = False
- popCount (W64# x#) = I# (word2Int# (popCnt64# x#))
- bit = bitDefault
- testBit = testBitDefault
+#if WORD_SIZE_IN_BITS == 64
{-# RULES
-"fromIntegral/a->Word64" fromIntegral = \x -> case fromIntegral x of W# x# -> W64# x#
-"fromIntegral/Word64->a" fromIntegral = \(W64# x#) -> fromIntegral (W# x#)
+"fromIntegral/a->Word64" fromIntegral = \x -> case fromIntegral x of W# x# -> W64# (wordToWord64# x#)
+"fromIntegral/Word64->a" fromIntegral = \(W64# x#) -> fromIntegral (W# (word64ToWord# x#))
#-}
-uncheckedShiftL64# :: Word# -> Int# -> Word#
-uncheckedShiftL64# = uncheckedShiftL#
-
-uncheckedShiftRL64# :: Word# -> Int# -> Word#
-uncheckedShiftRL64# = uncheckedShiftRL#
-
#endif
-- | @since 4.6.0.0
@@ -1038,13 +861,8 @@ instance Ix Word64 where
-- | Reverse order of bytes in 'Word64'.
--
-- @since 4.7.0.0
-#if WORD_SIZE_IN_BITS < 64
byteSwap64 :: Word64 -> Word64
byteSwap64 (W64# w#) = W64# (byteSwap64# w#)
-#else
-byteSwap64 :: Word64 -> Word64
-byteSwap64 (W64# w#) = W64# (byteSwap# w#)
-#endif
-- | Reverse the order of the bits in a 'Word8'.
--
@@ -1067,13 +885,8 @@ bitReverse32 (W32# w#) = W32# (narrow32Word# (bitReverse32# w#))
-- | Reverse the order of the bits in a 'Word64'.
--
-- @since 4.12.0.0
-#if WORD_SIZE_IN_BITS < 64
bitReverse64 :: Word64 -> Word64
bitReverse64 (W64# w#) = W64# (bitReverse64# w#)
-#else
-bitReverse64 :: Word64 -> Word64
-bitReverse64 (W64# w#) = W64# (bitReverse# w#)
-#endif
-------------------------------------------------------------------------------
=====================================
libraries/binary
=====================================
@@ -1 +1 @@
-Subproject commit dfaf780596328c9184758452b78288e8f405fcc1
+Subproject commit 6dc8fa9cb4f51fb4253925f02b78478784d6bbbe
=====================================
libraries/bytestring
=====================================
@@ -1 +1 @@
-Subproject commit e6cb01e2ec0bfdd19298418c85f220925a9fa307
+Subproject commit 8e50cfe3321107638dcf5e14a9c0d3cebe5bbf1c
=====================================
libraries/ghc-bignum/src/GHC/Num/BigNat.hs
=====================================
@@ -24,10 +24,6 @@ import GHC.Magic
import GHC.Num.Primitives
import GHC.Num.WordArray
-#if WORD_SIZE_IN_BITS < 64
-import GHC.IntWord64
-#endif
-
#if defined(BIGNUM_CHECK)
import GHC.Num.BigNat.Check
@@ -246,8 +242,6 @@ bigNatToInt# a
bigNatToInt :: BigNat -> Int
bigNatToInt bn = I# (bigNatToInt# bn)
-#if WORD_SIZE_IN_BITS == 32
-
-- | Convert a Word64# into a BigNat on 32-bit architectures
bigNatFromWord64# :: Word64# -> BigNat
bigNatFromWord64# w64 = bigNatFromWord2# wh# wl#
@@ -266,8 +260,6 @@ bigNatToWord64# b
in uncheckedShiftL64# wh 32# `or64#` wl
else wl
-#endif
-
-- | Encode (# BigNat mantissa, Int# exponent #) into a Double#
bigNatEncodeDouble# :: BigNat -> Int# -> Double#
bigNatEncodeDouble# a e
=====================================
libraries/ghc-bignum/src/GHC/Num/Integer.hs
=====================================
@@ -32,10 +32,6 @@ import GHC.Num.Primitives
import GHC.Num.BigNat
import GHC.Num.Natural
-#if WORD_SIZE_IN_BITS < 64
-import GHC.IntWord64
-#endif
-
default ()
-- | Arbitrary precision integers. In contrast with fixed-size integral types
@@ -974,8 +970,6 @@ integerIsPowerOf2# (IS i)
integerIsPowerOf2# (IN _) = (# () | #)
integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w
-#if WORD_SIZE_IN_BITS == 32
-
-- | Convert an Int64# into an Integer on 32-bit architectures
integerFromInt64# :: Int64# -> Integer
{-# NOINLINE integerFromInt64# #-}
@@ -1013,14 +1007,6 @@ integerToWord64# (IS i) = int64ToWord64# (intToInt64# i)
integerToWord64# (IP b) = bigNatToWord64# b
integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64# b)))
-#else
-
--- | Convert an Int64# into an Integer on 64-bit architectures
-integerFromInt64# :: Int# -> Integer
-integerFromInt64# !x = IS x
-
-#endif
-
----------------------------------------------------------------------------
-- Conversions to/from floating point
----------------------------------------------------------------------------
=====================================
libraries/ghc-prim/GHC/Classes.hs
=====================================
@@ -55,7 +55,6 @@ module GHC.Classes(
-- GHC.Magic is used in some derived instances
import GHC.Magic ()
-import GHC.IntWord64
import GHC.Prim
import GHC.Tuple
import GHC.CString (unpackCString#)
@@ -279,7 +278,6 @@ eqInt, neInt :: Int -> Int -> Bool
(I# x) `eqInt` (I# y) = isTrue# (x ==# y)
(I# x) `neInt` (I# y) = isTrue# (x /=# y)
-#if WORD_SIZE_IN_BITS < 64
instance Eq TyCon where
(==) (TyCon hi1 lo1 _ _ _ _) (TyCon hi2 lo2 _ _ _ _)
= isTrue# (hi1 `eqWord64#` hi2) && isTrue# (lo1 `eqWord64#` lo2)
@@ -290,18 +288,6 @@ instance Ord TyCon where
| isTrue# (lo1 `gtWord64#` lo2) = GT
| isTrue# (lo1 `ltWord64#` lo2) = LT
| True = EQ
-#else
-instance Eq TyCon where
- (==) (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 _ _ _ _)
- | isTrue# (hi1 `gtWord#` hi2) = GT
- | isTrue# (hi1 `ltWord#` hi2) = LT
- | isTrue# (lo1 `gtWord#` lo2) = GT
- | isTrue# (lo1 `ltWord#` lo2) = LT
- | True = EQ
-#endif
-- | The 'Ord' class is used for totally ordered datatypes.
=====================================
libraries/ghc-prim/GHC/IntWord64.hs deleted
=====================================
@@ -1,74 +0,0 @@
-{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude, UnliftedFFITypes #-}
-{-# OPTIONS_HADDOCK not-home #-}
------------------------------------------------------------------------------
--- |
--- Module : GHC.IntWord64
--- Copyright : (c) The University of Glasgow, 1997-2008
--- License : see libraries/ghc-prim/LICENSE
---
--- Maintainer : cvs-ghc at haskell.org
--- Stability : internal
--- Portability : non-portable (GHC Extensions)
---
--- Primitive operations on Int64# and Word64# on platforms where
--- WORD_SIZE_IN_BITS < 64.
---
------------------------------------------------------------------------------
-
-#include "MachDeps.h"
-
-module GHC.IntWord64 (
-#if WORD_SIZE_IN_BITS < 64
- Int64#, Word64#, module GHC.IntWord64
-#endif
- ) where
-
-import GHC.Types () -- Make implicit dependency known to build system
-
-#if WORD_SIZE_IN_BITS < 64
-
-import GHC.Prim
-
-foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Int#
-foreign import ccall unsafe "hs_neWord64" neWord64# :: Word64# -> Word64# -> Int#
-foreign import ccall unsafe "hs_ltWord64" ltWord64# :: Word64# -> Word64# -> Int#
-foreign import ccall unsafe "hs_leWord64" leWord64# :: Word64# -> Word64# -> Int#
-foreign import ccall unsafe "hs_gtWord64" gtWord64# :: Word64# -> Word64# -> Int#
-foreign import ccall unsafe "hs_geWord64" geWord64# :: Word64# -> Word64# -> Int#
-
-foreign import ccall unsafe "hs_eqInt64" eqInt64# :: Int64# -> Int64# -> Int#
-foreign import ccall unsafe "hs_neInt64" neInt64# :: Int64# -> Int64# -> Int#
-foreign import ccall unsafe "hs_ltInt64" ltInt64# :: Int64# -> Int64# -> Int#
-foreign import ccall unsafe "hs_leInt64" leInt64# :: Int64# -> Int64# -> Int#
-foreign import ccall unsafe "hs_gtInt64" gtInt64# :: Int64# -> Int64# -> Int#
-foreign import ccall unsafe "hs_geInt64" geInt64# :: Int64# -> Int64# -> Int#
-foreign import ccall unsafe "hs_quotInt64" quotInt64# :: Int64# -> Int64# -> Int64#
-foreign import ccall unsafe "hs_remInt64" remInt64# :: Int64# -> Int64# -> Int64#
-
-foreign import ccall unsafe "hs_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64#
-foreign import ccall unsafe "hs_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64#
-foreign import ccall unsafe "hs_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64#
-foreign import ccall unsafe "hs_negateInt64" negateInt64# :: Int64# -> Int64#
-foreign import ccall unsafe "hs_quotWord64" quotWord64# :: Word64# -> Word64# -> Word64#
-foreign import ccall unsafe "hs_remWord64" remWord64# :: Word64# -> Word64# -> Word64#
-
-foreign import ccall unsafe "hs_and64" and64# :: Word64# -> Word64# -> Word64#
-foreign import ccall unsafe "hs_or64" or64# :: Word64# -> Word64# -> Word64#
-foreign import ccall unsafe "hs_xor64" xor64# :: Word64# -> Word64# -> Word64#
-foreign import ccall unsafe "hs_not64" not64# :: Word64# -> Word64#
-
-foreign import ccall unsafe "hs_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64#
-foreign import ccall unsafe "hs_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
-foreign import ccall unsafe "hs_uncheckedIShiftL64" uncheckedIShiftL64# :: Int64# -> Int# -> Int64#
-foreign import ccall unsafe "hs_uncheckedIShiftRA64" uncheckedIShiftRA64# :: Int64# -> Int# -> Int64#
-foreign import ccall unsafe "hs_uncheckedIShiftRL64" uncheckedIShiftRL64# :: Int64# -> Int# -> Int64#
-
-foreign import ccall unsafe "hs_int64ToWord64" int64ToWord64# :: Int64# -> Word64#
-foreign import ccall unsafe "hs_word64ToInt64" word64ToInt64# :: Word64# -> Int64#
-foreign import ccall unsafe "hs_intToInt64" intToInt64# :: Int# -> Int64#
-foreign import ccall unsafe "hs_int64ToInt" int64ToInt# :: Int64# -> Int#
-foreign import ccall unsafe "hs_wordToWord64" wordToWord64# :: Word# -> Word64#
-foreign import ccall unsafe "hs_word64ToWord" word64ToWord# :: Word64# -> Word#
-
-#endif
-
=====================================
libraries/ghc-prim/GHC/Prim/Ext.hs
=====================================
@@ -26,17 +26,14 @@
-- are described over there.
module GHC.Prim.Ext
(
- -- 64-bit bit aliases
- INT64
- , WORD64
+ -- * Misc
+ getThreadAllocationCounter#
-- * Delay\/wait operations
#if defined(mingw32_HOST_OS)
, asyncRead#
, asyncWrite#
, asyncDoProc#
#endif
- -- * Misc
- , getThreadAllocationCounter#
) where
import GHC.Prim
@@ -44,24 +41,6 @@ import GHC.Types () -- Make implicit dependency known to build system
default () -- Double and Integer aren't available yet
-------------------------------------------------------------------------
--- 64-bit bit aliases
-------------------------------------------------------------------------
-
-type INT64 =
-#if WORD_SIZE_IN_BITS < 64
- Int64#
-#else
- Int#
-#endif
-
-type WORD64 =
-#if WORD_SIZE_IN_BITS < 64
- Word64#
-#else
- Word#
-#endif
-
------------------------------------------------------------------------
-- Delay/wait operations
------------------------------------------------------------------------
@@ -102,4 +81,4 @@ foreign import prim "stg_asyncDoProczh" asyncDoProc#
-- | Retrieves the allocation counter for the current thread.
foreign import prim "stg_getThreadAllocationCounterzh" getThreadAllocationCounter#
:: State# RealWorld
- -> (# State# RealWorld, INT64 #)
+ -> (# State# RealWorld, Int64# #)
=====================================
libraries/ghc-prim/GHC/Types.hs
=====================================
@@ -1,5 +1,5 @@
{-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples,
- MultiParamTypeClasses, RoleAnnotations, CPP, TypeOperators,
+ MultiParamTypeClasses, RoleAnnotations, TypeOperators,
PolyKinds, NegativeLiterals, DataKinds #-}
-- NegativeLiterals: see Note [Fixity of (->)]
-----------------------------------------------------------------------------
@@ -485,8 +485,6 @@ or Module (for example when deserialising a TypeRep), in which case we
can't conveniently come up with an Addr#.
-}
-#include "MachDeps.h"
-
data Module = Module
TrName -- Package name
TrName -- Module name
@@ -498,12 +496,6 @@ data TrName
-- | A de Bruijn index for a binder within a 'KindRep'.
type KindBndr = Int
-#if WORD_SIZE_IN_BITS < 64
-#define WORD64_TY Word64#
-#else
-#define WORD64_TY Word#
-#endif
-
-- | The representation produced by GHC for conjuring up the kind of a
-- 'Data.Typeable.TypeRep'.
@@ -520,7 +512,7 @@ data TypeLitSort = TypeLitSymbol
| TypeLitNat
-- Show instance for TyCon found in GHC.Show
-data TyCon = TyCon WORD64_TY WORD64_TY -- Fingerprint
+data TyCon = TyCon Word64# Word64# -- Fingerprint
Module -- Module in which this is defined
TrName -- Type constructor name
Int# -- How many kind variables do we accept?
=====================================
libraries/ghc-prim/cbits/atomic.c
=====================================
@@ -33,14 +33,12 @@ hs_atomic_add32(StgWord x, StgWord val)
return __sync_fetch_and_add((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_add64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_add64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_add((volatile StgWord64 *) x, val);
}
-#endif
// FetchSubByteArrayOp_Int
@@ -65,14 +63,12 @@ hs_atomic_sub32(StgWord x, StgWord val)
return __sync_fetch_and_sub((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_sub64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_sub64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_sub((volatile StgWord64 *) x, val);
}
-#endif
// FetchAndByteArrayOp_Int
@@ -97,14 +93,12 @@ hs_atomic_and32(StgWord x, StgWord val)
return __sync_fetch_and_and((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_and64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_and64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_and((volatile StgWord64 *) x, val);
}
-#endif
// FetchNandByteArrayOp_Int
@@ -207,7 +201,6 @@ hs_atomic_nand32(StgWord x, StgWord val)
#endif
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_nand64(StgWord x, StgWord64 val)
@@ -218,7 +211,6 @@ hs_atomic_nand64(StgWord x, StgWord64 val)
CAS_NAND((volatile StgWord64 *) x, val);
#endif
}
-#endif
#pragma GCC diagnostic pop
@@ -245,14 +237,12 @@ hs_atomic_or32(StgWord x, StgWord val)
return __sync_fetch_and_or((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_or64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_or64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_or((volatile StgWord64 *) x, val);
}
-#endif
// FetchXorByteArrayOp_Int
@@ -277,14 +267,12 @@ hs_atomic_xor32(StgWord x, StgWord val)
return __sync_fetch_and_xor((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_xor64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_xor((volatile StgWord64 *) x, val);
}
-#endif
// CasByteArrayOp_Int
@@ -309,14 +297,12 @@ hs_cmpxchg32(StgWord x, StgWord old, StgWord new)
return __sync_val_compare_and_swap((volatile StgWord32 *) x, (StgWord32) old, (StgWord32) new);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new);
StgWord
hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new)
{
return __sync_val_compare_and_swap((volatile StgWord64 *) x, old, new);
}
-#endif
// Atomic exchange operations
=====================================
libraries/ghc-prim/cbits/longlong.c deleted
=====================================
@@ -1,89 +0,0 @@
-/* -----------------------------------------------------------------------------
- * $Id: longlong.c,v 1.4 2002/12/13 14:23:42 simonmar Exp $
- *
- * (c) The GHC Team, 1998-1999
- *
- * Primitive operations over (64-bit) long longs
- * (only used on 32-bit platforms.)
- *
- * ---------------------------------------------------------------------------*/
-
-
-/*
-Miscellaneous primitive operations on HsInt64 and HsWord64s.
-N.B. These are not primops!
-
-Instead of going the normal (boring) route of making the list
-of primitive operations even longer to cope with operations
-over 64-bit entities, we implement them instead 'out-of-line'.
-
-The primitive ops get their own routine (in C) that implements
-the operation, requiring the caller to _ccall_ out. This has
-performance implications of course, but we currently don't
-expect intensive use of either Int64 or Word64 types.
-
-The exceptions to the rule are primops that cast to and from
-64-bit entities (these are defined in PrimOps.h)
-*/
-
-#include "Rts.h"
-
-#if WORD_SIZE_IN_BITS < 64
-
-/* Relational operators */
-
-HsInt hs_gtWord64 (HsWord64 a, HsWord64 b) {return a > b;}
-HsInt hs_geWord64 (HsWord64 a, HsWord64 b) {return a >= b;}
-HsInt hs_eqWord64 (HsWord64 a, HsWord64 b) {return a == b;}
-HsInt hs_neWord64 (HsWord64 a, HsWord64 b) {return a != b;}
-HsInt hs_ltWord64 (HsWord64 a, HsWord64 b) {return a < b;}
-HsInt hs_leWord64 (HsWord64 a, HsWord64 b) {return a <= b;}
-
-HsInt hs_gtInt64 (HsInt64 a, HsInt64 b) {return a > b;}
-HsInt hs_geInt64 (HsInt64 a, HsInt64 b) {return a >= b;}
-HsInt hs_eqInt64 (HsInt64 a, HsInt64 b) {return a == b;}
-HsInt hs_neInt64 (HsInt64 a, HsInt64 b) {return a != b;}
-HsInt hs_ltInt64 (HsInt64 a, HsInt64 b) {return a < b;}
-HsInt hs_leInt64 (HsInt64 a, HsInt64 b) {return a <= b;}
-
-/* Arithmetic operators */
-
-HsWord64 hs_remWord64 (HsWord64 a, HsWord64 b) {return a % b;}
-HsWord64 hs_quotWord64 (HsWord64 a, HsWord64 b) {return a / b;}
-
-HsInt64 hs_remInt64 (HsInt64 a, HsInt64 b) {return a % b;}
-HsInt64 hs_quotInt64 (HsInt64 a, HsInt64 b) {return a / b;}
-HsInt64 hs_negateInt64 (HsInt64 a) {return -a;}
-HsInt64 hs_plusInt64 (HsInt64 a, HsInt64 b) {return a + b;}
-HsInt64 hs_minusInt64 (HsInt64 a, HsInt64 b) {return a - b;}
-HsInt64 hs_timesInt64 (HsInt64 a, HsInt64 b) {return a * b;}
-
-/* Logical operators: */
-
-HsWord64 hs_and64 (HsWord64 a, HsWord64 b) {return a & b;}
-HsWord64 hs_or64 (HsWord64 a, HsWord64 b) {return a | b;}
-HsWord64 hs_xor64 (HsWord64 a, HsWord64 b) {return a ^ b;}
-HsWord64 hs_not64 (HsWord64 a) {return ~a;}
-
-HsWord64 hs_uncheckedShiftL64 (HsWord64 a, HsInt b) {return a << b;}
-HsWord64 hs_uncheckedShiftRL64 (HsWord64 a, HsInt b) {return a >> b;}
-/* Right shifting of signed quantities is not portable in C, so
- the behaviour you'll get from using these primops depends
- on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98
-*/
-HsInt64 hs_uncheckedIShiftL64 (HsInt64 a, HsInt b) {return a << b;}
-HsInt64 hs_uncheckedIShiftRA64 (HsInt64 a, HsInt b) {return a >> b;}
-HsInt64 hs_uncheckedIShiftRL64 (HsInt64 a, HsInt b)
- {return (HsInt64) ((HsWord64) a >> b);}
-
-/* Casting between longs and longer longs.
-*/
-
-HsInt64 hs_intToInt64 (HsInt i) {return (HsInt64) i;}
-HsInt hs_int64ToInt (HsInt64 i) {return (HsInt) i;}
-HsWord64 hs_int64ToWord64 (HsInt64 i) {return (HsWord64) i;}
-HsWord64 hs_wordToWord64 (HsWord w) {return (HsWord64) w;}
-HsWord hs_word64ToWord (HsWord64 w) {return (HsWord) w;}
-HsInt64 hs_word64ToInt64 (HsWord64 w) {return (HsInt64) w;}
-
-#endif /* SUPPORT_LONG_LONGS */
=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -43,7 +43,6 @@ Library
GHC.CString
GHC.Classes
GHC.Debug
- GHC.IntWord64
GHC.Magic
GHC.Prim.Ext
GHC.Prim.Panic
@@ -81,7 +80,6 @@ Library
cbits/clz.c
cbits/ctz.c
cbits/debug.c
- cbits/longlong.c
cbits/pdep.c
cbits/pext.c
cbits/popcnt.c
=====================================
rts/package.conf.in
=====================================
@@ -129,45 +129,31 @@ ld-options:
, "-Wl,-u,_hs_atomic_add8"
, "-Wl,-u,_hs_atomic_add16"
, "-Wl,-u,_hs_atomic_add32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,_hs_atomic_add64"
-#endif
, "-Wl,-u,_hs_atomic_sub8"
, "-Wl,-u,_hs_atomic_sub16"
, "-Wl,-u,_hs_atomic_sub32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,_hs_atomic_sub64"
-#endif
, "-Wl,-u,_hs_atomic_and8"
, "-Wl,-u,_hs_atomic_and16"
, "-Wl,-u,_hs_atomic_and32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,_hs_atomic_and64"
-#endif
, "-Wl,-u,_hs_atomic_nand8"
, "-Wl,-u,_hs_atomic_nand16"
, "-Wl,-u,_hs_atomic_nand32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,_hs_atomic_nand64"
-#endif
, "-Wl,-u,_hs_atomic_or8"
, "-Wl,-u,_hs_atomic_or16"
, "-Wl,-u,_hs_atomic_or32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,_hs_atomic_or64"
-#endif
, "-Wl,-u,_hs_atomic_xor8"
, "-Wl,-u,_hs_atomic_xor16"
, "-Wl,-u,_hs_atomic_xor32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,_hs_atomic_xor64"
-#endif
, "-Wl,-u,_hs_cmpxchg8"
, "-Wl,-u,_hs_cmpxchg16"
, "-Wl,-u,_hs_cmpxchg32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,_hs_cmpxchg64"
-#endif
, "-Wl,-u,_hs_xchg8"
, "-Wl,-u,_hs_xchg16"
, "-Wl,-u,_hs_xchg32"
@@ -175,15 +161,11 @@ ld-options:
, "-Wl,-u,_hs_atomicread8"
, "-Wl,-u,_hs_atomicread16"
, "-Wl,-u,_hs_atomicread32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,_hs_atomicread64"
-#endif
, "-Wl,-u,_hs_atomicwrite8"
, "-Wl,-u,_hs_atomicwrite16"
, "-Wl,-u,_hs_atomicwrite32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,_hs_atomicwrite64"
-#endif
#if defined(DEBUG)
/* This symbol is useful in gdb, but not referred to anywhere,
* so we need to force it to be included in the binary. */
@@ -238,45 +220,31 @@ ld-options:
, "-Wl,-u,hs_atomic_add8"
, "-Wl,-u,hs_atomic_add16"
, "-Wl,-u,hs_atomic_add32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,hs_atomic_add64"
-#endif
, "-Wl,-u,hs_atomic_sub8"
, "-Wl,-u,hs_atomic_sub16"
, "-Wl,-u,hs_atomic_sub32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,hs_atomic_sub64"
-#endif
, "-Wl,-u,hs_atomic_and8"
, "-Wl,-u,hs_atomic_and16"
, "-Wl,-u,hs_atomic_and32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,hs_atomic_and64"
-#endif
, "-Wl,-u,hs_atomic_nand8"
, "-Wl,-u,hs_atomic_nand16"
, "-Wl,-u,hs_atomic_nand32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,hs_atomic_nand64"
-#endif
, "-Wl,-u,hs_atomic_or8"
, "-Wl,-u,hs_atomic_or16"
, "-Wl,-u,hs_atomic_or32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,hs_atomic_or64"
-#endif
, "-Wl,-u,hs_atomic_xor8"
, "-Wl,-u,hs_atomic_xor16"
, "-Wl,-u,hs_atomic_xor32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,hs_atomic_xor64"
-#endif
, "-Wl,-u,hs_cmpxchg8"
, "-Wl,-u,hs_cmpxchg16"
, "-Wl,-u,hs_cmpxchg32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,hs_cmpxchg64"
-#endif
, "-Wl,-u,hs_xchg8"
, "-Wl,-u,hs_xchg16"
, "-Wl,-u,hs_xchg32"
@@ -284,15 +252,11 @@ ld-options:
, "-Wl,-u,hs_atomicread8"
, "-Wl,-u,hs_atomicread16"
, "-Wl,-u,hs_atomicread32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,hs_atomicread64"
-#endif
, "-Wl,-u,hs_atomicwrite8"
, "-Wl,-u,hs_atomicwrite16"
, "-Wl,-u,hs_atomicwrite32"
-#if WORD_SIZE_IN_BITS == 64
, "-Wl,-u,hs_atomicwrite64"
-#endif
#if defined(DEBUG)
/* This symbol is useful in gdb, but not referred to anywhere,
* so we need to force it to be included in the binary. */
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e03d64df48b1f26ac872a89dd20072796669504...8d5180226e68bd952da9a3a3f2ce6077fe5abce6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e03d64df48b1f26ac872a89dd20072796669504...8d5180226e68bd952da9a3a3f2ce6077fe5abce6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200706/3df16a21/attachment-0001.html>
More information about the ghc-commits
mailing list