ghc/lib/prelude/IInteger.hs

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