[project @ 1999-11-11 15:17:59 by simonmar]

Integer divMod now uses the native GMP method.  The PrimOp was already
there, it just wasn't being used.

ghc/lib/std/Ix.lhs

@@ -54,6 +54,7 @@ class  (Ord a) => Ix a  where
 	-- Must specify one of index, unsafeIndex
     index b i | inRange b i = unsafeIndex b i
 	      | otherwise   = error "Error in array index"
+				-- ToDo: raise (ArrayException IndexOutOfRange)
     unsafeIndex b i = index b i
 \end{code}
 

ghc/lib/std/PrelArr.lhs

@@ -143,7 +143,7 @@ done (l,u) marr = \s1 ->
 
 arrEleBottom :: a
 arrEleBottom = error "(Array.!): undefined array element"
-
+-- ToDo: arrEleBottom = throw (ArrayException (UndefinedElement "Array.!"))
 
 -----------------------------------------------------------------------
 -- These also go better with magic: (//), accum, accumArray

ghc/lib/std/PrelException.lhs

 % -----------------------------------------------------------------------------
-% $Id: PrelException.lhs,v 1.8 1999/07/14 08:33:38 simonmar Exp $
+% $Id: PrelException.lhs,v 1.9 1999/11/11 15:18:00 simonmar Exp $
 %
 % (c) The GRAP/AQUA Project, Glasgow University, 1998
 %
@@ -38,6 +38,7 @@ data Exception
   | AssertionFailed	String		-- Assertions
   | DynException	Dynamic		-- Dynamic exceptions
   | AsyncException	AsyncException	-- Externally generated errors
+  | ArrayException	ArrayException  -- Array-related exceptions
   | NonTermination
 
 data ArithException
@@ -54,6 +55,11 @@ data AsyncException
   | ThreadKilled
   deriving (Eq, Ord)
 
+data ArrayException
+  = IndexOutOfBounds String
+  | UndefinedElement String
+  deriving (Eq, Ord)
+
 stackOverflow, heapOverflow :: Exception -- for the RTS
 stackOverflow = AsyncException StackOverflow
 heapOverflow  = AsyncException HeapOverflow
@@ -70,6 +76,12 @@ instance Show AsyncException where
   showsPrec _ HeapOverflow    = showString "heap overflow"
   showsPrec _ ThreadKilled    = showString "thread killed"
 
+instance Show ArrayException where
+  showsPrec _ (IndexOutOfBounds s) = showString "array index out of bounds: "
+				   . showString s
+  showsPrec _ (UndefinedElement s) = showString "undefined array element: "
+				   . showString s
+
 instance Show Exception where
   showsPrec _ (IOException err)	         = shows err
   showsPrec _ (ArithException err)       = shows err

ghc/lib/std/PrelForeign.lhs

@@ -51,7 +51,7 @@ writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
 eqForeignObj mp1 mp2
   = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
 
-foreign import "eqForeignObj" primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
+foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
 
 instance Eq ForeignObj where 
     p == q = eqForeignObj p q

ghc/lib/std/PrelGHC.hi-boot

@@ -190,6 +190,7 @@ __export PrelGHC
   timesIntegerzh
   gcdIntegerzh
   quotRemIntegerzh
+  divModIntegerzh
   integer2Intzh
   integer2Wordzh
   int2Integerzh

ghc/lib/std/PrelNum.lhs

@@ -344,9 +344,14 @@ instance  Integral Integer where
     n `div` d	=  q  where (q,_) = divMod n d
     n `mod` d	=  r  where (_,r) = divMod n d
 
-    divMod n d 	=  case (quotRem n d) of { qr@(q,r) ->
-		   if signum r == negate (signum d) then (q - 1, r+d) else qr }
-		   -- Case-ified by WDP 94/10
+    divMod (S# i) (S# j)         
+      = case divMod (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j) 
+    divMod i1@(J# _ _) i2@(S# _) = divMod i1 (toBig i2)
+    divMod i1@(S# _) i2@(J# _ _) = divMod (toBig i1) i2
+    divMod (J# s1 d1) (J# s2 d2)
+      = case (divModInteger# s1 d1 s2 d2) of
+	  (# s3, d3, s4, d4 #)
+	    -> (J# s3 d3, J# s4 d4)
 
 ------------------------------------------------------------------------
 instance  Enum Integer  where