int64DataConKey,
int64PrimTyConKey,
int64TyConKey,
- integerDataConKey,
+ smallIntegerDataConKey,
+ largeIntegerDataConKey,
integerMinusOneIdKey,
integerPlusOneIdKey,
integerPlusTwoIdKey,
int16DataConKey = mkPreludeDataConUnique 9
int32DataConKey = mkPreludeDataConUnique 10
int64DataConKey = mkPreludeDataConUnique 11
-integerDataConKey = mkPreludeDataConUnique 12
-foreignObjDataConKey = mkPreludeDataConUnique 13
-nilDataConKey = mkPreludeDataConUnique 14
-ratioDataConKey = mkPreludeDataConUnique 15
-stablePtrDataConKey = mkPreludeDataConUnique 16
-stableNameDataConKey = mkPreludeDataConUnique 17
+smallIntegerDataConKey = mkPreludeDataConUnique 12
+largeIntegerDataConKey = mkPreludeDataConUnique 13
+foreignObjDataConKey = mkPreludeDataConUnique 14
+nilDataConKey = mkPreludeDataConUnique 15
+ratioDataConKey = mkPreludeDataConUnique 16
+stablePtrDataConKey = mkPreludeDataConUnique 17
+stableNameDataConKey = mkPreludeDataConUnique 18
trueDataConKey = mkPreludeDataConUnique 34
wordDataConKey = mkPreludeDataConUnique 35
word8DataConKey = mkPreludeDataConUnique 36
mIN_SIZE_NonUpdHeapObject = (MIN_NONUPD_SIZE::Int)
\end{code}
+If we're compiling with GHC (and we're not cross-compiling), then we
+know that minBound and maxBound :: Int are the right values for the
+target architecture. Otherwise, we assume -2^31 and 2^31-1
+respectively (which will be wrong on a 64-bit machine).
+
\begin{code}
tARGET_MIN_INT, tARGET_MAX_INT :: Integer
-tARGET_MIN_INT = -536870912
-tARGET_MAX_INT = 536870912
+#if __GLASGOW_HASKELL__
+tARGET_MIN_INT = toInteger (minBound :: Int)
+tARGET_MAX_INT = toInteger (maxBound :: Int)
+#else
+tARGET_MIN_INT = -2147483648
+tARGET_MAX_INT = 2147483647
+#endif
\end{code}
Constants for semi-tagging; the tags associated with the data
-- Here are the thin-air Ids themselves
- int2IntegerId, addr2IntegerId,
- integerMinusOneId, integerZeroId, integerPlusOneId, integerPlusTwoId,
+ addr2IntegerId,
packStringForCId, unpackCStringId, unpackCString2Id,
unpackCStringAppendId, unpackCStringFoldrId,
foldrId,
= map mkKnownKeyGlobal
[
-- Needed for converting literals to Integers (used in tidyCoreExpr)
- (varQual pREL_BASE SLIT("int2Integer"), int2IntegerIdKey)
- , (varQual pREL_BASE SLIT("addr2Integer"), addr2IntegerIdKey)
-
- -- OK, this is Will's idea: we should have magic values for Integers 0,
- -- +1, +2, and -1 (go ahead, fire me):
- , (varQual pREL_BASE SLIT("integer_0"), integerZeroIdKey)
- , (varQual pREL_BASE SLIT("integer_1"), integerPlusOneIdKey)
- , (varQual pREL_BASE SLIT("integer_2"), integerPlusTwoIdKey)
- , (varQual pREL_BASE SLIT("integer_m1"), integerMinusOneIdKey)
-
+ (varQual pREL_BASE SLIT("addr2Integer"), addr2IntegerIdKey)
-- String literals
, (varQual pREL_PACK SLIT("packCString#"), packCStringIdKey)
thinAirModules = [pREL_PACK] -- See notes with RnIfaces.findAndReadIface
-noRepIntegerIds = [integerZeroId, integerPlusOneId, integerPlusTwoId, integerMinusOneId,
- int2IntegerId, addr2IntegerId]
+noRepIntegerIds = [addr2IntegerId]
noRepStrIds = [unpackCString2Id, unpackCStringId]
-int2IntegerId = lookupThinAirId int2IntegerIdKey
addr2IntegerId = lookupThinAirId addr2IntegerIdKey
-integerMinusOneId = lookupThinAirId integerMinusOneIdKey
-integerZeroId = lookupThinAirId integerZeroIdKey
-integerPlusOneId = lookupThinAirId integerPlusOneIdKey
-integerPlusTwoId = lookupThinAirId integerPlusTwoIdKey
-
packStringForCId = lookupThinAirId packCStringIdKey
unpackCStringId = lookupThinAirId unpackCStringIdKey
unpackCString2Id = lookupThinAirId unpackCString2IdKey
| IntAddOp | IntSubOp | IntMulOp | IntQuotOp
| IntRemOp | IntNegOp | IntAbsOp
| ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
+ | IntAddCOp
+ | IntSubCOp
+ | IntMulCOp
-- Word#-related ops:
| WordQuotOp | WordRemOp
| IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
| IntegerCmpOp
+ | IntegerCmpIntOp
| Integer2IntOp | Integer2WordOp
| Int2IntegerOp | Word2IntegerOp
tagOf_PrimOp ISllOp = ILIT( 54)
tagOf_PrimOp ISraOp = ILIT( 55)
tagOf_PrimOp ISrlOp = ILIT( 56)
-tagOf_PrimOp Int2WordOp = ILIT( 57)
-tagOf_PrimOp Word2IntOp = ILIT( 58)
-tagOf_PrimOp Int2AddrOp = ILIT( 59)
-tagOf_PrimOp Addr2IntOp = ILIT( 60)
-
-tagOf_PrimOp FloatAddOp = ILIT( 61)
-tagOf_PrimOp FloatSubOp = ILIT( 62)
-tagOf_PrimOp FloatMulOp = ILIT( 63)
-tagOf_PrimOp FloatDivOp = ILIT( 64)
-tagOf_PrimOp FloatNegOp = ILIT( 65)
-tagOf_PrimOp Float2IntOp = ILIT( 66)
-tagOf_PrimOp Int2FloatOp = ILIT( 67)
-tagOf_PrimOp FloatExpOp = ILIT( 68)
-tagOf_PrimOp FloatLogOp = ILIT( 69)
-tagOf_PrimOp FloatSqrtOp = ILIT( 70)
-tagOf_PrimOp FloatSinOp = ILIT( 71)
-tagOf_PrimOp FloatCosOp = ILIT( 72)
-tagOf_PrimOp FloatTanOp = ILIT( 73)
-tagOf_PrimOp FloatAsinOp = ILIT( 74)
-tagOf_PrimOp FloatAcosOp = ILIT( 75)
-tagOf_PrimOp FloatAtanOp = ILIT( 76)
-tagOf_PrimOp FloatSinhOp = ILIT( 77)
-tagOf_PrimOp FloatCoshOp = ILIT( 78)
-tagOf_PrimOp FloatTanhOp = ILIT( 79)
-tagOf_PrimOp FloatPowerOp = ILIT( 80)
-
-tagOf_PrimOp DoubleAddOp = ILIT( 81)
-tagOf_PrimOp DoubleSubOp = ILIT( 82)
-tagOf_PrimOp DoubleMulOp = ILIT( 83)
-tagOf_PrimOp DoubleDivOp = ILIT( 84)
-tagOf_PrimOp DoubleNegOp = ILIT( 85)
-tagOf_PrimOp Double2IntOp = ILIT( 86)
-tagOf_PrimOp Int2DoubleOp = ILIT( 87)
-tagOf_PrimOp Double2FloatOp = ILIT( 88)
-tagOf_PrimOp Float2DoubleOp = ILIT( 89)
-tagOf_PrimOp DoubleExpOp = ILIT( 90)
-tagOf_PrimOp DoubleLogOp = ILIT( 91)
-tagOf_PrimOp DoubleSqrtOp = ILIT( 92)
-tagOf_PrimOp DoubleSinOp = ILIT( 93)
-tagOf_PrimOp DoubleCosOp = ILIT( 94)
-tagOf_PrimOp DoubleTanOp = ILIT( 95)
-tagOf_PrimOp DoubleAsinOp = ILIT( 96)
-tagOf_PrimOp DoubleAcosOp = ILIT( 97)
-tagOf_PrimOp DoubleAtanOp = ILIT( 98)
-tagOf_PrimOp DoubleSinhOp = ILIT( 99)
-tagOf_PrimOp DoubleCoshOp = ILIT(100)
-tagOf_PrimOp DoubleTanhOp = ILIT(101)
-tagOf_PrimOp DoublePowerOp = ILIT(102)
-
-tagOf_PrimOp IntegerAddOp = ILIT(103)
-tagOf_PrimOp IntegerSubOp = ILIT(104)
-tagOf_PrimOp IntegerMulOp = ILIT(105)
-tagOf_PrimOp IntegerGcdOp = ILIT(106)
-tagOf_PrimOp IntegerQuotRemOp = ILIT(107)
-tagOf_PrimOp IntegerDivModOp = ILIT(108)
-tagOf_PrimOp IntegerNegOp = ILIT(109)
-tagOf_PrimOp IntegerCmpOp = ILIT(110)
-tagOf_PrimOp Integer2IntOp = ILIT(111)
-tagOf_PrimOp Integer2WordOp = ILIT(112)
-tagOf_PrimOp Int2IntegerOp = ILIT(113)
-tagOf_PrimOp Word2IntegerOp = ILIT(114)
-tagOf_PrimOp Addr2IntegerOp = ILIT(115)
-tagOf_PrimOp IntegerToInt64Op = ILIT(116)
-tagOf_PrimOp Int64ToIntegerOp = ILIT(117)
-tagOf_PrimOp IntegerToWord64Op = ILIT(118)
-tagOf_PrimOp Word64ToIntegerOp = ILIT(119)
-
-tagOf_PrimOp FloatEncodeOp = ILIT(120)
-tagOf_PrimOp FloatDecodeOp = ILIT(121)
-tagOf_PrimOp DoubleEncodeOp = ILIT(122)
-tagOf_PrimOp DoubleDecodeOp = ILIT(123)
-
-tagOf_PrimOp NewArrayOp = ILIT(124)
-tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(125)
-tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(126)
-tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(127)
-tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(128)
-tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(129)
-tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(130)
-tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(131)
-tagOf_PrimOp SameMutableArrayOp = ILIT(132)
-tagOf_PrimOp SameMutableByteArrayOp = ILIT(133)
-tagOf_PrimOp ReadArrayOp = ILIT(134)
-tagOf_PrimOp WriteArrayOp = ILIT(135)
-tagOf_PrimOp IndexArrayOp = ILIT(136)
-
-tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(137)
-tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(138)
-tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(139)
-tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(140)
-tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(141)
-tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(142)
-tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(143)
-tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(144)
-tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(145)
-
-tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(146)
-tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(147)
-tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(148)
-tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(149)
-tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(150)
-tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(151)
-tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(152)
-tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(153)
-tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(154)
-
-tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(155)
-tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(156)
-tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(157)
-tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(158)
-tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(159)
-tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(160)
-tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(161)
-tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(162)
-tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(163)
-
-tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(164)
-tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(165)
-tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(166)
-tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(167)
-tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(168)
-tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(169)
-tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(170)
-tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(171)
-tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(172)
-tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(173)
-tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(174)
-tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(175)
-tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(176)
-tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(177)
-tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(178)
-tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(179)
-tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(180)
-tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(181)
-
-tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(182)
-tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(183)
-tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(184)
-tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(185)
-tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(186)
-tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(187)
-tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(188)
-tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(189)
-tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(190)
-tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(191)
-
-tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(192)
-tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(193)
-tagOf_PrimOp SizeofByteArrayOp = ILIT(194)
-tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(195)
-tagOf_PrimOp NewMVarOp = ILIT(196)
-tagOf_PrimOp TakeMVarOp = ILIT(197)
-tagOf_PrimOp PutMVarOp = ILIT(198)
-tagOf_PrimOp SameMVarOp = ILIT(199)
-tagOf_PrimOp IsEmptyMVarOp = ILIT(200)
-tagOf_PrimOp MakeForeignObjOp = ILIT(201)
-tagOf_PrimOp WriteForeignObjOp = ILIT(202)
-tagOf_PrimOp MkWeakOp = ILIT(203)
-tagOf_PrimOp DeRefWeakOp = ILIT(204)
-tagOf_PrimOp FinalizeWeakOp = ILIT(205)
-tagOf_PrimOp MakeStableNameOp = ILIT(206)
-tagOf_PrimOp EqStableNameOp = ILIT(207)
-tagOf_PrimOp StableNameToIntOp = ILIT(208)
-tagOf_PrimOp MakeStablePtrOp = ILIT(209)
-tagOf_PrimOp DeRefStablePtrOp = ILIT(210)
-tagOf_PrimOp EqStablePtrOp = ILIT(211)
-tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(212)
-tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(213)
-tagOf_PrimOp SeqOp = ILIT(214)
-tagOf_PrimOp ParOp = ILIT(215)
-tagOf_PrimOp ForkOp = ILIT(216)
-tagOf_PrimOp KillThreadOp = ILIT(217)
-tagOf_PrimOp DelayOp = ILIT(218)
-tagOf_PrimOp WaitReadOp = ILIT(219)
-tagOf_PrimOp WaitWriteOp = ILIT(220)
-tagOf_PrimOp ParGlobalOp = ILIT(221)
-tagOf_PrimOp ParLocalOp = ILIT(222)
-tagOf_PrimOp ParAtOp = ILIT(223)
-tagOf_PrimOp ParAtAbsOp = ILIT(224)
-tagOf_PrimOp ParAtRelOp = ILIT(225)
-tagOf_PrimOp ParAtForNowOp = ILIT(226)
-tagOf_PrimOp CopyableOp = ILIT(227)
-tagOf_PrimOp NoFollowOp = ILIT(228)
-tagOf_PrimOp NewMutVarOp = ILIT(229)
-tagOf_PrimOp ReadMutVarOp = ILIT(230)
-tagOf_PrimOp WriteMutVarOp = ILIT(231)
-tagOf_PrimOp SameMutVarOp = ILIT(232)
-tagOf_PrimOp CatchOp = ILIT(233)
-tagOf_PrimOp RaiseOp = ILIT(234)
+tagOf_PrimOp IntAddCOp = ILIT( 57)
+tagOf_PrimOp IntSubCOp = ILIT( 58)
+tagOf_PrimOp IntMulCOp = ILIT( 59)
+tagOf_PrimOp Int2WordOp = ILIT( 60)
+tagOf_PrimOp Word2IntOp = ILIT( 61)
+tagOf_PrimOp Int2AddrOp = ILIT( 62)
+tagOf_PrimOp Addr2IntOp = ILIT( 63)
+
+tagOf_PrimOp FloatAddOp = ILIT( 64)
+tagOf_PrimOp FloatSubOp = ILIT( 65)
+tagOf_PrimOp FloatMulOp = ILIT( 66)
+tagOf_PrimOp FloatDivOp = ILIT( 67)
+tagOf_PrimOp FloatNegOp = ILIT( 68)
+tagOf_PrimOp Float2IntOp = ILIT( 69)
+tagOf_PrimOp Int2FloatOp = ILIT( 70)
+tagOf_PrimOp FloatExpOp = ILIT( 71)
+tagOf_PrimOp FloatLogOp = ILIT( 72)
+tagOf_PrimOp FloatSqrtOp = ILIT( 73)
+tagOf_PrimOp FloatSinOp = ILIT( 74)
+tagOf_PrimOp FloatCosOp = ILIT( 75)
+tagOf_PrimOp FloatTanOp = ILIT( 76)
+tagOf_PrimOp FloatAsinOp = ILIT( 77)
+tagOf_PrimOp FloatAcosOp = ILIT( 78)
+tagOf_PrimOp FloatAtanOp = ILIT( 79)
+tagOf_PrimOp FloatSinhOp = ILIT( 80)
+tagOf_PrimOp FloatCoshOp = ILIT( 81)
+tagOf_PrimOp FloatTanhOp = ILIT( 82)
+tagOf_PrimOp FloatPowerOp = ILIT( 83)
+
+tagOf_PrimOp DoubleAddOp = ILIT( 84)
+tagOf_PrimOp DoubleSubOp = ILIT( 85)
+tagOf_PrimOp DoubleMulOp = ILIT( 86)
+tagOf_PrimOp DoubleDivOp = ILIT( 87)
+tagOf_PrimOp DoubleNegOp = ILIT( 88)
+tagOf_PrimOp Double2IntOp = ILIT( 89)
+tagOf_PrimOp Int2DoubleOp = ILIT( 90)
+tagOf_PrimOp Double2FloatOp = ILIT( 91)
+tagOf_PrimOp Float2DoubleOp = ILIT( 92)
+tagOf_PrimOp DoubleExpOp = ILIT( 93)
+tagOf_PrimOp DoubleLogOp = ILIT( 94)
+tagOf_PrimOp DoubleSqrtOp = ILIT( 95)
+tagOf_PrimOp DoubleSinOp = ILIT( 96)
+tagOf_PrimOp DoubleCosOp = ILIT( 97)
+tagOf_PrimOp DoubleTanOp = ILIT( 98)
+tagOf_PrimOp DoubleAsinOp = ILIT( 99)
+tagOf_PrimOp DoubleAcosOp = ILIT(100)
+tagOf_PrimOp DoubleAtanOp = ILIT(101)
+tagOf_PrimOp DoubleSinhOp = ILIT(102)
+tagOf_PrimOp DoubleCoshOp = ILIT(103)
+tagOf_PrimOp DoubleTanhOp = ILIT(104)
+tagOf_PrimOp DoublePowerOp = ILIT(105)
+
+tagOf_PrimOp IntegerAddOp = ILIT(106)
+tagOf_PrimOp IntegerSubOp = ILIT(107)
+tagOf_PrimOp IntegerMulOp = ILIT(108)
+tagOf_PrimOp IntegerGcdOp = ILIT(109)
+tagOf_PrimOp IntegerQuotRemOp = ILIT(110)
+tagOf_PrimOp IntegerDivModOp = ILIT(111)
+tagOf_PrimOp IntegerNegOp = ILIT(112)
+tagOf_PrimOp IntegerCmpOp = ILIT(113)
+tagOf_PrimOp IntegerCmpIntOp = ILIT(114)
+tagOf_PrimOp Integer2IntOp = ILIT(115)
+tagOf_PrimOp Integer2WordOp = ILIT(116)
+tagOf_PrimOp Int2IntegerOp = ILIT(117)
+tagOf_PrimOp Word2IntegerOp = ILIT(118)
+tagOf_PrimOp Addr2IntegerOp = ILIT(119)
+tagOf_PrimOp IntegerToInt64Op = ILIT(120)
+tagOf_PrimOp Int64ToIntegerOp = ILIT(121)
+tagOf_PrimOp IntegerToWord64Op = ILIT(122)
+tagOf_PrimOp Word64ToIntegerOp = ILIT(123)
+tagOf_PrimOp FloatEncodeOp = ILIT(124)
+tagOf_PrimOp FloatDecodeOp = ILIT(125)
+tagOf_PrimOp DoubleEncodeOp = ILIT(126)
+tagOf_PrimOp DoubleDecodeOp = ILIT(127)
+
+tagOf_PrimOp NewArrayOp = ILIT(128)
+tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(129)
+tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(130)
+tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(131)
+tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(132)
+tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(133)
+tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(134)
+tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(135)
+
+tagOf_PrimOp SameMutableArrayOp = ILIT(136)
+tagOf_PrimOp SameMutableByteArrayOp = ILIT(137)
+tagOf_PrimOp ReadArrayOp = ILIT(138)
+tagOf_PrimOp WriteArrayOp = ILIT(139)
+tagOf_PrimOp IndexArrayOp = ILIT(140)
+
+tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(141)
+tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(142)
+tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(143)
+tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(144)
+tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(145)
+tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(146)
+tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(147)
+tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(148)
+tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(149)
+
+tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(150)
+tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(151)
+tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(152)
+tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(153)
+tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(154)
+tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(155)
+tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(156)
+tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(157)
+tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(158)
+
+tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(159)
+tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(160)
+tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(161)
+tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(162)
+tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(163)
+tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(164)
+tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(165)
+tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(166)
+tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(167)
+
+tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(168)
+tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(169)
+tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(170)
+tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(171)
+tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(172)
+tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(173)
+tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(174)
+tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(175)
+tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(176)
+
+tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(177)
+tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(178)
+tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(179)
+tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(180)
+tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(181)
+tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(182)
+tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(183)
+tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(184)
+tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(185)
+
+tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(186)
+tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(187)
+tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(188)
+tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(189)
+tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(190)
+tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(191)
+tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(192)
+tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(193)
+tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(194)
+tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(195)
+
+tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(196)
+tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(197)
+tagOf_PrimOp SizeofByteArrayOp = ILIT(198)
+tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(199)
+
+tagOf_PrimOp NewMVarOp = ILIT(200)
+tagOf_PrimOp TakeMVarOp = ILIT(201)
+tagOf_PrimOp PutMVarOp = ILIT(202)
+tagOf_PrimOp SameMVarOp = ILIT(203)
+tagOf_PrimOp IsEmptyMVarOp = ILIT(204)
+tagOf_PrimOp MakeForeignObjOp = ILIT(205)
+tagOf_PrimOp WriteForeignObjOp = ILIT(206)
+tagOf_PrimOp MkWeakOp = ILIT(207)
+tagOf_PrimOp DeRefWeakOp = ILIT(208)
+tagOf_PrimOp FinalizeWeakOp = ILIT(209)
+tagOf_PrimOp MakeStableNameOp = ILIT(210)
+tagOf_PrimOp EqStableNameOp = ILIT(211)
+tagOf_PrimOp StableNameToIntOp = ILIT(212)
+tagOf_PrimOp MakeStablePtrOp = ILIT(213)
+tagOf_PrimOp DeRefStablePtrOp = ILIT(214)
+tagOf_PrimOp EqStablePtrOp = ILIT(215)
+tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(216)
+tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(217)
+tagOf_PrimOp SeqOp = ILIT(218)
+tagOf_PrimOp ParOp = ILIT(219)
+tagOf_PrimOp ForkOp = ILIT(220)
+tagOf_PrimOp KillThreadOp = ILIT(221)
+tagOf_PrimOp DelayOp = ILIT(222)
+tagOf_PrimOp WaitReadOp = ILIT(223)
+tagOf_PrimOp WaitWriteOp = ILIT(224)
+tagOf_PrimOp ParGlobalOp = ILIT(225)
+tagOf_PrimOp ParLocalOp = ILIT(226)
+tagOf_PrimOp ParAtOp = ILIT(227)
+tagOf_PrimOp ParAtAbsOp = ILIT(228)
+tagOf_PrimOp ParAtRelOp = ILIT(229)
+tagOf_PrimOp ParAtForNowOp = ILIT(230)
+tagOf_PrimOp CopyableOp = ILIT(231)
+tagOf_PrimOp NoFollowOp = ILIT(232)
+tagOf_PrimOp NewMutVarOp = ILIT(233)
+tagOf_PrimOp ReadMutVarOp = ILIT(234)
+tagOf_PrimOp WriteMutVarOp = ILIT(235)
+tagOf_PrimOp SameMutVarOp = ILIT(236)
+tagOf_PrimOp CatchOp = ILIT(237)
+tagOf_PrimOp RaiseOp = ILIT(238)
tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
--panic# "tagOf_PrimOp: pattern-match"
ISllOp,
ISraOp,
ISrlOp,
+ IntAddCOp,
+ IntSubCOp,
+ IntMulCOp,
Int2WordOp,
Word2IntOp,
Int2AddrOp,
IntegerDivModOp,
IntegerNegOp,
IntegerCmpOp,
+ IntegerCmpIntOp,
Integer2IntOp,
Integer2WordOp,
Int2IntegerOp,
Utility bits:
\begin{code}
-one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
+one_Integer_ty = [intPrimTy, byteArrayPrimTy]
two_Integer_tys
- = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
- intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
+ = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
+ intPrimTy, byteArrayPrimTy] -- second '' pieces
an_Integer_and_Int_tys
- = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
+ = [intPrimTy, byteArrayPrimTy, -- Integer
intPrimTy]
unboxedPair = mkUnboxedTupleTy 2
unboxedTriple = mkUnboxedTupleTy 3
unboxedQuadruple = mkUnboxedTupleTy 4
-unboxedSexTuple = mkUnboxedTupleTy 6
integerMonadic name = mkGenPrimOp name [] one_Integer_ty
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedPair one_Integer_ty)
integerDyadic name = mkGenPrimOp name [] two_Integer_tys
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedPair one_Integer_ty)
integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
- (unboxedSexTuple [intPrimTy, intPrimTy, byteArrayPrimTy,
- intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedQuadruple two_Integer_tys)
integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
\end{code}
primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
primOpInfo IntAbsOp = mkMonadic SLIT("absInt#") intPrimTy
+
+primOpInfo IntAddCOp =
+ mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
+ (unboxedPair [intPrimTy, intPrimTy])
+
+primOpInfo IntSubCOp =
+ mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy]
+ (unboxedPair [intPrimTy, intPrimTy])
+
+primOpInfo IntMulCOp =
+ mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy]
+ (unboxedPair [intPrimTy, intPrimTy])
\end{code}
%************************************************************************
primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
+primOpInfo IntegerCmpIntOp
+ = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
primOpInfo Int2IntegerOp
= mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedPair one_Integer_ty)
primOpInfo Word2IntegerOp
= mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedPair one_Integer_ty)
primOpInfo Addr2IntegerOp
= mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedPair one_Integer_ty)
primOpInfo IntegerToInt64Op
= mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
primOpInfo Int64ToIntegerOp
= mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedPair one_Integer_ty)
primOpInfo Word64ToIntegerOp
= mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedPair one_Integer_ty)
primOpInfo IntegerToWord64Op
= mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
primOpInfo FloatDecodeOp
= mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
- (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
primOpInfo DoubleDecodeOp
= mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
- (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
\end{code}
%************************************************************************
primOpNeedsWrapper Integer2IntOp = True
primOpNeedsWrapper Integer2WordOp = True
primOpNeedsWrapper IntegerCmpOp = True
+primOpNeedsWrapper IntegerCmpIntOp = True
primOpNeedsWrapper FloatExpOp = True
primOpNeedsWrapper FloatLogOp = True
integerTy,
integerTyCon,
- integerDataCon,
+ smallIntegerDataCon,
+ largeIntegerDataCon,
isIntegerTy,
listTyCon,
integerTy :: Type
integerTy = mkTyConTy integerTyCon
-integerTyCon = pcNonRecDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [integerDataCon]
+integerTyCon = pcNonRecDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [smallIntegerDataCon, largeIntegerDataCon]
+
+smallIntegerDataCon = pcDataCon smallIntegerDataConKey pREL_BASE SLIT("S#")
+ [] [] [intPrimTy] integerTyCon
+largeIntegerDataCon = pcDataCon largeIntegerDataConKey pREL_BASE SLIT("J#")
+ [] [] [intPrimTy, byteArrayPrimTy] integerTyCon
-integerDataCon = pcDataCon integerDataConKey pREL_BASE SLIT("J#")
- [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon
isIntegerTy :: Type -> Bool
isIntegerTy ty
)
import TyCon ( TyCon, isDataTyCon )
import PrimOp ( PrimOp(..) )
-import PrelInfo ( unpackCStringId, unpackCString2Id,
- integerZeroId, integerPlusOneId,
- integerPlusTwoId, integerMinusOneId,
- int2IntegerId, addr2IntegerId
- )
+import PrelInfo ( unpackCStringId, unpackCString2Id, addr2IntegerId )
import Type ( Type, splitAlgTyConApp_maybe,
isUnLiftedType,
tidyType, tidyTypes, tidyTopType, tidyTyVar, tidyTyVars,
Type
)
import Class ( Class, classSelIds )
-import TysWiredIn ( isIntegerTy )
+import TysWiredIn ( smallIntegerDataCon, isIntegerTy )
import LiberateCase ( liberateCase )
import SAT ( doStaticArgs )
import Specialise ( specProgram)
If an Integer is small enough (Haskell implementations must support
Ints in the range $[-2^29+1, 2^29-1]$), wrap it up in @int2Integer@;
-otherwise, wrap with @litString2Integer@.
+otherwise, wrap with @addr2Integer@.
\begin{code}
litToRep (NoRepInteger i integer_ty)
= returnPM (integer_ty, rhs)
where
- rhs | i == 0 = Var integerZeroId -- Extremely convenient to look out for
- | i == 1 = Var integerPlusOneId -- a few very common Integer literals!
- | i == 2 = Var integerPlusTwoId
- | i == (-1) = Var integerMinusOneId
-
- | i > tARGET_MIN_INT && -- Small enough, so start from an Int
+ rhs | i > tARGET_MIN_INT && -- Small enough, so start from an Int
i < tARGET_MAX_INT
- = App (Var int2IntegerId) (Con (Literal (mkMachInt i)) [])
+ = Con (DataCon smallIntegerDataCon) [Con (Literal (mkMachInt i)) []]
| otherwise -- Big, so start from a string
= App (Var addr2IntegerId) (Con (Literal (MachStr (_PK_ (show i)))) [])
else if utc == intDataConKey then 'I'
else if utc == floatDataConKey then 'F'
else if utc == doubleDataConKey then 'D'
- else if utc == integerDataConKey then 'J'
+ else if utc == smallIntegerDataConKey ||
+ utc == largeIntegerDataConKey then 'J'
else if utc == charPrimTyConKey then 'c'
else if (utc == intPrimTyConKey || utc == wordPrimTyConKey
|| utc == addrPrimTyConKey) then 'i'
<item> <tt/mkWeak/ now takes a <tt/Maybe (IO ())/ for the finalizer,
and <tt/mkWeakNoFinalizer/ is removed.
<itemize>
+
+<item> Changed representation of <tt/Integer/ type to speed up
+computations on small integers. The performance of <tt/Integer/ is now
+only slightly slower than <tt/Int/ for values between <tt/minBound :: Int/
+and <tt/maxBound :: Int/.
+
</itemize>
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.18 1999/02/11 17:15:20 simonm Exp $
+ * $Id: PrimOps.h,v 1.19 1999/02/17 15:57:30 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
#define remIntzh(r,a,b) r=(a)%(b)
#define negateIntzh(r,a) r=-(a)
-/* The following operations are the standard add,subtract and multiply
- * except that they return a carry if the operation overflows.
+/* -----------------------------------------------------------------------------
+ * Int operations with carry.
+ * -------------------------------------------------------------------------- */
+
+/* With some bit-twiddling, we can define int{Add,Sub}Czh portably in
+ * C, and without needing any comparisons. This may not be the
+ * fastest way to do it - if you have better code, please send it! --SDM
+ *
+ * Return : r = a + b, c = 0 if no overflow, 1 on overflow.
+ *
+ * We currently don't make use of the r value if c is != 0 (i.e.
+ * overflow), we just convert to big integers and try again. This
+ * could be improved by making r and c the correct values for
+ * plugging into a new J#.
+ */
+#define addIntCzh(r,c,a,b) \
+{ r = a + b; \
+ c = ((StgWord)(~(a^b) & (a^r))) \
+ >> (BITS_PER_BYTE * sizeof(I_) - 1); \
+}
+
+
+#define subIntCzh(r,c,a,b) \
+{ r = a - b; \
+ c = ((StgWord)((a^b) & (a^r))) \
+ >> (BITS_PER_BYTE * sizeof(I_) - 1); \
+}
+
+/* Multiply with overflow checking.
+ *
+ * This is slightly more tricky - the usual sign rules for add/subtract
+ * don't apply.
*
- * They are all defined in terms of 32-bit integers and use the GCC
- * 'long long' extension to get a 64-bit result. We'd like to use
- * 64-bit integers on 64-bit architectures, but it seems that gcc's
- * 'long long' type is set at 64-bits even on a 64-bit machine.
+ * On x86 hardware we use a hand-crafted assembly fragment to do the job.
+ *
+ * On other 32-bit machines we use gcc's 'long long' types, finding
+ * overflow with some careful bit-twiddling.
+ *
+ * On 64-bit machines where gcc's 'long long' type is also 64-bits,
+ * we use a crude approximation, testing whether either operand is
+ * larger than 32-bits; if neither is, then we go ahead with the
+ * multiplication.
*/
+#if i386_TARGET_ARCH
+
+#define mulIntCzh(r,c,a,b) \
+{ \
+ __asm__("xor %1,%1\n\t \
+ imull %2,%3\n\t \
+ jno 1f\n\t \
+ movl $1,%1\n\t \
+ 1:" \
+ : "=r" (r), "=r" (c) : "r" (a), "0" (b)); \
+}
+
+#elif SIZEOF_VOID_P == 4
+
#ifdef WORDS_BIGENDIAN
#define C 0
#define R 1
StgInt32 i[2];
} long_long_u ;
-#define addWithCarryzh(r,c,a,b) \
-{ long_long_u z; \
- z.l = a + b; \
- r = z.i[R]; \
- c = z.i[C]; \
+#define mulIntCzh(r,c,a,b) \
+ long_long_u z; \
+ z.l = (StgInt64)a * (StgInt64)b; \
+ r = z.i[R]; \
+ c = z.i[C]; \
+ if (c == 0 || c == -1) { \
+ c = ((StgWord)((a^b) ^ r)) \
+ >> (BITS_PER_BYTE * sizeof(I_) - 1); \
+ } \
}
+/* Careful: the carry calculation above is extremely delicate. Make sure
+ * you test it thoroughly after changing it.
+ */
+#else
-#define subWithCarryzh(r,c,a,b) \
-{ long_long_u z; \
- z.l = a + b; \
- r = z.i[R]; \
- c = z.i[C]; \
-}
+#define HALF_INT (1 << (BITS_PER_BYTE * sizeof(I_) / 2))
+
+#define stg_abs(a) ((a) < 0 ? -(a) : (a))
-#define mulWithCarryzh(r,c,a,b) \
-{ long_long_u z; \
- z.l = a * b; \
- r = z.i[R]; \
- c = z.i[C]; \
+#define mulIntCzh(r,c,a,b) \
+{ \
+ if (stg_abs(a) >= HALF_INT \
+ stg_abs(b) >= HALF_INT) { \
+ c = 1; \
+ } else { \
+ r = a * b; \
+ c = 0; \
+ } \
}
+#endif
/* -----------------------------------------------------------------------------
Word PrimOps.
* to allocate any memory.
*/
-#define integer2Intzh(r, aa,sa,da) \
-{ MP_INT arg; \
- \
- arg._mp_alloc = (aa); \
- arg._mp_size = (sa); \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- (r) = RET_PRIM_STGCALL1(I_,mpz_get_si,&arg); \
+#define integer2Intzh(r, sa,da) \
+{ MP_INT arg; \
+ \
+ arg._mp_size = (sa); \
+ arg._mp_alloc = ((StgArrWords *)da)->words; \
+ arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ \
+ (r) = RET_PRIM_STGCALL1(I_,mpz_get_si,&arg); \
}
-#define integer2Wordzh(r, aa,sa,da) \
-{ MP_INT arg; \
- \
- arg._mp_alloc = (aa); \
- arg._mp_size = (sa); \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- (r) = RET_PRIM_STGCALL1(I_,mpz_get_ui,&arg); \
+#define integer2Wordzh(r, sa,da) \
+{ MP_INT arg; \
+ \
+ arg._mp_size = (sa); \
+ arg._mp_alloc = ((StgArrWords *)da)->words; \
+ arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ \
+ (r) = RET_PRIM_STGCALL1(I_,mpz_get_ui,&arg); \
}
-#define cmpIntegerzh(r, a1,s1,d1, a2,s2,d2) \
-{ MP_INT arg1; \
- MP_INT arg2; \
- \
- arg1._mp_alloc= (a1); \
- arg1._mp_size = (s1); \
- arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
- arg2._mp_alloc= (a2); \
- arg2._mp_size = (s2); \
- arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
- \
- (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2); \
+#define cmpIntegerzh(r, s1,d1, s2,d2) \
+{ MP_INT arg1; \
+ MP_INT arg2; \
+ \
+ arg1._mp_size = (s1); \
+ arg1._mp_alloc= ((StgArrWords *)d1)->words; \
+ arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
+ arg2._mp_size = (s2); \
+ arg2._mp_alloc= ((StgArrWords *)d2)->words; \
+ arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
+ \
+ (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2); \
}
-/* A glorious hack: calling mpz_neg would entail allocation and
- * copying, but by looking at what mpz_neg actually does, we can
- * derive a better version:
- */
-
-#define negateIntegerzh(ra, rs, rd, a, s, d) \
-{ \
- (ra) = (a); \
- (rs) = -(s); \
- (rd) = d; \
+#define cmpIntegerIntzh(r, s,d, i) \
+{ MP_INT arg; \
+ \
+ arg._mp_size = (s); \
+ arg._mp_alloc = ((StgArrWords *)d)->words; \
+ arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d)); \
+ \
+ (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i); \
}
/* The rest are all out-of-line: -------- */
EF_(word2Integerzh_fast);
EF_(addr2Integerzh_fast);
-/* Floating-point encodings/decodings */
-EF_(encodeFloatzh_fast);
+/* Floating-point decodings */
EF_(decodeFloatzh_fast);
-
-EF_(encodeDoublezh_fast);
EF_(decodeDoublezh_fast);
/* -----------------------------------------------------------------------------
#ifdef SUPPORT_LONG_LONGS
-#define integerToWord64zh(r, aa,sa,da) \
-{ unsigned long int* d; \
- StgNat64 res; \
- \
- d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- if ( (aa) == 0 ) { \
- res = (LW_)0; \
- } else if ( (aa) == 1) { \
- res = (LW_)d[0]; \
- } else { \
- res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL; \
- } \
- (r) = res; \
+#define integerToWord64zh(r, sa,da) \
+{ unsigned long int* d; \
+ I_ aa; \
+ StgNat64 res; \
+ \
+ d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ aa = ((StgArrWords *)da)->words; \
+ if ( (aa) == 0 ) { \
+ res = (LW_)0; \
+ } else if ( (aa) == 1) { \
+ res = (LW_)d[0]; \
+ } else { \
+ res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL; \
+ } \
+ (r) = res; \
}
-#define integerToInt64zh(r, aa,sa,da) \
-{ unsigned long int* d; \
- StgInt64 res; \
- \
- d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- if ( (aa) == 0 ) { \
- res = (LI_)0; \
- } else if ( (aa) == 1) { \
- res = (LI_)d[0]; \
- } else { \
- res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL; \
- if ( sa < 0 ) { \
- res = (LI_)-res; \
- } \
- } \
- (r) = res; \
+#define integerToInt64zh(r, sa,da) \
+{ unsigned long int* d; \
+ I_ aa; \
+ StgInt64 res; \
+ \
+ d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ aa = ((StgArrWords *)da)->words; \
+ if ( (aa) == 0 ) { \
+ res = (LI_)0; \
+ } else if ( (aa) == 1) { \
+ res = (LI_)d[0]; \
+ } else { \
+ res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL; \
+ if ( sa < 0 ) { \
+ res = (LI_)-res; \
+ } \
+ } \
+ (r) = res; \
}
/* Conversions */
#include "ieee-flpt.h"
#if FLOATS_AS_DOUBLES /* i.e. 64-bit machines */
-#define encodeFloatzh(r, aa,sa,da, expon) encodeDoublezh(r, aa,sa,da, expon)
+#define encodeFloatzh(r, sa,da, expon) encodeDoublezh(r, sa,da, expon)
#else
-#define encodeFloatzh(r, aa,sa,da, expon) \
-{ MP_INT arg; \
- /* Does not allocate memory */ \
- \
- arg._mp_alloc = aa; \
- arg._mp_size = sa; \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- r = RET_PRIM_STGCALL2(StgFloat, __encodeFloat,&arg,(expon));\
+#define encodeFloatzh(r, sa,da, expon) \
+{ MP_INT arg; \
+ /* Does not allocate memory */ \
+ \
+ arg._mp_size = sa; \
+ arg._mp_alloc = ((StgArrWords *)da)->words; \
+ arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ \
+ r = RET_PRIM_STGCALL2(StgFloat, __encodeFloat,&arg,(expon)); \
}
#endif /* FLOATS_AS_DOUBLES */
-#define encodeDoublezh(r, aa,sa,da, expon) \
-{ MP_INT arg; \
- /* Does not allocate memory */ \
- \
- arg._mp_alloc = aa; \
- arg._mp_size = sa; \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
- \
- r = RET_PRIM_STGCALL2(StgDouble, __encodeDouble,&arg,(expon));\
+#define encodeDoublezh(r, sa,da, expon) \
+{ MP_INT arg; \
+ /* Does not allocate memory */ \
+ \
+ arg._mp_size = sa; \
+ arg._mp_alloc = ((StgArrWords *)da)->words; \
+ arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ \
+ r = RET_PRIM_STGCALL2(StgDouble, __encodeDouble,&arg,(expon)); \
}
/* The decode operations are out-of-line because they need to allocate
abs = absReal
signum = signumReal
- fromInteger (J# a# s# d#)
- = case (integer2Int# a# s# d#) of { i# -> I8# (intToInt8# i#) }
+ fromInteger (J# s# d#)
+ = case (integer2Int# s# d#) of { i# -> I8# (intToInt8# i#) }
fromInt = intToInt8
instance Bounded Int8 where
else I16# (0x10000# -# x#)
abs = absReal
signum = signumReal
- fromInteger (J# a# s# d#)
- = case (integer2Int# a# s# d#) of { i# -> I16# (intToInt16# i#) }
+ fromInteger (J# s# d#)
+ = case (integer2Int# s# d#) of { i# -> I16# (intToInt16# i#) }
fromInt = intToInt16
instance Bounded Int16 where
#endif
abs = absReal
signum = signumReal
- fromInteger (J# a# s# d#)
- = case (integer2Int# a# s# d#) of { i# -> I32# (intToInt32# i#) }
+ fromInteger (J# s# d#)
+ = case (integer2Int# s# d#) of { i# -> I32# (intToInt32# i#) }
fromInt = intToInt32
instance Bounded Int32 where
negate w@(I64# x) = I64# (negateInt# x)
abs x = absReal
signum = signumReal
- fromInteger (J# a# s# d#) = case (integer2Int# a# s# d#) of { i# -> I64# i# }
+ fromInteger (J# s# d#) = case (integer2Int# s# d#) of { i# -> I64# i# }
fromInt = intToInt64
instance Bounded Int64 where
int64ToInteger :: Int64 -> Integer
int64ToInteger (I64# x#) =
case int64ToInteger# x# of
- (# a#, s#, p# #) -> J# a# s# p#
+ (# s#, p# #) -> J# s# p#
integerToInt64 :: Integer -> Int64
-integerToInt64 (J# a# s# d#) = I64# (integerToInt64# a# s# d#)
+integerToInt64 (J# s# d#) = I64# (integerToInt64# s# d#)
instance Eq Int64 where
(I64# x) == (I64# y) = x `eqInt64#` y
import Ix
import PrelGHC
-newtype ST s a = ST (PrelST.State s -> (a,PrelST.State s))
+newtype ST s a = ST (State s -> (a, State s))
+
+data State s = S# (State# s)
instance Functor (ST s) where
fmap f m = ST $ \ s ->
{-# NOINLINE runST #-}
runST :: (forall s. ST s a) -> a
-runST st = case st of ST the_st -> let (r,_) = the_st (PrelST.S# realWorld#) in r
+runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r
\end{code}
%*********************************************************
strictToLazyST :: PrelST.ST s a -> ST s a
strictToLazyST m = ST $ \s ->
let
- pr = case s of { PrelST.S# s# -> PrelST.liftST m s# }
+ pr = case s of { S# s# -> PrelST.liftST m s# }
r = case pr of { PrelST.STret _ v -> v }
- s' = case pr of { PrelST.STret s2# _ -> PrelST.S# s2# }
+ s' = case pr of { PrelST.STret s2# _ -> S# s2# }
in
(r, s')
lazyToStrictST :: ST s a -> PrelST.ST s a
lazyToStrictST (ST m) = PrelST.ST $ \s ->
- case (m (PrelST.S# s)) of (a, PrelST.S# s') -> (# s', a #)
+ case (m (S# s)) of (a, S# s') -> (# s', a #)
unsafeInterleaveST :: ST s a -> ST s a
unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST
integerToWord32 :: Integer -> Word32
integerToWord32 = fromInteger
-wordToInt :: Word -> Int
-wordToInt (W# w#) = I# (word2Int# w#)
-
\end{code}
\subsection[Word8]{The @Word8@ interface}
x' = word2Int# x
abs x = x
signum = signumReal
- fromInteger (J# a# s# d#) = W8# (wordToWord8# (integer2Word# a# s# d#))
+ fromInteger (J# s# d#) = W8# (wordToWord8# (integer2Word# s# d#))
fromInt = intToWord8
instance Bounded Word8 where
word2Integer :: Word# -> Integer
word2Integer w = case word2Integer# w of
- (# a, s, d #) -> J# a s d
+ (# s, d #) -> J# s d
pow2_64# :: Int# -> Int64#
pow2_64# x# = word64ToInt64# (shiftL64# (wordToWord64# (int2Word# 1#)) x#)
x' = word2Int# x
abs x = x
signum = signumReal
- fromInteger (J# a# s# d#) = W16# (wordToWord16# (integer2Word# a# s# d#))
+ fromInteger (J# s# d#) = W16# (wordToWord16# (integer2Word# s# d#))
fromInt = intToWord16
instance Bounded Word16 where
#endif
abs x = x
signum = signumReal
- fromInteger (J# a# s# d#) = W32# (integer2Word# a# s# d#)
+ fromInteger (J# s# d#) = W32# (integer2Word# s# d#)
fromInt (I# x) = W32# (intToWord32# x)
-- ToDo: restrict fromInt{eger} range.
x' = word2Int# x
abs x = x
signum = signumReal
- fromInteger (J# a# s# d#) = W64# (integer2Word# a# s# d#)
+ fromInteger (J# s# d#) = W64# (integer2Word# s# d#)
fromInt = intToWord64
-- Note: no need to mask results here
word64ToInteger :: Word64 -> Integer
word64ToInteger (W64# w#) =
case word64ToInteger# w# of
- (# a#, s#, p# #) -> J# a# s# p#
+ (# s#, p# #) -> J# s# p#
word64ToInt :: Word64 -> Int
word64ToInt w =
intToWord64 (I# i#) = W64# (intToWord64# i#)
integerToWord64 :: Integer -> Word64
-integerToWord64 (J# a# s# d#) = W64# (integerToWord64# a# s# d#)
+integerToWord64 (J# s# d#) = W64# (integerToWord64# s# d#)
instance Eq Word64 where
(W64# x) == (W64# y) = x `eqWord64#` y
#ifndef __HUGS__
modificationTime :: FileStatus -> IO ClockTime
modificationTime stat = do
- -- ToDo: better, this is ugly stuff.
- i1 <- malloc1
+ i1 <- stToIO (newWordArray (0,1))
setFileMode i1 stat
- secs <- cvtUnsigned i1
- return (TOD secs 0)
- where
- malloc1 = IO $ \ s# ->
- case newIntArray# 1# s# of
- (# s2#, barr# #) -> (# s2#, MutableByteArray bnds barr# #)
-
- bnds = (0,1)
- -- The C routine fills in an unsigned word. We don't have `unsigned2Integer#,'
- -- so we freeze the data bits and use them for an MP_INT structure. Note that
- -- zero is still handled specially, although (J# 1# 1# (ptr to 0#)) is probably
- -- acceptable to gmp.
-
- cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# ->
- case readIntArray# arr# 0# s# of
- (# s2#, r# #) ->
- if r# ==# 0# then
- (# s2#, 0 #)
- else
- case unsafeFreezeByteArray# arr# s2# of
- (# s3#, frozen# #) ->
- (# s3#, J# 1# 1# frozen# #)
+ secs <- stToIO (readWordArray i1 0)
+ return (TOD (toInteger (wordToInt secs)) 0)
foreign import ccall "libHS_cbits.so" "set_stat_st_mtime" unsafe
setFileMode :: PrimMutableByteArray RealWorld -> FileStatus -> IO ()
-
#endif
isDirectory :: FileStatus -> Bool
module PrelAddr (
Addr(..)
- , Word(..)
, nullAddr -- :: Addr
, plusAddr -- :: Addr -> Int -> Addr
, indexAddrOffAddr -- :: Addr -> Int -> Addr
+ , Word(..)
+ , wordToInt
+
, Word64(..)
, Int64(..)
) where
instance CCallable Word#
instance CReturnable Word
+wordToInt :: Word -> Int
+wordToInt (W# w#) = I# (word2Int# w#)
+
#if WORD_SIZE_IN_BYTES == 8
data Word64 = W64# Word#
data Int64 = I64# Int#
x - y = x + negate y
negate x = 0 - x
- fromInt (I# i#) = fromInteger (case int2Integer# i# of
- (# a, s, d #) -> J# a s d)
+ fromInt (I# i#) = fromInteger (S# i#)
-- Go via the standard class-op if the
-- non-standard one ain't provided
\end{code}
| n `eqInt` 0 = 0
| otherwise = 1
- fromInteger (J# a# s# d#)
- = case (integer2Int# a# s# d#) of { i# -> I# i# }
+ fromInteger (S# i#) = I# i#
+ fromInteger (J# s# d#)
+ = case (integer2Int# s# d#) of { i# -> I# i# }
fromInt n = n
\begin{code}
data Float = F# Float#
data Double = D# Double#
-data Integer = J# Int# Int# ByteArray#
-instance Eq Integer where
- (J# a1 s1 d1) == (J# a2 s2 d2)
- = (cmpInteger# a1 s1 d1 a2 s2 d2) ==# 0#
-
- (J# a1 s1 d1) /= (J# a2 s2 d2)
- = (cmpInteger# a1 s1 d1 a2 s2 d2) /=# 0#
+data Integer
+ = S# Int# -- small integers
+ | J# Int# ByteArray# -- large integers
+instance Eq Integer where
+ (S# i) == (S# j) = i ==# j
+ (S# i) == (J# s d) = cmpIntegerInt# s d i ==# 0#
+ (J# s d) == (S# i) = cmpIntegerInt# s d i ==# 0#
+ (J# s1 d1) == (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#
+
+ (S# i) /= (S# j) = i /=# j
+ (S# i) /= (J# s d) = cmpIntegerInt# s d i /=# 0#
+ (J# s d) /= (S# i) = cmpIntegerInt# s d i /=# 0#
+ (J# s1 d1) /= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
\end{code}
%*********************************************************
{-# INLINE int2Integer #-}
{-# INLINE addr2Integer #-}
int2Integer :: Int# -> Integer
-int2Integer i = case int2Integer# i of (# a, s, d #) -> J# a s d
+int2Integer i = S# i
addr2Integer :: Addr# -> Integer
-addr2Integer x = case addr2Integer# x of (# a, s, d #) -> J# a s d
-
-integer_0, integer_1, integer_2, integer_m1 :: Integer
-integer_0 = int2Integer 0#
-integer_1 = int2Integer 1#
-integer_2 = int2Integer 2#
-integer_m1 = int2Integer (negateInt# 1#)
+addr2Integer x = case addr2Integer# x of (# s, d #) -> J# s d
\end{code}
iShiftLzh
iShiftRAzh
iShiftRLzh
+ addIntCzh
+ subIntCzh
+ mulIntCzh
Wordzh
gtWordzh
encodeDoublezh
cmpIntegerzh
- negateIntegerzh
+ cmpIntegerIntzh
plusIntegerzh
minusIntegerzh
timesIntegerzh
-- expression --SDM
_casm_ ``%r = 1;'' >>= \(I# hack#) ->
case int2Integer hack# of
- result@(J# _ _ d#) -> do
+ result@(J# _ d#) -> do
rc <- CCALL(fileSize) (haFO__ handle_) d# -- ConcHask: SAFE, won't block
writeHandle handle handle_
if rc == (0::Int) then
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(seekFile_int64) fo whence (primIntegerToInt64 offset)) -- ConcHask: UNSAFE, may block
#else
-hSeek handle mode (J# _ s# d#) =
+hSeek handle mode (J# s# d#) =
wantSeekableHandle "hSeek" handle $ \ handle_ -> do
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
\begin{code}
instance Ord Integer where
- (J# a1 s1 d1) <= (J# a2 s2 d2)
- = (cmpInteger# a1 s1 d1 a2 s2 d2) <=# 0#
-
- (J# a1 s1 d1) < (J# a2 s2 d2)
- = (cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#
-
- (J# a1 s1 d1) >= (J# a2 s2 d2)
- = (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
-
- (J# a1 s1 d1) > (J# a2 s2 d2)
- = (cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#
-
- x@(J# a1 s1 d1) `max` y@(J# a2 s2 d2)
- = if ((cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#) then x else y
-
- x@(J# a1 s1 d1) `min` y@(J# a2 s2 d2)
- = if ((cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#) then x else y
-
- compare (J# a1 s1 d1) (J# a2 s2 d2)
- = case cmpInteger# a1 s1 d1 a2 s2 d2 of { res# ->
+ (S# i) <= (S# j) = i <=# j
+ (J# s d) <= (S# i) = cmpIntegerInt# s d i <=# 0#
+ (S# i) <= (J# s d) = cmpIntegerInt# s d i >=# 0#
+ (J# s1 d1) <= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
+
+ (S# i) > (S# j) = i ># j
+ (J# s d) > (S# i) = cmpIntegerInt# s d i ># 0#
+ (S# i) > (J# s d) = cmpIntegerInt# s d i <# 0#
+ (J# s1 d1) > (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
+
+ (S# i) < (S# j) = i <# j
+ (J# s d) < (S# i) = cmpIntegerInt# s d i <# 0#
+ (S# i) < (J# s d) = cmpIntegerInt# s d i ># 0#
+ (J# s1 d1) < (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
+
+ (S# i) >= (S# j) = i >=# j
+ (J# s d) >= (S# i) = cmpIntegerInt# s d i >=# 0#
+ (S# i) >= (J# s d) = cmpIntegerInt# s d i <=# 0#
+ (J# s1 d1) >= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
+
+ compare (S# i) (S# j)
+ | i ==# j = EQ
+ | i <=# j = LT
+ | otherwise = GT
+ compare (J# s d) (S# i)
+ = case cmpIntegerInt# s d i of { res# ->
+ if res# <# 0# then LT else
+ if res# ># 0# then GT else EQ
+ }
+ compare (S# i) (J# s d)
+ = case cmpIntegerInt# s d i of { res# ->
+ if res# ># 0# then LT else
+ if res# <# 0# then GT else EQ
+ }
+ compare (J# s1 d1) (J# s2 d2)
+ = case cmpInteger# s1 d1 s2 d2 of { res# ->
if res# <# 0# then LT else
if res# ># 0# then GT else EQ
}
-instance Num Integer where
- (+) (J# a1 s1 d1) (J# a2 s2 d2)
- = case plusInteger# a1 s1 d1 a2 s2 d2 of (# a, s, d #) -> J# a s d
-
- (-) (J# a1 s1 d1) (J# a2 s2 d2)
- = case minusInteger# a1 s1 d1 a2 s2 d2 of (# a, s, d #) -> J# a s d
-
- negate (J# a s d)
- = case negateInteger# a s d of (# a1, s1, d1 #) -> J# a1 s1 d1
+toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d }
+toBig i@(J# s d) = i
- (*) (J# a1 s1 d1) (J# a2 s2 d2)
- = case timesInteger# a1 s1 d1 a2 s2 d2 of (# a, s, d #) -> J# a s d
+instance Num Integer where
+ (+) i1@(S# i) i2@(S# j)
+ = case addIntC# i j of { (# r, c #) ->
+ if c ==# 0# then S# r
+ else toBig i1 + toBig i2 }
+ (+) i1@(J# s d) i2@(S# i) = i1 + toBig i2
+ (+) i1@(S# i) i2@(J# s d) = toBig i1 + i2
+ (+) (J# s1 d1) (J# s2 d2)
+ = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
+
+ (-) i1@(S# i) i2@(S# j)
+ = case subIntC# i j of { (# r, c #) ->
+ if c ==# 0# then S# r
+ else toBig i1 - toBig i2 }
+ (-) i1@(J# s d) i2@(S# i) = i1 - toBig i2
+ (-) i1@(S# i) i2@(J# s d) = toBig i1 - i2
+ (-) (J# s1 d1) (J# s2 d2)
+ = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
+
+ (*) i1@(S# i) i2@(S# j)
+ = case mulIntC# i j of { (# r, c #) ->
+ if c ==# 0# then S# r
+ else toBig i1 * toBig i2 }
+ (*) i1@(J# s d) i2@(S# i) = i1 * toBig i2
+ (*) i1@(S# i) i2@(J# s d) = toBig i1 * i2
+ (*) (J# s1 d1) (J# s2 d2)
+ = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
+
+ negate (S# i) = S# (negateInt# i)
+ negate (J# s d) = J# (negateInt# s) d
-- ORIG: abs n = if n >= 0 then n else -n
- abs n@(J# a1 s1 d1)
- = case 0 of { J# a2 s2 d2 ->
- if (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
+ abs (S# i) = case abs (I# i) of I# j -> S# j
+ abs n@(J# s d)
+ = if (cmpIntegerInt# s d 0#) >=# 0#
then n
- else case negateInteger# a1 s1 d1 of (# a, s, d #) -> J# a s d
- }
+ else J# (negateInt# s) d
- signum (J# a1 s1 d1)
- = case 0 of { J# a2 s2 d2 ->
- let
- cmp = cmpInteger# a1 s1 d1 a2 s2 d2
+ signum (S# i) = case signum (I# i) of I# j -> S# j
+ signum (J# s d)
+ = let
+ cmp = cmpIntegerInt# s d 0#
in
- if cmp ># 0# then 1
- else if cmp ==# 0# then 0
- else (negate 1)
- }
+ if cmp ># 0# then S# 1#
+ else if cmp ==# 0# then S# 0#
+ else S# (negateInt# 1#)
fromInteger x = x
- fromInt (I# i) = int2Integer i
+ fromInt (I# i) = S# i
instance Real Integer where
toRational x = x % 1
instance Integral Integer where
- quotRem (J# a1 s1 d1) (J# a2 s2 d2)
- = case (quotRemInteger# a1 s1 d1 a2 s2 d2) of
- (# a3, s3, d3, a4, s4, d4 #)
- -> (J# a3 s3 d3, J# a4 s4 d4)
+ -- ToDo: a `rem` b returns a small integer if b is small,
+ -- a `quot` b returns a small integer if a is small.
+ quotRem (S# i) (S# j)
+ = case quotRem (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
+ quotRem i1@(J# s d) i2@(S# i) = quotRem i1 (toBig i2)
+ quotRem i1@(S# i) i2@(J# s d) = quotRem (toBig i1) i2
+ quotRem (J# s1 d1) (J# s2 d2)
+ = case (quotRemInteger# s1 d1 s2 d2) of
+ (# s3, d3, s4, d4 #)
+ -> (J# s3 d3, J# s4 d4)
{- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
-> (J# a3 s3 d3, J# a4 s4 d4)
-}
toInteger n = n
- toInt (J# a s d) = case (integer2Int# a s d) of { n# -> I# n# }
+ toInt (S# i) = I# i
+ toInt (J# s d) = case (integer2Int# s d) of { n# -> I# n# }
-- the rest are identical to the report default methods;
-- you get slightly better code if you let the compiler
-- see them right here:
+ (S# n) `quot` (S# d) = S# (n `quotInt#` d)
n `quot` d = if d /= 0 then q else
error "Prelude.Integral.quot{Integer}: divide by 0"
where (q,_) = quotRem n d
+
+ (S# n) `rem` (S# d) = S# (n `remInt#` d)
n `rem` d = if d /= 0 then r else
error "Prelude.Integral.rem{Integer}: divide by 0"
where (_,r) = quotRem n d
+
n `div` d = q where (q,_) = divMod n d
n `mod` d = r where (_,r) = divMod n d
decodeFloat (F# f#)
= case decodeFloat# f# of
- (# exp#, a#, s#, d# #) -> (J# a# s# d#, I# exp#)
+ (# exp#, s#, d# #) -> (J# s# d#, I# exp#)
- encodeFloat (J# a# s# d#) (I# e#)
- = case encodeFloat# a# s# d# e# of { flt# -> F# flt# }
+ encodeFloat i@(S# _) j = encodeFloat (toBig i) j
+ encodeFloat (J# s# d#) (I# e#)
+ = case encodeFloat# s# d# e# of { flt# -> F# flt# }
exponent x = case decodeFloat x of
(m,n) -> if m == 0 then 0 else n + floatDigits x
decodeFloat (D# x#)
= case decodeDouble# x# of
- (# exp#, a#, s#, d# #) -> (J# a# s# d#, I# exp#)
+ (# exp#, s#, d# #) -> (J# s# d#, I# exp#)
- encodeFloat (J# a# s# d#) (I# e#)
- = case encodeDouble# a# s# d# e# of { dbl# -> D# dbl# }
+ encodeFloat i@(S# _) j = encodeFloat (toBig i) j
+ encodeFloat (J# s# d#) (I# e#)
+ = case encodeDouble# s# d# e# of { dbl# -> D# dbl# }
exponent x = case decodeFloat x of
(m,n) -> if m == 0 then 0 else n + floatDigits x
ST m -> case m realWorld# of
(# _, r #) -> r
\end{code}
-
-%*********************************************************
-%* *
-\subsection{Ghastly return types}
-%* *
-%*********************************************************
-
-The @State@ type is the return type of a _ccall_ with no result. It
-never actually exists, since it's always deconstructed straight away;
-the desugarer ensures this.
-
-\begin{code}
-data State s = S# (State# s)
-\end{code}
instance Show ClockTime
#else
instance Show ClockTime where
- showsPrec _ (TOD (J# _ s# d#) _nsec) =
+ showsPrec p (TOD (S# i) _nsec) =
+ case int2Integer# i of (# s, d #) -> showsPrec p (TOD (J# s d) _nsec)
+ showsPrec _ (TOD (J# s# d#) _nsec) =
showString $ unsafePerformIO $ do
buf <- allocChars 38 -- exactly enough for error message
str <- _ccall_ showTime (I# s#) d# buf
-- The C routine fills in an unsigned word. We don't have
-- `unsigned2Integer#,' so we freeze the data bits and use them
-- for an MP_INT structure. Note that zero is still handled specially,
- -- although (J# 1# 1# (ptr to 0#)) is probably acceptable to gmp.
+ -- although (J# 1# (ptr to 0#)) is probably acceptable to gmp.
cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# ->
case readIntArray# arr# 0# s# of
then (# s2#, 0 #)
else case unsafeFreezeByteArray# arr# s2# of
(# s3#, frozen# #) ->
- (# s3#, J# 1# 1# frozen# #)
+ (# s3#, J# 1# frozen# #)
#endif
\end{code}
isDst = if isdst then (1::Int) else 0
#else
toCalendarTime :: ClockTime -> IO CalendarTime
-toCalendarTime (TOD (J# _ s# d#) psec) = do
+toCalendarTime (TOD (S# i) psec)
+ = case int2Integer# i of (# s, d #) -> toCalendarTime (TOD (J# s d) psec)
+toCalendarTime (TOD (J# s# d#) psec) = do
res <- allocWords (``sizeof(struct tm)''::Int)
zoneNm <- allocChars 32
_casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm
(toEnum wday) yday tzname tz (isdst /= (0::Int)))
toUTCTime :: ClockTime -> CalendarTime
-toUTCTime (TOD (J# _ s# d#) psec) = unsafePerformIO $ do
+toUTCTime (TOD (S# i) psec)
+ = case int2Integer# i of (# s, d #) -> toUTCTime (TOD (J# s d) psec)
+toUTCTime (TOD (J# s# d#) psec) = unsafePerformIO $ do
res <- allocWords (``sizeof(struct tm)''::Int)
zoneNm <- allocChars 32
_casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.15 1999/02/11 17:15:22 simonm Exp $
+ * $Id: PrimOps.hc,v 1.16 1999/02/17 15:57:39 simonm Exp $
*
* (c) The GHC Team, 1998-1999
*
R1.w = (W_)(a); R2.w = (W_)(b); R3.w = (W_)(c); R4.w = (W_)d; \
JMP_(ENTRY_CODE(Sp[0]));
+# define RET_NPNP(a,b,c,d) \
+ R1.w = (W_)(a); R2.w = (W_)(b); R3.w = (W_)(c); R4.w = (W_)(d);
+ JMP_(ENTRY_CODE(Sp[0]));
+
# define RET_NNPNNP(a,b,c,d,e,f) \
R1.w = (W_)(a); R2.w = (W_)(b); R3.w = (W_)(c); \
R4.w = (W_)(d); R5.w = (W_)(e); R6.w = (W_)(f); \
Sp -= 5; \
JMP_(ENTRY_CODE(Sp[5]));
+# define RET_NPNP(a,b,c,d) \
+ R1.w = (W_)(a); \
+ Sp[-4] = (W_)(b); \
+ /* Sp[-3] = ARGTAG(1); */ \
+ Sp[-2] = (W_)(c); \
+ Sp[-1] = (W_)(d); \
+ Sp -= 4; \
+ JMP_(ENTRY_CODE(Sp[4]));
+
# define RET_NNPNNP(a,b,c,d,e,f) \
R1.w = (W_)(a); \
Sp[-1] = (W_)(f); \
# define RET_NNP(a,b,c) PUSH_N(6,a); PUSH_N(4,b); PUSH_N(2,c); PUSHED(6)
# define RET_NNNP(a,b,c,d) PUSH_N(7,a); PUSH_N(5,b); PUSH_N(3,c); PUSH_P(1,d); PUSHED(7)
+# define RET_NPNP(a,b,c,d) PUSH_N(6,a); PUSH_P(4,b); PUSH_N(3,c); PUSH_P(1,d); PUSHED(6)
# define RET_NNPNNP(a,b,c,d,e,f) PUSH_N(10,a); PUSH_N(8,b); PUSH_P(6,c); PUSH_N(5,d); PUSH_N(3,e); PUSH_P(1,f); PUSHED(10)
#endif
s = 0;
}
- /* returns (# alloc :: Int#,
- size :: Int#,
+ /* returns (# size :: Int#,
data :: ByteArray#
#)
*/
- TICK_RET_UNBOXED_TUP(3);
- RET_NNP(1,s,p);
+ TICK_RET_UNBOXED_TUP(2);
+ RET_NP(s,p);
FE_
}
s = 0;
}
- /* returns (# alloc :: Int#,
- size :: Int#,
+ /* returns (# size :: Int#,
data :: ByteArray#
#)
*/
- TICK_RET_UNBOXED_TUP(3);
- RET_NNP(1,s,p);
+ TICK_RET_UNBOXED_TUP(2);
+ RET_NP(s,p);
FE_
}
if (RET_STGCALL3(int, mpz_init_set_str,&result,(str),/*base*/10))
abort();
- TICK_RET_UNBOXED_TUP(3);
- RET_NNP(result._mp_alloc, result._mp_size,
+ /* returns (# size :: Int#,
+ data :: ByteArray#
+ #)
+ */
+ TICK_RET_UNBOXED_TUP(2);
+ RET_NP(result._mp_size,
result._mp_d - sizeofW(StgArrWords));
FE_
}
StgInt64 val; /* to avoid aliasing */
W_ hi;
- I_ s,a, neg, words_needed;
+ I_ s, neg, words_needed;
StgArrWords* p; /* address of array result */
FB_
p = stgCast(StgArrWords*,(Hp-words_needed+1))-1;
SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, words_needed);
- a = words_needed;
-
if ( val < 0LL ) {
neg = 1;
val = -val;
hi = (W_)((LW_)val / 0x100000000ULL);
- if ( a == 2 ) {
+ if ( words_needed == 2 ) {
s = 2;
Hp[-1] = (W_)val;
Hp[0] = hi;
}
s = ( neg ? -s : s );
- /* returns (# alloc :: Int#,
- size :: Int#,
+ /* returns (# size :: Int#,
data :: ByteArray#
#)
*/
- TICK_RET_UNBOXED_TUP(3);
- RET_NNP(a,s,p);
+ TICK_RET_UNBOXED_TUP(2);
+ RET_NP(s,p);
FE_
}
StgNat64 val; /* to avoid aliasing */
StgWord hi;
- I_ s,a,words_needed;
+ I_ s, words_needed;
StgArrWords* p; /* address of array result */
FB_
p = stgCast(StgArrWords*,(Hp-words_needed+1))-1;
SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, words_needed);
- a = words_needed;
-
hi = (W_)((LW_)val / 0x100000000ULL);
if ( val >= 0x100000000ULL ) {
s = 2;
s = 0;
}
- /* returns (# alloc :: Int#,
- size :: Int#,
+ /* returns (# size :: Int#,
data :: ByteArray#
#)
*/
- TICK_RET_UNBOXED_TUP(3);
- RET_NNP(a,s,p);
+ TICK_RET_UNBOXED_TUP(2);
+ RET_NP(s,p);
FE_
}
FN_(name) \
{ \
MP_INT arg1, arg2, result; \
- I_ a1, s1, a2, s2; \
+ I_ s1, s2; \
StgArrWords* d1; \
StgArrWords* d2; \
FB_ \
\
/* call doYouWantToGC() */ \
- MAYBE_GC(R3_PTR | R6_PTR, name); \
+ MAYBE_GC(R2_PTR | R4_PTR, name); \
\
- a1 = R1.i; \
- s1 = R2.i; \
- d1 = stgCast(StgArrWords*,R3.p); \
- a2 = R4.i; \
- s2 = R5.i; \
- d2 = stgCast(StgArrWords*,R6.p); \
+ d1 = (StgArrWords *)R2.p; \
+ s1 = R1.i; \
+ d2 = (StgArrWords *)R4.p; \
+ s2 = R3.i; \
\
- arg1._mp_alloc = (a1); \
+ arg1._mp_alloc = d1->words; \
arg1._mp_size = (s1); \
arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
- arg2._mp_alloc = (a2); \
+ arg2._mp_alloc = d2->words; \
arg2._mp_size = (s2); \
arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
\
/* Perform the operation */ \
STGCALL3(mp_fun,&result,&arg1,&arg2); \
\
- TICK_RET_UNBOXED_TUP(3); \
- RET_NNP(result._mp_alloc, \
- result._mp_size, \
- result._mp_d-sizeofW(StgArrWords)); \
+ TICK_RET_UNBOXED_TUP(2); \
+ RET_NP(result._mp_size, \
+ result._mp_d-sizeofW(StgArrWords)); \
FE_ \
}
FN_(name) \
{ \
MP_INT arg1, arg2, result1, result2; \
- I_ a1, s1, a2, s2; \
+ I_ s1, s2; \
StgArrWords* d1; \
StgArrWords* d2; \
FB_ \
\
/* call doYouWantToGC() */ \
- MAYBE_GC(R3_PTR | R6_PTR, name); \
+ MAYBE_GC(R2_PTR | R4_PTR, name); \
\
- a1 = R1.i; \
- s1 = R2.i; \
- d1 = stgCast(StgArrWords*,R3.p); \
- a2 = R4.i; \
- s2 = R5.i; \
- d2 = stgCast(StgArrWords*,R6.p); \
+ d1 = (StgArrWords *)R2.p; \
+ s1 = R1.i; \
+ d2 = (StgArrWords *)R4.p; \
+ s2 = R3.i; \
\
- arg1._mp_alloc = (a1); \
+ arg1._mp_alloc = d1->words; \
arg1._mp_size = (s1); \
arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
- arg2._mp_alloc = (a2); \
+ arg2._mp_alloc = d2->words; \
arg2._mp_size = (s2); \
arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
\
/* Perform the operation */ \
STGCALL4(mp_fun,&result1,&result2,&arg1,&arg2); \
\
- TICK_RET_UNBOXED_TUP(6); \
- RET_NNPNNP(result1._mp_alloc, \
- result1._mp_size, \
- result1._mp_d-sizeofW(StgArrWords), \
- result2._mp_alloc, \
- result2._mp_size, \
- result2._mp_d-sizeofW(StgArrWords)); \
+ TICK_RET_UNBOXED_TUP(4); \
+ RET_NPNP(result1._mp_size, \
+ result1._mp_d-sizeofW(StgArrWords), \
+ result2._mp_size, \
+ result2._mp_d-sizeofW(StgArrWords)); \
FE_ \
}
/* Perform the operation */
STGCALL3(__decodeFloat,&mantissa,&exponent,arg);
- /* returns: (R1 = Int# (expn), R2 = Int#, R3 = Int#, R4 = ByteArray#) */
- TICK_RET_UNBOXED_TUP(4);
- RET_NNNP(exponent,mantissa._mp_alloc,mantissa._mp_size,p);
+ /* returns: (Int# (expn), Int#, ByteArray#) */
+ TICK_RET_UNBOXED_TUP(3);
+ RET_NNP(exponent,mantissa._mp_size,p);
FE_
}
#endif /* !FLOATS_AS_DOUBLES */
/* Perform the operation */
STGCALL3(__decodeDouble,&mantissa,&exponent,arg);
- /* returns: (R1 = Int# (expn), R2 = Int#, R3 = Int#, R4 = ByteArray#) */
- TICK_RET_UNBOXED_TUP(4);
- RET_NNNP(exponent,mantissa._mp_alloc,mantissa._mp_size,p);
+ /* returns: (Int# (expn), Int#, ByteArray#) */
+ TICK_RET_UNBOXED_TUP(3);
+ RET_NNP(exponent,mantissa._mp_size,p);
FE_
}
projects / ghc-hetmet.git / commitdiff