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, 19 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