Ticket #8638: 0001-Try-harder-to-demote-results-from-J-to-S-re-8638.patch

File 0001-Try-harder-to-demote-results-from-J-to-S-re-8638.patch, 12.3 KB (added by hvr, 14 months ago)
  • GHC/Integer/Type.lhs

    From b71e9f6da8a77c541f9d6ed5e42740f7231cf0c2 Mon Sep 17 00:00:00 2001
    From: Herbert Valerio Riedel <[email protected]>
    Date: Mon, 30 Dec 2013 16:05:20 +0100
    Subject: [PATCH] Try harder to demote results from `J#` to `S#` (re #8638)
    
    Signed-off-by: Herbert Valerio Riedel <[email protected]>
    ---
     GHC/Integer/Type.lhs | 79 +++++++++++++++++++++++++++++++---------------------
     1 file changed, 48 insertions(+), 31 deletions(-)
    
    diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs
    index 85ffa7c..58b97f3 100644
    a b module GHC.Integer.Type where 
    2424import GHC.Prim ( 
    2525    -- Other types we use, convert from, or convert to 
    2626    Int#, Word#, Double#, Float#, ByteArray#, MutableByteArray#, Addr#, State#, 
     27    indexIntArray#, 
    2728    -- Conversions between those types 
    2829    int2Word#, int2Double#, int2Float#, word2Int#, 
    2930    -- Operations on Int# that we use for operations on S# 
    smallInteger i = S# i 
    101102 
    102103{-# NOINLINE wordToInteger #-} 
    103104wordToInteger :: Word# -> Integer 
    104 wordToInteger w = case word2Integer# w of (# s, d #) -> J# s d 
     105wordToInteger w = case word2Integer# w of (# s, d #) -> smartJ# s d 
    105106 
    106107{-# NOINLINE integerToWord #-} 
    107108integerToWord :: Integer -> Word# 
    integerToInt :: Integer -> Int# 
    140141integerToInt (S# i)   = i 
    141142integerToInt (J# s d) = integer2Int# s d 
    142143 
     144-- | Promote 'S#' to 'J#' 
    143145toBig :: Integer -> Integer 
    144146toBig (S# i)     = case int2Integer# i of { (# s, d #) -> J# s d } 
    145147toBig i@(J# _ _) = i 
     148 
     149-- | Demote 'J#' to 'S#' if possible. See also 'smartJ#'. 
     150toSmall :: Integer -> Integer 
     151toSmall i@(S# _)  = i 
     152toSmall (J# 0# _) = S# 0# 
     153toSmall (J# 1# mb#)  | isTrue# (v ># 0#) = S# v 
     154    where 
     155      v = indexIntArray# mb# 0# 
     156toSmall (J# -1# mb#) | isTrue# (v <# 0#) = S# v 
     157    where 
     158      v = negateInt# (indexIntArray# mb# 0#) 
     159toSmall i         = i 
     160 
     161-- | Smart 'J#' constructor which tries to construct 'S#' if possible 
     162smartJ# :: Int# -> ByteArray# -> Integer 
     163smartJ# s# mb# = toSmall (J# s# mb#) 
    146164\end{code} 
    147165 
    148166 
    quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2 
    176194quotRemInteger (J# s1 d1) (J# s2 d2) 
    177195  = case (quotRemInteger# s1 d1 s2 d2) of 
    178196          (# s3, d3, s4, d4 #) 
    179             -> (# J# s3 d3, J# s4 d4 #) 
     197            -> (# smartJ# s3 d3, smartJ# s4 d4 #) 
    180198 
    181199{-# NOINLINE divModInteger #-} 
    182200divModInteger :: Integer -> Integer -> (# Integer, Integer #) 
    divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2 
    192210divModInteger (J# s1 d1) (J# s2 d2) 
    193211  = case (divModInteger# s1 d1 s2 d2) of 
    194212          (# s3, d3, s4, d4 #) 
    195             -> (# J# s3 d3, J# s4 d4 #) 
     213            -> (# smartJ# s3 d3, smartJ# s4 d4 #) 
    196214 
    197215{-# NOINLINE remInteger #-} 
    198216remInteger :: Integer -> Integer -> Integer 
    remInteger (J# sa a) (S# b) 
    212230    case remInteger# sa a sb b' of { (# sr, r #) -> 
    213231    S# (integer2Int# sr r) }} 
    214232remInteger (J# sa a) (J# sb b) 
    215   = case remInteger# sa a sb b of (# sr, r #) -> J# sr r 
     233  = case remInteger# sa a sb b of (# sr, r #) -> smartJ# sr r 
    216234 
    217235{-# NOINLINE quotInteger #-} 
    218236quotInteger :: Integer -> Integer -> Integer 
    quotInteger (S# a) (J# sb b) 
    227245quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib 
    228246quotInteger (J# sa a) (S# b) 
    229247  = case int2Integer# b of { (# sb, b' #) -> 
    230     case quotInteger# sa a sb b' of (# sq, q #) -> J# sq q } 
     248    case quotInteger# sa a sb b' of (# sq, q #) -> smartJ# sq q } 
    231249quotInteger (J# sa a) (J# sb b) 
    232   = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g 
     250  = case quotInteger# sa a sb b of (# sg, g #) -> smartJ# sg g 
    233251 
    234252{-# NOINLINE modInteger #-} 
    235253modInteger :: Integer -> Integer -> Integer 
    modInteger (J# sa a) (S# b) 
    241259    case modInteger# sa a sb b' of { (# sr, r #) -> 
    242260    S# (integer2Int# sr r) }} 
    243261modInteger (J# sa a) (J# sb b) 
    244   = case modInteger# sa a sb b of (# sr, r #) -> J# sr r 
     262  = case modInteger# sa a sb b of (# sr, r #) -> smartJ# sr r 
    245263 
    246264{-# NOINLINE divInteger #-} 
    247265divInteger :: Integer -> Integer -> Integer 
    divInteger (S# a) (S# b) = S# (divInt# a b) 
    250268divInteger ia@(S# _) ib@(J# _ _) = divInteger (toBig ia) ib 
    251269divInteger (J# sa a) (S# b) 
    252270  = case int2Integer# b of { (# sb, b' #) -> 
    253     case divInteger# sa a sb b' of (# sq, q #) -> J# sq q } 
     271    case divInteger# sa a sb b' of (# sq, q #) -> smartJ# sq q } 
    254272divInteger (J# sa a) (J# sb b) 
    255   = case divInteger# sa a sb b of (# sg, g #) -> J# sg g 
     273  = case divInteger# sa a sb b of (# sg, g #) -> smartJ# sg g 
    256274\end{code} 
    257275 
    258276 
    gcdInteger ia@(S# a) ib@(J# sb b) 
    273291             !absSb = if isTrue# (sb <# 0#) then negateInt# sb else sb 
    274292gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia 
    275293gcdInteger (J# sa a) (J# sb b) 
    276   = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g 
     294  = case gcdInteger# sa a sb b of (# sg, g #) -> smartJ# sg g 
    277295 
    278296-- | Extended euclidean algorithm. 
    279297-- 
    gcdExtInteger a@(S# _) b@(J# _ _) = gcdExtInteger (toBig a) b 
    286304gcdExtInteger a@(J# _ _) b@(S# _) = gcdExtInteger a (toBig b) 
    287305gcdExtInteger (J# sa a) (J# sb b) 
    288306  = case gcdExtInteger# sa a sb b of 
    289       (# sg, g, ss, s #) -> (# J# sg g, J# ss s #) 
     307      (# sg, g, ss, s #) -> (# smartJ# sg g, smartJ# ss s #) 
    290308 
    291309-- | Compute least common multiple. 
    292310{-# NOINLINE lcmInteger #-} 
    divExact (S# a) (J# sb b) 
    314332divExact (J# sa a) (S# b) 
    315333  = case int2Integer# b of 
    316334    (# sb, b' #) -> case divExactInteger# sa a sb b' of 
    317                     (# sd, d #) -> J# sd d 
     335                    (# sd, d #) -> smartJ# sd d 
    318336divExact (J# sa a) (J# sb b) 
    319   = case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d 
     337  = case divExactInteger# sa a sb b of (# sd, d #) -> smartJ# sd d 
    320338\end{code} 
    321339 
    322340 
    plusInteger i1@(S# i) i2@(S# j) = case addIntC# i j of 
    458476plusInteger i1@(J# _ _) i2@(S# _) = plusInteger i1 (toBig i2) 
    459477plusInteger i1@(S# _) i2@(J# _ _) = plusInteger (toBig i1) i2 
    460478plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of 
    461                                     (# s, d #) -> J# s d 
     479                                    (# s, d #) -> smartJ# s d 
    462480 
    463481{-# NOINLINE minusInteger #-} 
    464482minusInteger :: Integer -> Integer -> Integer 
    minusInteger i1@(S# i) i2@(S# j) = case subIntC# i j of 
    470488minusInteger i1@(J# _ _) i2@(S# _) = minusInteger i1 (toBig i2) 
    471489minusInteger i1@(S# _) i2@(J# _ _) = minusInteger (toBig i1) i2 
    472490minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of 
    473                                      (# s, d #) -> J# s d 
     491                                     (# s, d #) -> smartJ# s d 
    474492 
    475493{-# NOINLINE timesInteger #-} 
    476494timesInteger :: Integer -> Integer -> Integer 
    477495timesInteger i1@(S# i) i2@(S# j)   = if isTrue# (mulIntMayOflo# i j ==# 0#) 
    478496                                     then S# (i *# j) 
    479497                                     else timesInteger (toBig i1) (toBig i2) 
    480 timesInteger i1@(J# _ _) i2@(S# _) = timesInteger i1 (toBig i2) 
     498timesInteger (S# 0#)     _         = S# 0# 
     499timesInteger (S# -1#)    i2        = negateInteger i2 
     500timesInteger (S# 1#)     i2        = i2 
    481501timesInteger i1@(S# _) i2@(J# _ _) = timesInteger (toBig i1) i2 
     502timesInteger i1@(J# _ _) i2@(S# _) = timesInteger i2 i1 -- swap args & retry 
    482503timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of 
    483504                                     (# s, d #) -> J# s d 
    484505 
    encodeDoubleInteger (J# s# d#) e = encodeDouble# s# d# e 
    510531{-# NOINLINE decodeDoubleInteger #-} 
    511532decodeDoubleInteger :: Double# -> (# Integer, Int# #) 
    512533decodeDoubleInteger d = case decodeDouble# d of 
    513                         (# exp#, s#, d# #) -> (# J# s# d#, exp# #) 
     534                        (# exp#, s#, d# #) -> (# smartJ# s# d#, exp# #) 
    514535 
    515536-- previous code: doubleFromInteger n = fromInteger n = encodeFloat n 0 
    516537-- doesn't work too well, because encodeFloat is defined in 
    x@(S# _) `andInteger` y@(J# _ _) = toBig x `andInteger` y 
    557578x@(J# _ _) `andInteger` y@(S# _)     = x `andInteger` toBig y 
    558579(J# s1 d1) `andInteger`   (J# s2 d2) = 
    559580     case andInteger# s1 d1 s2 d2 of 
    560        (# s, d #) -> J# s d 
     581       (# s, d #) -> smartJ# s d 
    561582 
    562583{-# NOINLINE orInteger #-} 
    563584orInteger :: Integer -> Integer -> Integer 
    x@(S# _) `xorInteger` y@(J# _ _) = toBig x `xorInteger` y 
    575596x@(J# _ _) `xorInteger` y@(S# _)     = x `xorInteger` toBig y 
    576597(J# s1 d1) `xorInteger`   (J# s2 d2) = 
    577598     case xorInteger# s1 d1 s2 d2 of 
    578        (# s, d #) -> J# s d 
     599       (# s, d #) -> smartJ# s d 
    579600 
    580601{-# NOINLINE complementInteger #-} 
    581602complementInteger :: Integer -> Integer 
    582603complementInteger (S# x) 
    583604    = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#))) 
    584605complementInteger (J# s d) 
    585     = case complementInteger# s d of (# s', d' #) -> J# s' d' 
     606    = case complementInteger# s d of (# s', d' #) -> smartJ# s' d' 
    586607 
    587608{-# NOINLINE shiftLInteger #-} 
    588609shiftLInteger :: Integer -> Int# -> Integer 
    shiftLInteger (J# s d) i = case mul2ExpInteger# s d i of 
    594615shiftRInteger :: Integer -> Int# -> Integer 
    595616shiftRInteger j@(S# _) i = shiftRInteger (toBig j) i 
    596617shiftRInteger (J# s d) i = case fdivQ2ExpInteger# s d i of 
    597                            (# s', d' #) -> J# s' d' 
     618                           (# s', d' #) -> smartJ# s' d' 
    598619 
    599620{-# NOINLINE testBitInteger #-} 
    600621testBitInteger :: Integer -> Int# -> Bool 
    testBitInteger (J# s d) i = isTrue# (testBitInteger# s d i /=# 0#) 
    606627powInteger :: Integer -> Word# -> Integer 
    607628powInteger j@(S# _) e = powInteger (toBig j) e 
    608629powInteger (J# s d) e = case powInteger# s d e of 
    609                             (# s', d' #) -> J# s' d' 
     630                            (# s', d' #) -> smartJ# s' d' 
    610631 
    611632-- | \"@'powModInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to 
    612633-- exponent @/e/@ modulo @/m/@. 
    powInteger (J# s d) e = case powInteger# s d e of 
    620641powModInteger :: Integer -> Integer -> Integer -> Integer 
    621642powModInteger (J# s1 d1) (J# s2 d2) (J# s3 d3) = 
    622643    case powModInteger# s1 d1 s2 d2 s3 d3 of 
    623         (# s', d' #) -> J# s' d' 
     644        (# s', d' #) -> smartJ# s' d' 
    624645powModInteger b e m = powModInteger (toBig b) (toBig e) (toBig m) 
    625646 
    626647-- | \"@'powModSecInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to 
    recipModInteger j@(S# _) m@(S# _) = recipModInteger (toBig j) (toBig m) 
    651672recipModInteger j@(S# _) m@(J# _ _) = recipModInteger (toBig j) m 
    652673recipModInteger j@(J# _ _) m@(S# _) = recipModInteger j (toBig m) 
    653674recipModInteger (J# s d) (J# ms md) = case recipModInteger# s d ms md of 
    654                            (# s', d' #) -> J# s' d' 
     675                           (# s', d' #) -> smartJ# s' d' 
    655676 
    656677-- | Probalistic Miller-Rabin primality test. 
    657678-- 
    testPrimeInteger (J# s d) reps = testPrimeInteger# s d reps 
    681702{-# NOINLINE nextPrimeInteger #-} 
    682703nextPrimeInteger :: Integer -> Integer 
    683704nextPrimeInteger j@(S# _) = nextPrimeInteger (toBig j) 
    684 nextPrimeInteger (J# s d) = case nextPrimeInteger# s d of (# s', d' #) -> J# s' d' 
     705nextPrimeInteger (J# s d) = case nextPrimeInteger# s d of (# s', d' #) -> smartJ# s' d' 
    685706 
    686707-- | Compute number of digits (without sign) in given @/base/@. 
    687708-- 
    exportIntegerToAddr j@(S# _) addr o e = exportIntegerToAddr (toBig j) addr o e - 
    769790--   significant byte first if @/order/@ is @-1#@, and 
    770791-- 
    771792-- * returns a new 'Integer' 
    772 -- 
    773 -- It's recommended to avoid calling 'importIntegerFromByteArray' for 
    774 -- known to be small integers as this function currently always 
    775 -- returns a big integer even if it would fit into a small integer. 
    776793{-# NOINLINE importIntegerFromByteArray #-} 
    777794importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer 
    778 importIntegerFromByteArray ba o l e = case importIntegerFromByteArray# ba o l e of (# s', d' #) -> J# s' d' 
     795importIntegerFromByteArray ba o l e = case importIntegerFromByteArray# ba o l e of (# s', d' #) -> smartJ# s' d' 
    779796 
    780797-- | Read 'Integer' (without sign) from memory location at @/addr/@ in 
    781798-- base-256 representation. 
    importIntegerFromByteArray ba o l e = case importIntegerFromByteArray# ba o l e 
    788805{-# NOINLINE importIntegerFromAddr #-} 
    789806importIntegerFromAddr :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Integer #) 
    790807importIntegerFromAddr addr l e st = case importIntegerFromAddr# addr l e st of 
    791                                       (# st', s', d' #) -> (# st', J# s' d' #) 
     808                                      (# st', s', d' #) -> (# st', smartJ# s' d' #) 
    792809 
    793810\end{code} 
    794811