ghc/lib/prelude/IInteger.hs

   1 module PreludeCore (
   2         Integer(..),
   3         int2Integer,
   4         _integer_0, _integer_1, _integer_m1
   5     ) where
   6
   7 import Cls
   8 import Core
   9 import IInt
  10 import IRatio           ( (%) )
  11 import ITup2            -- instances
  12 import List             ( (++), foldr )
  13 import Prel             ( not, otherwise, (&&) )
  14 import PS               ( _PackedString, _unpackPS )
  15 import Text
  16
  17 ------------------------------------------------------
  18 -- a magical Integer-ish function that
  19 -- the compiler inserts references to
  20
  21 int2Integer :: Int -> Integer
  22 int2Integer (I# i#) = int2Integer# i#
  23
  24 ------------------------------------------------------
  25 -- some *very* heavily-used constants
  26
  27 _integer_0, _integer_1, _integer_m1 :: Integer
  28 _integer_0  = 0
  29 _integer_1  = 1
  30 _integer_m1 = (-1)
  31
  32 ------------------------------------------------------
  33
  34 instance  Eq Integer  where
  35     (J# a1 s1 d1) == (J# a2 s2 d2)
  36       = (cmpInteger# a1 s1 d1 a2 s2 d2) ==# 0#
  37
  38     (J# a1 s1 d1) /= (J# a2 s2 d2)
  39       = (cmpInteger# a1 s1 d1 a2 s2 d2) /=# 0#
  40
  41 instance  Ord Integer  where
  42     (J# a1 s1 d1) <= (J# a2 s2 d2)
  43       = (cmpInteger# a1 s1 d1 a2 s2 d2) <=# 0#
  44
  45     (J# a1 s1 d1) <  (J# a2 s2 d2)
  46       = (cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#
  47
  48     (J# a1 s1 d1) >= (J# a2 s2 d2)
  49       = (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
  50
  51     (J# a1 s1 d1) >  (J# a2 s2 d2)
  52       = (cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#
  53
  54     x@(J# a1 s1 d1) `max` y@(J# a2 s2 d2)
  55       = if ((cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#) then x else y
  56
  57     x@(J# a1 s1 d1) `min` y@(J# a2 s2 d2)
  58       = if ((cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#) then x else y
  59
  60     _tagCmp (J# a1 s1 d1) (J# a2 s2 d2)
  61        = case cmpInteger# a1 s1 d1 a2 s2 d2 of { res# ->
  62          if res# <# 0# then _LT else
  63          if res# ># 0# then _GT else _EQ
  64          }
  65
  66 instance  Num Integer  where
  67     (+) (J# a1 s1 d1) (J# a2 s2 d2)
  68       = plusInteger# a1 s1 d1 a2 s2 d2
  69
  70     (-) (J# a1 s1 d1) (J# a2 s2 d2)
  71       = minusInteger# a1 s1 d1 a2 s2 d2
  72
  73     negate (J# a s d) = negateInteger# a s d
  74
  75     (*) (J# a1 s1 d1) (J# a2 s2 d2)
  76       = timesInteger# a1 s1 d1 a2 s2 d2
  77
  78     -- ORIG: abs n = if n >= 0 then n else -n
  79
  80     abs n@(J# a1 s1 d1)
  81       = case _integer_0 of { J# a2 s2 d2 ->
  82         if (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
  83         then n
  84         else negateInteger# a1 s1 d1
  85         }
  86
  87     {- ORIG:
  88     signum n | n <  0   = -1
  89              | n == 0   = 0
  90              | otherwise= 1
  91     -}
  92
  93     signum n@(J# a1 s1 d1)
  94       = case _integer_0 of { J# a2 s2 d2 ->
  95         let
  96             cmp = cmpInteger# a1 s1 d1 a2 s2 d2
  97         in
  98         if      cmp >#  0# then _integer_1
  99         else if cmp ==# 0# then _integer_0
 100         else                    _integer_m1
 101         }
 102
 103     fromInteger x       =  x
 104
 105     fromInt (I# n#)     =  int2Integer# n# -- gives back a full-blown Integer
 106
 107 instance  Real Integer  where
 108     toRational x        =  x % 1
 109
 110 instance  Integral Integer where
 111     quotRem (J# a1 s1 d1) (J# a2 s2 d2)
 112       = case (quotRemInteger# a1 s1 d1 a2 s2 d2) of
 113           _Return2GMPs a3 s3 d3 a4 s4 d4
 114             -> (J# a3 s3 d3, J# a4 s4 d4)
 115
 116 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
 117
 118     divMod (J# a1 s1 d1) (J# a2 s2 d2)
 119       = case (divModInteger# a1 s1 d1 a2 s2 d2) of
 120           _Return2GMPs a3 s3 d3 a4 s4 d4
 121             -> (J# a3 s3 d3, J# a4 s4 d4)
 122 -}
 123     toInteger n      = n
 124     toInt (J# a s d) = case (integer2Int# a s d) of { n# -> I# n# }
 125
 126     -- the rest are identical to the report default methods;
 127     -- you get slightly better code if you let the compiler
 128     -- see them right here:
 129     n `quot` d  =  q  where (q,r) = quotRem n d
 130     n `rem` d   =  r  where (q,r) = quotRem n d
 131     n `div` d   =  q  where (q,r) = divMod n d
 132     n `mod` d   =  r  where (q,r) = divMod n d
 133
 134     divMod n d  =  case (quotRem n d) of { qr@(q,r) ->
 135                    if signum r == - signum d then (q-1, r+d) else qr }
 136                    -- Case-ified by WDP 94/10
 137
 138     even x = (==) (rem x 2) 0
 139     odd x  = (/=) (rem x 2) 0
 140
 141 instance  Ix Integer  where
 142     range (m,n)         =  [m..n]
 143     index b@(m,n) i
 144         | inRange b i   =  fromInteger (i - m)
 145         | otherwise     =  error ("Ix.Integer.index{PreludeCore}: Index "
 146                                   ++ show i ++ " outside the range "
 147                                   ++ show b ++ ".\n")
 148     inRange (m,n) i     =  m <= i && i <= n
 149
 150 instance  Enum Integer  where
 151 {- RAW PRELUDE ************************
 152     enumFrom            =  numericEnumFrom
 153     enumFromThen        =  numericEnumFromThen
 154 -}
 155     enumFrom n = n : enumFrom (n + 1)
 156     enumFromThen m n = en' m (n - m)
 157             where en' m n = m : en' (m + n) n
 158
 159
 160 instance  Text Integer  where
 161     readsPrec p x = readSigned readDec x
 162     showsPrec   x = showSigned showInt x