1 module PreludeCore ( Int(..), rangeComplaint_Ix_Int#{-see comment later-} ) where
5 import IInteger -- instances
8 import List ( (++), map, takeWhile )
9 import Prel ( otherwise, (&&), (||), chr, ord )
10 import PS ( _PackedString, _unpackPS )
15 -- definitions of the boxed PrimOps; these will be
16 -- used in the case of partial applications, etc.
18 plusInt (I# x) (I# y) = I# (plusInt# x y)
19 minusInt(I# x) (I# y) = I# (minusInt# x y)
20 timesInt(I# x) (I# y) = I# (timesInt# x y)
21 quotInt (I# x) (I# y) = I# (quotInt# x y)
22 remInt (I# x) (I# y) = I# (remInt# x y)
23 negateInt (I# x) = I# (negateInt# x)
24 gtInt (I# x) (I# y) = gtInt# x y
25 geInt (I# x) (I# y) = geInt# x y
26 eqInt (I# x) (I# y) = eqInt# x y
27 neInt (I# x) (I# y) = neInt# x y
28 ltInt (I# x) (I# y) = ltInt# x y
29 leInt (I# x) (I# y) = leInt# x y
31 ---------------------------------------------------------------
37 instance Ord Int where
43 max a b = case _tagCmp a b of { _LT -> b; _EQ -> a; _GT -> a }
44 min a b = case _tagCmp a b of { _LT -> a; _EQ -> a; _GT -> b }
46 _tagCmp (I# a#) (I# b#)
47 = if (a# ==# b#) then _EQ
48 else if (a# <# b#) then _LT else _GT
50 instance Num Int where
52 (-) x y = minusInt x y
53 negate x = negateInt x
54 (*) x y = timesInt x y
55 abs n = if n `geInt` 0 then n else (negateInt n)
57 signum n | n `ltInt` 0 = negateInt 1
61 fromInteger (J# a# s# d#)
62 = case (integer2Int# a# s# d#) of { i# -> I# i# }
66 instance Real Int where
67 toRational x = toInteger x % 1
69 instance Integral Int where
70 a@(I# _) `quotRem` b@(I# _) = (a `quotInt` b, a `remInt` b)
71 -- OK, so I made it a little stricter. Shoot me. (WDP 94/10)
73 -- following chks for zero divisor are non-standard (WDP)
74 a `quot` b = if b /= 0
76 else error "Integral.Int.quot{PreludeCore}: divide by 0\n"
79 else error "Integral.Int.rem{PreludeCore}: divide by 0\n"
81 x `div` y = if x > 0 && y < 0 then quotInt (x-y-1) y
82 else if x < 0 && y > 0 then quotInt (x-y+1) y
84 x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
85 if r/=0 then r+y else 0
90 divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
91 -- Stricter. Sorry if you don't like it. (WDP 94/10)
93 even x = eqInt (x `mod` 2) 0
94 odd x = neInt (x `mod` 2) 0
96 toInteger (I# n#) = int2Integer# n# -- give back a full-blown Integer
99 rangeComplaint_Ix_Int# i m n -- export it so it will *not* be floated inwards
100 = error ("Ix.Int.index2{PreludeCore}: Index "
101 ++ show (I# i) ++ " outside the range "
102 ++ show (I# m,I# n) ++ ".\n")
104 instance Ix Int where
106 index b@(I# m, I# n) (I# i)
107 | inRange b (I# i) = I# (i -# m)
108 | otherwise = rangeComplaint_Ix_Int# i m n
109 inRange (I# m, I# n) (I# i) = m <=# i && i <=# n
111 instance Enum Int where
112 #ifndef USE_FOLDR_BUILD
113 enumFrom x = x : enumFrom (x `plusInt` 1)
114 enumFromTo n m = takeWhile (<= m) (enumFrom n)
116 {-# INLINE enumFrom #-}
117 {-# INLINE enumFromTo #-}
118 enumFrom x = _build (\ c _ ->
119 let g x = x `c` g (x `plusInt` 1) in g x)
120 enumFromTo x y = _build (\ c n ->
121 let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
123 enumFromThen m n = en' m (n `minusInt` m)
124 where en' m n = m : en' (m `plusInt` n) n
125 enumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
128 instance Text Int where
129 readsPrec p x = readSigned readDec x
130 showsPrec x = showSigned showInt x
131 readList = _readList (readsPrec 0)
132 showList = _showList (showsPrec 0)
134 ---------------------------------------------------------------
135 instance _CCallable Int
136 instance _CReturnable Int
138 #if defined(__UNBOXED_INSTANCES__)
139 ---------------------------------------------------------------
140 -- Instances for Int#
141 ---------------------------------------------------------------
143 instance Eq Int# where
144 (==) x y = eqInt# x y
145 (/=) x y = neInt# x y
147 instance Ord Int# where
148 (<=) x y = leInt# x y
150 (>=) x y = geInt# x y
153 max a b = case _tagCmp a b of { _LT -> b; _EQ -> a; _GT -> a }
154 min a b = case _tagCmp a b of { _LT -> a; _EQ -> a; _GT -> b }
157 = if (a `eqInt#` b) then _EQ
158 else if (a `ltInt#` b) then _LT else _GT
160 instance Num Int# where
161 (+) x y = plusInt# x y
162 (-) x y = minusInt# x y
163 negate x = negateInt# x
164 (*) x y = timesInt# x y
165 abs n = if n `geInt#` 0 then n else (negateInt# n)
167 signum n | n `ltInt#` 0 = negateInt# 1
171 fromInteger (J# a# s# d#)
172 = integer2Int# a# s# d#
176 instance Real Int# where
177 toRational x = toInteger x % 1
179 instance Integral Int# where
180 a `quotRem` b = (a `quotInt#` b, a `remInt#` b)
182 -- following chks for zero divisor are non-standard (WDP)
183 a `quot` b = if b /= 0
185 else error "Integral.Int#.quot{PreludeCore}: divide by 0\n"
186 a `rem` b = if b /= 0
188 else error "Integral.Int#.rem{PreludeCore}: divide by 0\n"
190 x `div` y = if x > 0 && y < 0 then quotInt# (x-y-1) y
191 else if x < 0 && y > 0 then quotInt# (x-y+1) y
193 x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
194 if r/=0 then r+y else 0
197 where r = remInt# x y
199 divMod x y = (x `div` y, x `mod` y)
201 even x = eqInt# (x `mod` 2) 0
202 odd x = neInt# (x `mod` 2) 0
204 toInteger n# = int2Integer# n# -- give back a full-blown Integer
207 instance Ix Int# where
210 | inRange b i = I# (i -# m)
211 | otherwise = rangeComplaint_Ix_Int# i m n
212 inRange (m, n) i = m <=# i && i <=# n
214 instance Enum Int# where
215 #ifndef USE_FOLDR_BUILD
216 enumFrom x = x : enumFrom (x `plusInt#` 1)
217 enumFromTo n m = takeWhile (<= m) (enumFrom n)
219 {-# INLINE enumFrom #-}
220 {-# INLINE enumFromTo #-}
221 enumFrom x = _build (\ c _ ->
222 let g x = x `c` g (x `plusInt#` 1) in g x)
223 enumFromTo x y = _build (\ c n ->
224 let g x = if x <= y then x `c` g (x `plusInt#` 1) else n in g x)
226 enumFromThen m n = en' m (n `minusInt#` m)
227 where en' m n = m : en' (m `plusInt#` n) n
228 enumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
231 -- ToDo: efficient Text Int# instance
232 instance Text Int# where
233 readsPrec p s = map (\ (I# i#, s) -> (i#, s)) (readsPrec p s)
234 showsPrec p x = showsPrec p (I# x)
235 readList = _readList (readsPrec 0)
236 showList = _showList (showsPrec 0)
238 instance _CCallable Int#
239 instance _CReturnable Int#
241 #endif {-UNBOXED INSTANCES-}
243 ---------------------------------------------------------------
244 -- Instances for Addr Word etc #
245 ---------------------------------------------------------------
247 instance _CCallable _Addr
248 instance _CCallable _Word
249 instance _CCallable (_StablePtr a)
250 instance _CCallable _MallocPtr
252 instance _CReturnable _Addr
253 instance _CReturnable _Word
254 instance _CReturnable ()
255 instance _CReturnable (_StablePtr a)
256 instance _CReturnable _MallocPtr
258 ---------------------------------------------------------------
259 gtAddr (A# x) (A# y) = gtAddr# x y
260 geAddr (A# x) (A# y) = geAddr# x y
261 eqAddr (A# x) (A# y) = eqAddr# x y
262 neAddr (A# x) (A# y) = neAddr# x y
263 ltAddr (A# x) (A# y) = ltAddr# x y
264 leAddr (A# x) (A# y) = leAddr# x y
266 instance Eq _Addr where
267 (==) x y = eqAddr x y
268 (/=) x y = neAddr x y
270 instance Ord _Addr where
271 (<=) x y = leAddr x y
273 (>=) x y = geAddr x y
276 max a b = case _tagCmp a b of { _LT -> b; _EQ -> a; _GT -> a }
277 min a b = case _tagCmp a b of { _LT -> a; _EQ -> a; _GT -> b }
279 _tagCmp (A# a#) (A# b#)
280 = if (eqAddr# a# b#) then _EQ
281 else if (ltAddr# a# b#) then _LT else _GT
283 ---------------------------------------------------------------
284 gtWord (W# x) (W# y) = gtWord# x y
285 geWord (W# x) (W# y) = geWord# x y
286 eqWord (W# x) (W# y) = eqWord# x y
287 neWord (W# x) (W# y) = neWord# x y
288 ltWord (W# x) (W# y) = ltWord# x y
289 leWord (W# x) (W# y) = leWord# x y
291 instance Eq _Word where
292 (==) x y = eqWord x y
293 (/=) x y = neWord x y
295 instance Ord _Word where
296 (<=) x y = leWord x y
298 (>=) x y = geWord x y
301 max a b = case _tagCmp a b of { _LT -> b; _EQ -> a; _GT -> a }
302 min a b = case _tagCmp a b of { _LT -> a; _EQ -> a; _GT -> b }
304 _tagCmp (W# a#) (W# b#)
305 = if (eqWord# a# b#) then _EQ
306 else if (ltWord# a# b#) then _LT else _GT