From 4481cefcf6a301196288f97731002d69cb0996fd Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Thu, 11 Nov 1999 15:18:00 +0000
Subject: [PATCH] [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            |    1 +
 ghc/lib/std/PrelArr.lhs       |    2 +-
 ghc/lib/std/PrelException.lhs |   14 +++++++++++++-
 ghc/lib/std/PrelForeign.lhs   |    2 +-
 ghc/lib/std/PrelGHC.hi-boot   |    1 +
 ghc/lib/std/PrelNum.lhs       |   11 ++++++++---
 6 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/ghc/lib/std/Ix.lhs b/ghc/lib/std/Ix.lhs
index e7ee204..060c923 100644
--- a/ghc/lib/std/Ix.lhs
+++ b/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}
 
diff --git a/ghc/lib/std/PrelArr.lhs b/ghc/lib/std/PrelArr.lhs
index dea699a..e36c52c 100644
--- a/ghc/lib/std/PrelArr.lhs
+++ b/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
diff --git a/ghc/lib/std/PrelException.lhs b/ghc/lib/std/PrelException.lhs
index 56d116e..d434c5a 100644
--- a/ghc/lib/std/PrelException.lhs
+++ b/ghc/lib/std/PrelException.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $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
diff --git a/ghc/lib/std/PrelForeign.lhs b/ghc/lib/std/PrelForeign.lhs
index 9e326cb..ed575ef 100644
--- a/ghc/lib/std/PrelForeign.lhs
+++ b/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
diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot
index b2810b4..33c3a90 100644
--- a/ghc/lib/std/PrelGHC.hi-boot
+++ b/ghc/lib/std/PrelGHC.hi-boot
@@ -190,6 +190,7 @@ __export PrelGHC
   timesIntegerzh
   gcdIntegerzh
   quotRemIntegerzh
+  divModIntegerzh
   integer2Intzh
   integer2Wordzh
   int2Integerzh
diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs
index a946e1b..7c70f0f 100644
--- a/ghc/lib/std/PrelNum.lhs
+++ b/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
-- 
1.7.10.4