[project @ 2000-06-04 18:27:45 by panne]

The GCD saga continues: Fixed gcdInt/gcdInteger to work correctly for
non-positive values, i.e. call mpn_gcd_1 only with positive inputs,
and issue an error if both operands are zero. This should fix the bug
reported by Marc.

3 files changed, 23 insertions, 19 deletions

diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index bf9182bc2e..44909c053a 100644
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.55 2000/05/28 20:22:08 panne Exp $
+ * $Id: PrimOps.h,v 1.56 2000/06/04 18:27:45 panne Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -368,15 +368,12 @@ typedef union {
   (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i);		\
 }
 
-/* I think mp_limb_t must be the same size as StgInt for this to work
- * properly --SDM
- */
+/* NOTE: gcdIntzh and gcdIntegerIntzh work only for positive inputs! */
+
+/* mp_limb_t must be able to hold an StgInt for this to work properly */
 #define gcdIntzh(r,a,b) \
-{ StgInt aa = a; \
-  r = (aa) ? (b) ? \
-        RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(&aa), 1, (mp_limb_t)(b)) \
-        : abs(aa) \
-      : abs(b); \
+{ mp_limb_t aa = (mp_limb_t)(a); \
+  RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(&aa), 1, (mp_limb_t)(b)); \
 }
 
 #define gcdIntegerIntzh(r,sa,a,b) \
diff --git a/ghc/lib/std/PrelBase.lhs b/ghc/lib/std/PrelBase.lhs
index 6ba7618c7e..e87bfb9253 100644
--- a/ghc/lib/std/PrelBase.lhs
+++ b/ghc/lib/std/PrelBase.lhs
@@ -573,11 +573,16 @@ plusInt	(I# x) (I# y) = I# (x +# y)
 minusInt(I# x) (I# y) = I# (x -# y)
 timesInt(I# x) (I# y) = I# (x *# y)
 quotInt	(I# x) (I# y) = I# (quotInt# x y)
-remInt	(I# x) (I# y) = I# (remInt# x y)
-gcdInt (I# a)  (I# b) = I# (gcdInt# a b)
+remInt	(I# x) (I# y) = I# (remInt#  x y)
+
+gcdInt  (I# 0#) (I# 0#) = error "PrelBase.gcdInt: gcd 0 0 is undefined"
+gcdInt  a       (I# 0#) = a
+gcdInt  (I# 0#) b       = b
+gcdInt  (I# a)  (I# b)  = I# (gcdInt# (absInt a) (absInt b))
+   where absInt x = if x <# 0# then negateInt# x else x
 
 negateInt :: Int -> Int
-negateInt (I# x)      = I# (negateInt# x)
+negateInt (I# x) = I# (negateInt# x)
 
 divInt, modInt :: Int -> Int -> Int
 x `divInt` y 
diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs
index 1ff4c98f28..83ed87b681 100644
--- a/ghc/lib/std/PrelNum.lhs
+++ b/ghc/lib/std/PrelNum.lhs
@@ -208,17 +208,19 @@ quotInteger (J# sa a) (J# sb b)
 
 \begin{code}
 gcdInteger :: Integer -> Integer -> Integer
+-- SUP: Do we really need the first two cases?
 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)
+gcdInteger (S# a) (S# b) = case gcdInt (I# a) (I# b) of { I# c -> S# c }
+gcdInteger ia@(S# 0#) ib@(J# 0# _) = error "PrelNum.gcdInteger: gcd 0 0 is undefined"
+gcdInteger ia@(S# a)  ib@(J# sb b)
   | a  ==# 0#  = abs ib
   | sb ==# 0#  = abs ia
-  | otherwise  = S# (gcdIntegerInt# sb b a)
-gcdInteger ia@(J# sa a) ib@(S# b)
-  | sa ==# 0#  = abs ib
-  | b ==# 0#   = abs ia
-  | otherwise  = S# (gcdIntegerInt# sa a b)
+  | otherwise  = S# (gcdIntegerInt# absSb b absA)
+       where absA  = if a  <# 0# then negateInt# a  else a
+             absSb = if sb <# 0# then negateInt# sb else sb
+gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia
+gcdInteger (J# 0# _) (J# 0# _) = error "PrelNum.gcdInteger: gcd 0 0 is undefined"
 gcdInteger (J# sa a) (J# sb b)
   = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g