[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.

diff --git a/ghc/lib/std/Ix.lhs b/ghc/lib/std/Ix.lhs
index e7ee204..060c923 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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