X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelNum.lhs;h=92ce9ae7052b0126bdd5dd1be5b9f0e5c17748ea;hb=f3653fdfe391a2104c24fdcc4931fa695d3b4d60;hp=48ed0d956373317893d1ffbd8685f51b65d6b9d5;hpb=e921b2e307532e0f30eefa88b11a124be592bde4;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs
index 48ed0d9..92ce9ae 100644
--- a/ghc/lib/std/PrelNum.lhs
+++ b/ghc/lib/std/PrelNum.lhs
@@ -14,7 +14,7 @@ and the type
 
 
 \begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS -fcompiling-prelude -fno-implicit-prelude #-}
 
 module PrelNum where
 
@@ -144,7 +144,8 @@ toBig i@(J# _ _) = i
 
 \begin{code}
 quotRemInteger :: Integer -> Integer -> (Integer, Integer)
-quotRemInteger (S# i) (S# j)         
+quotRemInteger a@(S# (-2147483648#)) b = quotRemInteger (toBig a) b
+quotRemInteger (S# i) (S# j)
   = case quotRemInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j ) 
 quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2)
 quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2
@@ -153,7 +154,8 @@ quotRemInteger (J# s1 d1) (J# s2 d2)
 	  (# s3, d3, s4, d4 #)
 	    -> (J# s3 d3, J# s4 d4)
 
-divModInteger (S# i) (S# j)         
+divModInteger a@(S# (-2147483648#)) b = divModInteger (toBig a) b
+divModInteger (S# i) (S# j)
   = case divModInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j) 
 divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2)
 divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2
@@ -165,13 +167,17 @@ divModInteger (J# s1 d1) (J# s2 d2)
 remInteger :: Integer -> Integer -> Integer
 remInteger ia 0
   = error "Prelude.Integral.rem{Integer}: divide by 0"
-remInteger (S# a) (S# b) 
-  = S# (remInt# a b)
+remInteger a@(S# (-2147483648#)) b = remInteger (toBig a) b
+remInteger (S# a) (S# b) = S# (remInt# a b)
+{- Special case doesn't work, because a 1-element J# has the range
+   -(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1)
 remInteger ia@(S# a) (J# sb b)
   | sb ==# 1#  = S# (remInt# a (word2Int# (integer2Word# sb b)))
   | sb ==# -1# = S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
   | 0# <# sb   = ia
   | otherwise  = S# (0# -# a)
+-}
+remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib
 remInteger (J# sa a) (S# b)
   = case int2Integer# b of { (# sb, b #) ->
     case remInteger# sa a sb b of { (# sr, r #) ->
@@ -182,12 +188,15 @@ remInteger (J# sa a) (J# sb b)
 quotInteger :: Integer -> Integer -> Integer
 quotInteger ia 0
   = error "Prelude.Integral.quot{Integer}: divide by 0"
-quotInteger (S# a) (S# b) 
-  = S# (quotInt# a b)
+quotInteger a@(S# (-2147483648#)) b = quotInteger (toBig a) b
+quotInteger (S# a) (S# b) = S# (quotInt# a b)
+{- Special case disabled, see remInteger above
 quotInteger (S# a) (J# sb b)
   | sb ==# 1#  = S# (quotInt# a (word2Int# (integer2Word# sb b)))
   | sb ==# -1# = S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
   | otherwise  = zeroInteger
+-}
+quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib
 quotInteger (J# sa a) (S# b)
   = case int2Integer# b of { (# sb, b #) ->
     case quotInteger# sa a sb b of (# sq, q #) -> J# sq q }
@@ -199,16 +208,17 @@ quotInteger (J# sa a) (J# sb b)
 
 \begin{code}
 gcdInteger :: Integer -> Integer -> Integer
-gcdInteger (S# a) (S# b)
-  = case gcdInt# a b of g -> S# g
+gcdInteger a@(S# (-2147483648#)) b = gcdInteger (toBig a) b
+gcdInteger a b@(S# (-2147483648#)) = gcdInteger a (toBig b)
+gcdInteger (S# a) (S# b) = S# (gcdInt# a b)
 gcdInteger ia@(S# a) ib@(J# sb b)
   | a  ==# 0#  = abs ib
   | sb ==# 0#  = abs ia
-  | otherwise  = case gcdIntegerInt# sb b a of g -> S# g
+  | otherwise  = S# (gcdIntegerInt# sb b a)
 gcdInteger ia@(J# sa a) ib@(S# b)
   | sa ==# 0#  = abs ib
   | b ==# 0#   = abs ia
-  | otherwise  = case gcdIntegerInt# sa a b of g -> S# g
+  | otherwise  = S# (gcdIntegerInt# sa a b)
 gcdInteger (J# sa a) (J# sb b)
   = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g
 
@@ -223,8 +233,8 @@ lcmInteger a b
         ab = abs b
 
 divExact :: Integer -> Integer -> Integer
-divExact (S# a) (S# b)
-  = S# (quotInt# a b)
+divExact a@(S# (-2147483648#)) b = divExact (toBig a) b
+divExact (S# a) (S# b) = S# (quotInt# a b)
 divExact (S# a) (J# sb b)
   = S# (quotInt# a (sb *# (word2Int# (integer2Word# sb b))))
 divExact (J# sa a) (S# b)
@@ -374,10 +384,21 @@ instance  Enum Integer  where
     {-# INLINE enumFromThen #-}
     {-# INLINE enumFromTo #-}
     {-# INLINE enumFromThenTo #-}
-    enumFrom x             = build (\c _ -> enumDeltaIntegerFB 	 c   x 1)
-    enumFromThen x y       = build (\c _ -> enumDeltaIntegerFB 	 c   x (y-x))
-    enumFromTo x lim	   = build (\c n -> enumDeltaToIntegerFB c n x 1     lim)
-    enumFromThenTo x y lim = build (\c n -> enumDeltaToIntegerFB c n x (y-x) lim)
+    enumFrom x             = efdInteger  x 1
+    enumFromThen x y       = efdInteger  x (y-x)
+    enumFromTo x lim	   = efdtInteger x 1     lim
+    enumFromThenTo x y lim = efdtInteger x (y-x) lim
+
+
+efdInteger  = enumDeltaIntegerList
+efdtInteger = enumDeltaToIntegerList
+
+{-# RULES
+"efdInteger"		forall x y.  efdInteger x y	    = build (\c _ -> enumDeltaIntegerFB c x y)
+"efdtInteger"		forall x y l.efdtInteger x y l	    = build (\c n -> enumDeltaToIntegerFB c n x y l)
+"enumDeltaInteger" 	enumDeltaIntegerFB   (:)    = enumDeltaIntegerList
+"enumDeltaToInteger" 	enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
+ #-}
 
 enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
 enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d
@@ -411,10 +432,6 @@ dn_list x delta lim = go (x::Integer)
 			go x | x < lim   = []
 			     | otherwise = x : go (x+delta)
 
-{-# RULES
-"enumDeltaInteger" 	enumDeltaIntegerFB   (:)    = enumDeltaIntegerList
-"enumDeltaToInteger" 	enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
- #-}
 \end{code}