From: sof <unknown>
Date: Sun, 18 May 1997 04:24:13 +0000 (+0000)
Subject: [project @ 1997-05-18 04:24:13 by sof]
X-Git-Tag: Approximately_1000_patches_recorded~668
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=05f1dd604e13cbd01b1135d080186330667fe757;p=ghc-hetmet.git

[project @ 1997-05-18 04:24:13 by sof]
Array ops now use Ix.rangeSize
---

diff --git a/ghc/lib/ghc/ArrBase.lhs b/ghc/lib/ghc/ArrBase.lhs
index 0440cf0..a80fd4d 100644
--- a/ghc/lib/ghc/ArrBase.lhs
+++ b/ghc/lib/ghc/ArrBase.lhs
@@ -13,9 +13,10 @@ module ArrBase where
 
 import {-# SOURCE #-}	IOBase	( error )
 import Ix
-import PrelList
+import PrelList (foldl)
 import STBase
 import PrelBase
+import Foreign
 import GHC
 
 infixl 9  !, //
@@ -55,6 +56,12 @@ data Ix ix => ByteArray ix      	= ByteArray	   (ix,ix) ByteArray#
 data Ix ix => MutableArray     s ix elt = MutableArray     (ix,ix) (MutableArray# s elt)
 data Ix ix => MutableByteArray s ix     = MutableByteArray (ix,ix) (MutableByteArray# s)
 
+instance CCallable (MutableByteArray s ix)
+instance CCallable (MutableByteArray# s)
+
+instance CCallable (ByteArray ix)
+instance CCallable ByteArray#
+
 -- A one-element mutable array:
 type MutableVar s a = MutableArray s Int a
 \end{code}
@@ -182,54 +189,35 @@ newCharArray, newIntArray, newAddrArray, newFloatArray, newDoubleArray
 {-# SPECIALIZE newFloatArray  :: IPr -> ST s (MutableByteArray s Int) #-}
 {-# SPECIALIZE newDoubleArray :: IPr -> ST s (MutableByteArray s Int) #-}
 
-newArray ixs@(ix_start, ix_end) init = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else (index ixs ix_end) + 1) of { I# x -> x }
-	-- size is one bigger than index of last elem
-    in
+newArray ixs init = ST $ \ (S# s#) ->
+    case rangeSize ixs              of { I# n# ->
     case (newArray# n# init s#)     of { StateAndMutableArray# s2# arr# ->
-    (MutableArray ixs arr#, S# s2#)}
+    (MutableArray ixs arr#, S# s2#)}}
 
-newCharArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+newCharArray ixs = ST $ \ (S# s#) ->
+    case rangeSize ixs              of { I# n# ->
     case (newCharArray# n# s#)	  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
+    (MutableByteArray ixs barr#, S# s2#)}}
 
-newIntArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+newIntArray ixs = ST $ \ (S# s#) ->
+    case rangeSize ixs              of { I# n# ->
     case (newIntArray# n# s#)	  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
+    (MutableByteArray ixs barr#, S# s2#)}}
 
-newAddrArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+newAddrArray ixs = ST $ \ (S# s#) ->
+    case rangeSize ixs              of { I# n# ->
     case (newAddrArray# n# s#)	  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
+    (MutableByteArray ixs barr#, S# s2#)}}
 
-newFloatArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+newFloatArray ixs = ST $ \ (S# s#) ->
+    case rangeSize ixs              of { I# n# ->
     case (newFloatArray# n# s#)	  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
+    (MutableByteArray ixs barr#, S# s2#)}}
 
-newDoubleArray ixs@(ix_start, ix_end) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+newDoubleArray ixs = ST $ \ (S# s#) ->
+    case rangeSize ixs              of { I# n# ->
     case (newDoubleArray# n# s#)  of { StateAndMutableByteArray# s2# barr# ->
-    (MutableByteArray ixs barr#, S# s2#)}
+    (MutableByteArray ixs barr#, S# s2#)}}
 
 boundsOfArray     :: Ix ix => MutableArray s ix elt -> (ix, ix)  
 boundsOfByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
@@ -424,13 +412,10 @@ freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
   #-}
 {-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
 
-freezeArray (MutableArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else (index ixs ix_end) + 1) of { I# x -> x }
-    in
+freezeArray (MutableArray ixs arr#) = ST $ \ (S# s#) ->
+    case rangeSize ixs     of { I# n# ->
     case freeze arr# n# s# of { StateAndArray# s2# frozen# ->
-    (Array ixs frozen#, S# s2#)}
+    (Array ixs frozen#, S# s2#)}}
   where
     freeze  :: MutableArray# s ele	-- the thing
 	    -> Int#			-- size of thing to be frozen
@@ -459,13 +444,10 @@ freezeArray (MutableArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
 	      copy (cur# +# 1#) end# from# to# s2#
 	      }}
 
-freezeCharArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+freezeCharArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
+    case rangeSize ixs     of { I# n# ->
     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
+    (ByteArray ixs frozen#, S# s2#) }}
   where
     freeze  :: MutableByteArray# s	-- the thing
 	    -> Int#			-- size of thing to be frozen
@@ -492,13 +474,10 @@ freezeCharArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#)
 	      copy (cur# +# 1#) end# from# to# s2#
 	      }}
 
-freezeIntArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+freezeIntArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
+    case rangeSize ixs     of { I# n# ->
     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
+    (ByteArray ixs frozen#, S# s2#) }}
   where
     freeze  :: MutableByteArray# s	-- the thing
 	    -> Int#			-- size of thing to be frozen
@@ -525,13 +504,10 @@ freezeIntArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) -
 	      copy (cur# +# 1#) end# from# to# s2#
 	      }}
 
-freezeAddrArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+freezeAddrArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
+    case rangeSize ixs     of { I# n# ->
     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
+    (ByteArray ixs frozen#, S# s2#) }}
   where
     freeze  :: MutableByteArray# s	-- the thing
 	    -> Int#			-- size of thing to be frozen
@@ -558,13 +534,10 @@ freezeAddrArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#)
 	      copy (cur# +# 1#) end# from# to# s2#
 	      }}
 
-freezeFloatArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+freezeFloatArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
+    case rangeSize ixs     of { I# n# ->
     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
+    (ByteArray ixs frozen#, S# s2#) }}
   where
     freeze  :: MutableByteArray# s	-- the thing
 	    -> Int#			-- size of thing to be frozen
@@ -591,13 +564,10 @@ freezeFloatArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#)
 	      copy (cur# +# 1#) end# from# to# s2#
 	      }}
 
-freezeDoubleArray (MutableByteArray ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else ((index ixs ix_end) + 1)) of { I# x -> x }
-    in
+freezeDoubleArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
+    case rangeSize ixs     of { I# n# ->
     case freeze arr# n# s# of { StateAndByteArray# s2# frozen# ->
-    (ByteArray ixs frozen#, S# s2#) }
+    (ByteArray ixs frozen#, S# s2#) }}
   where
     freeze  :: MutableByteArray# s	-- the thing
 	    -> Int#			-- size of thing to be frozen
@@ -647,13 +617,10 @@ unsafeFreezeByteArray (MutableByteArray ixs arr#) = ST $ \ (S# s#) ->
   #-}
 
 thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
-thawArray (Array ixs@(ix_start, ix_end) arr#) = ST $ \ (S# s#) ->
-    let n# = case (if null (range ixs)
-		  then 0
-		  else (index ixs ix_end) + 1) of { I# x -> x }
-    in
+thawArray (Array ixs arr#) = ST $ \ (S# s#) ->
+    case rangeSize ixs     of { I# n# ->
     case thaw arr# n# s# of { StateAndMutableArray# s2# thawed# ->
-    (MutableArray ixs thawed#, S# s2#)}
+    (MutableArray ixs thawed#, S# s2#)}}
   where
     thaw  :: Array# ele			-- the thing
 	    -> Int#			-- size of thing to be thawed