GHC.PArr: add bounds checking
[packages/random.git] / GHC / PArr.hs
index d385d84..fe58b94 100644 (file)
@@ -1,11 +1,17 @@
---  $Id: PArr.hs,v 1.1 2002/02/11 17:11:12 simonmar Exp $
---
---  Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
+{-# OPTIONS_GHC -fparr -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.PArr
+-- Copyright   :  (c) 2001-2002 Manuel M T Chakravarty & Gabriele Keller
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  Manuel M. T. Chakravarty <chak@cse.unsw.edu.au>
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
 --
 --  Basic implementation of Parallel Arrays.
 --
---- DESCRIPTION ---------------------------------------------------------------
---
 --  This module has two functions: (1) It defines the interface to the
 --  parallel array extension of the Prelude and (2) it provides a vanilla
 --  implementation of parallel arrays that does not require to flatten the
 --  * We might want to add bounds checks that can be deactivated.
 --
 
-{-# OPTIONS -fno-implicit-prelude #-}
-
 module GHC.PArr (
-  [::],                        -- abstract
+  -- [::],             -- Built-in syntax
 
   mapP,                        -- :: (a -> b) -> [:a:] -> [:b:]
   (+:+),               -- :: [:a:] -> [:a:] -> [:a:]
@@ -136,11 +140,11 @@ module GHC.PArr (
   indexOfP             -- :: (a -> Bool) -> [:a:] -> [:Int:]
 ) where
 
-import PrelBase
-import PrelST   (ST(..), STRep, runST)
-import PrelList
-import PrelShow
-import PrelRead
+import Prelude
+
+import GHC.ST   ( ST(..), STRep, runST )
+import GHC.Exts        ( Int#, Array#, Int(I#), MutableArray#, newArray#,
+                 unsafeFreezeArray#, indexArray#, writeArray#, (<#), (>=#) )
 
 infixl 9  !:
 infixr 5  +:+
@@ -212,7 +216,7 @@ scanlP     :: (a -> b -> a) -> a -> [:b:] -> [:a:]
 scanlP f z  = fst . loop (scanEFL (flip f)) z
 
 scanl1P        :: (a -> a -> a) -> [:a:] -> [:a:]
-acanl1P f [::]  = error "Prelude.scanl1P: empty array"
+scanl1P f [::]  = error "Prelude.scanl1P: empty array"
 scanl1P f a     = fst $ loopFromTo 1 (lengthP a - 1) (scanEFL f) (a!:0) a
 
 foldrP :: (a -> b -> b) -> b -> [:a:] -> b
@@ -241,7 +245,7 @@ takeP   :: Int -> [:a:] -> [:a:]
 takeP n  = sliceP 0 (n - 1)
 
 dropP     :: Int -> [:a:] -> [:a:]
-dropP n a  = sliceP (n - 1) (lengthP a - 1) a
+dropP n a  = sliceP n (lengthP a - 1) a
 
 splitAtP      :: Int -> [:a:] -> ([:a:],[:a:])
 splitAtP n xs  = (takeP n xs, dropP n xs)
@@ -293,7 +297,7 @@ sumP :: (Num a) => [:a:] -> a
 sumP  = foldP (+) 0
 
 productP :: (Num a) => [:a:] -> a
-productP  = foldP (*) 0
+productP  = foldP (*) 1
 
 maximumP      :: (Ord a) => [:a:] -> a
 maximumP [::]  = error "Prelude.maximumP: empty parallel array"
@@ -398,7 +402,7 @@ instance Read a => Read [:a:]  where
 -- Ideally, we would like `enumFromToP' and `enumFromThenToP' to be members of
 -- `Enum'.  On the other hand, we really do not want to change `Enum'.  Thus,
 -- for the moment, we hope that the compiler is sufficiently clever to
--- properly fuse the following definition.
+-- properly fuse the following definitions.
 
 enumFromToP    :: Enum a => a -> a -> [:a:]
 enumFromToP x y  = mapP toEnum (eftInt (fromEnum x) (fromEnum y))
@@ -410,7 +414,7 @@ enumFromThenToP x y z  =
   mapP toEnum (efttInt (fromEnum x) (fromEnum y) (fromEnum z))
   where
     efttInt x y z = scanlP (+) x $ 
-                     replicateP ((z - x + 1) `div` delta - 1) delta
+                     replicateP (abs (z - x) `div` abs delta + 1) delta
       where
        delta = y - x
 
@@ -566,7 +570,7 @@ loopFromTo from to mf start arr = runST (do
             -- unlike standard Haskell arrays, this value represents an
             -- internal error
 
--- actually loop body of `loop'
+-- actual loop body of `loop'
 --
 -- * for this to be really efficient, it has to be translated with the
 --   constructor specialisation phase "SpecConstr" switched on; as of GHC 5.03
@@ -633,12 +637,21 @@ scanEFL f  = \e a -> (Just a, f e a)
 --
 indexPArr                       :: [:e:] -> Int -> e
 {-# INLINE indexPArr #-}
-indexPArr (PArr _ arr#) (I# i#)  = 
-  case indexArray# arr# i# of (# e #) -> e
+indexPArr (PArr n# arr#) (I# i#) 
+  | i# >=# 0# && i# <# n# =
+    case indexArray# arr# i# of (# e #) -> e
+  | otherwise = error $ "indexPArr: out of bounds parallel array index; " ++
+                       "idx = " ++ show (I# i#) ++ ", arr len = "
+                       ++ show (I# n#)
 
 -- encapsulate writing into a mutable array into the `ST' monad
 --
 writeMPArr                           :: MPArr s e -> Int -> e -> ST s ()
 {-# INLINE writeMPArr #-}
-writeMPArr (MPArr _ marr#) (I# i#) e  = ST $ \s# ->
-  case writeArray# marr# i# e s# of s'# -> (# s'#, () #)
+writeMPArr (MPArr n# marr#) (I# i#) e 
+  | i# >=# 0# && i# <# n# =
+    ST $ \s# ->
+    case writeArray# marr# i# e s# of s'# -> (# s'#, () #)
+  | otherwise = error $ "writeMPArr: out of bounds parallel array index; " ++
+                       "idx = " ++ show (I# i#) ++ ", arr len = "
+                       ++ show (I# n#)