[project @ 1999-09-12 16:24:46 by sof]

[ghc-hetmet.git] / ghc / lib / std / PrelNum.lhs

diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs
index 97c853c..a946e1b 100644 (file)
--- a/ghc/lib/std/PrelNum.lhs
+++ b/ghc/lib/std/PrelNum.lhs
@@ -247,15 +247,15 @@ instance  Ord Integer  where
         }
 
 toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d }
-toBig i@(J# s d) = i
+toBig i@(J# _ _) = i
 
 instance  Num Integer  where
     (+) i1@(S# i) i2@(S# j)
        = case addIntC# i j of { (# r, c #) ->
          if c ==# 0# then S# r
          else toBig i1 + toBig i2 }
-    (+) i1@(J# s d) i2@(S# i)  = i1 + toBig i2
-    (+) i1@(S# i) i2@(J# s d)  = toBig i1 + i2
+    (+) i1@(J# _ _) i2@(S# _)  = i1 + toBig i2
+    (+) i1@(S# _) i2@(J# _ _)  = toBig i1 + i2
     (+) (J# s1 d1) (J# s2 d2)
       = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 
@@ -263,8 +263,8 @@ instance  Num Integer  where
        = case subIntC# i j of { (# r, c #) ->
          if c ==# 0# then S# r
          else toBig i1 - toBig i2 }
-    (-) i1@(J# s d) i2@(S# i)  = i1 - toBig i2
-    (-) i1@(S# i) i2@(J# s d)  = toBig i1 - i2
+    (-) i1@(J# _ _) i2@(S# _)  = i1 - toBig i2
+    (-) i1@(S# _) i2@(J# _ _)  = toBig i1 - i2
     (-) (J# s1 d1) (J# s2 d2)
       = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 
@@ -272,12 +272,12 @@ instance  Num Integer  where
        = case mulIntC# i j of { (# r, c #) ->
          if c ==# 0# then S# r
          else toBig i1 * toBig i2 }
-    (*) i1@(J# s d) i2@(S# i)  = i1 * toBig i2
-    (*) i1@(S# i) i2@(J# s d)  = toBig i1 * i2
+    (*) i1@(J# _ _) i2@(S# _)  = i1 * toBig i2
+    (*) i1@(S# _) i2@(J# _ _)  = toBig i1 * i2
     (*) (J# s1 d1) (J# s2 d2)
       = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 
-    negate i@(S# (-2147483648#)) = 2147483648
+    negate (S# (-2147483648#)) = 2147483648
     negate (S# i) = S# (negateInt# i)
     negate (J# s d) = J# (negateInt# s) d
 
@@ -310,8 +310,8 @@ instance  Integral Integer where
        --        a `quot` b returns a small integer if a is small.
     quotRem (S# i) (S# j)         
       = case quotRem (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j) 
-    quotRem i1@(J# s d) i2@(S# i) = quotRem i1 (toBig i2)
-    quotRem i1@(S# i) i2@(J# s d) = quotRem (toBig i1) i2
+    quotRem i1@(J# _ _) i2@(S# _) = quotRem i1 (toBig i2)
+    quotRem i1@(S# _) i2@(J# _ _) = quotRem (toBig i1) i2
     quotRem (J# s1 d1) (J# s2 d2)
       = case (quotRemInteger# s1 d1 s2 d2) of
          (# s3, d3, s4, d4 #)
@@ -348,21 +348,60 @@ instance  Integral Integer where
                   if signum r == negate (signum d) then (q - 1, r+d) else qr }
                   -- Case-ified by WDP 94/10
 
+------------------------------------------------------------------------
 instance  Enum Integer  where
     succ x              = x + 1
     pred x              = x - 1
     toEnum n            =  toInteger n
     fromEnum n          =  toInt n
-    enumFrom n           =  n : enumFrom (n + 1)
-    enumFromThen e1 e2   =  en' e1 (e2 - e1)
-                           where en' a b = a : en' (a + b) b
-    enumFromTo n m
-      | n <= m           =  takeWhile (<= m) (enumFrom n)
-      | otherwise        =  []
-    enumFromThenTo n m p =  takeWhile pred   (enumFromThen n m)
-           where
-            pred | m >= n    = (<= p)
-                 | otherwise = (>= p)
+
+    {-# INLINE enumFrom #-}
+    {-# 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)
+
+enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
+enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d
+
+enumDeltaIntegerList :: Integer -> Integer -> [Integer]
+enumDeltaIntegerList x d = x : enumDeltaIntegerList (x+d) d
+
+enumDeltaToIntegerFB c n x delta lim
+  | delta >= 0 = up_fb c n x delta lim
+  | otherwise  = dn_fb c n x delta lim
+
+enumDeltaToIntegerList x delta lim
+  | delta >= 0 = up_list x delta lim
+  | otherwise  = dn_list x delta lim
+
+up_fb c n x delta lim = go (x::Integer)
+                     where
+                       go x | x > lim   = n
+                            | otherwise = x `c` go (x+delta)
+dn_fb c n x delta lim = go (x::Integer)
+                     where
+                       go x | x < lim   = n
+                            | otherwise = x `c` go (x+delta)
+
+up_list x delta lim = go (x::Integer)
+                   where
+                       go x | x > lim   = []
+                            | otherwise = x : go (x+delta)
+dn_list x delta lim = go (x::Integer)
+                   where
+                       go x | x < lim   = []
+                            | otherwise = x : go (x+delta)
+
+{-# RULES
+"enumDeltaInteger"     enumDeltaIntegerFB   (:)    = enumDeltaIntegerList
+"enumDeltaToInteger"   enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
+ #-}
+
+------------------------------------------------------------------------
 
 instance  Show Integer  where
     showsPrec   x = showSignedInteger x