Commit 7f386840 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-03-28 08:52:28 by simonmar]

Replace freeze{Char,Int,Word,Float,Double}Array with freezeByteArray
(using sizeofByteArray and a foreign import of C's memcpy()).
parent 8fe056b2
......@@ -20,7 +20,8 @@ module CPUTime
import Prelude -- To generate the dependency
import PrelGHC ( indexIntArray# )
import PrelBase ( Int(..) )
import PrelByteArr ( ByteArray(..), newIntArray, unsafeFreezeByteArray )
import PrelByteArr ( ByteArray(..), newIntArray )
import PrelArrExtra ( unsafeFreezeByteArray )
import PrelNum ( fromInt )
import PrelIOBase ( IOError(..), IOErrorType( UnsupportedOperation ),
unsafePerformIO, stToIO )
......
......@@ -58,9 +58,8 @@ import Prelude -- Just to get it in the dependencies
import PrelGHC ( RealWorld, or#, and# )
import PrelByteArr ( ByteArray, MutableByteArray,
newWordArray, readWordArray, newCharArray,
unsafeFreezeByteArray
)
newWordArray, readWordArray, newCharArray )
import PrelArrExtra ( unsafeFreezeByteArray )
import PrelPack ( unpackNBytesST, packString, unpackCStringST )
import PrelIOBase ( stToIO,
constructErrorAndFail, constructErrorAndFailWithInfo,
......
......@@ -50,9 +50,6 @@ ifneq "$(way)" ""
SRC_HC_OPTS += -hisuf $(way_)hi
endif
# per-module flags
PrelArrExtra_HC_OPTS += -monly-2-regs
# Far too much heap is needed to compile PrelNumExtra with -O at the
# moment, but there you go..
PrelNumExtra_HC_OPTS += -H24m -K2m
......
......@@ -17,69 +17,40 @@ import Ix
import PrelArr
import PrelByteArr
import PrelST
import PrelIOBase
import PrelBase
import PrelGHC
\end{code}
%*********************************************************
%* *
\subsection{Moving between mutable and immutable}
%* *
%*********************************************************
freezeFloatArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeDoubleArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
\begin{code}
freezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeFloatArray (MutableByteArray l u arr#) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case freeze arr# n# s# of { (# s2#, frozen# #) ->
(# s2#, ByteArray l u frozen# #) }}
where
freeze :: MutableByteArray# s -- the thing
-> Int# -- size of thing to be frozen
-> State# s -- the Universe and everything
-> (# State# s, ByteArray# #)
{-# SPECIALISE freezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
freeze arr1# end# s#
= case (newFloatArray# end# s#) of { (# s2#, newarr1# #) ->
case copy 0# arr1# newarr1# s2# of { (# s3#, newarr2# #) ->
unsafeFreezeByteArray# newarr2# s3#
}}
where
copy :: Int#
-> MutableByteArray# s -> MutableByteArray# s
-> State# s
-> (# State# s, MutableByteArray# s #)
-- This coercion of memcpy to the ST monad is safe, because memcpy
-- only modifies its destination operand, which is already MutableByteArray.
freezeByteArray (MutableByteArray l u arr) = ST $ \ s ->
let n = sizeofMutableByteArray# arr in
case (newCharArray# n s) of { (# s, newarr #) ->
case ((unsafeCoerce# memcpy) newarr arr n s) of { (# s, () #) ->
case unsafeFreezeByteArray# newarr s of { (# s, frozen #) ->
(# s, ByteArray l u frozen #) }}}
copy cur# from# to# s1#
| cur# ==# end#
= (# s1#, to# #)
| otherwise
= case (readFloatArray# from# cur# s1#) of { (# s2#, ele #) ->
case (writeFloatArray# to# cur# ele s2#) of { s3# ->
copy (cur# +# 1#) from# to# s3#
}}
foreign import "memcpy" unsafe
memcpy :: MutableByteArray# RealWorld -> ByteArray# -> Int# -> IO ()
freezeDoubleArray (MutableByteArray l u arr#) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case freeze arr# n# s# of { (# s2#, frozen# #) ->
(# s2#, ByteArray l u frozen# #) }}
where
freeze :: MutableByteArray# s -- the thing
-> Int# -- size of thing to be frozen
-> State# s -- the Universe and everything
-> (# State# s, ByteArray# #)
unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freeze arr1# n# s1#
= case (newDoubleArray# n# s1#) of { (# s2#, newarr1# #) ->
case copy 0# n# arr1# newarr1# s2# of { (# s3#, newarr2# #) ->
unsafeFreezeByteArray# newarr2# s3#
}}
where
copy :: Int# -> Int#
-> MutableByteArray# s -> MutableByteArray# s
-> State# s
-> (# State# s, MutableByteArray# s #)
{-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
#-}
copy cur# end# from# to# st#
| cur# ==# end#
= (# st#, to# #)
| otherwise
= case (readDoubleArray# from# cur# st#) of { (# s2#, ele #) ->
case (writeDoubleArray# to# cur# ele s2#) of { s3# ->
copy (cur# +# 1#) end# from# to# s3#
}}
unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
(# s2#, ByteArray l u frozen# #) }
\end{code}
......@@ -235,147 +235,3 @@ writeDoubleArray (MutableByteArray l u barr#) n (D# ele) = ST $ \ s# ->
case writeDoubleArray# barr# n# ele s# of { s2# ->
(# s2#, () #) }}
\end{code}
%*********************************************************
%* *
\subsection{Moving between mutable and immutable}
%* *
%*********************************************************
\begin{code}
freezeCharArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeIntArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeWordArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
freezeAddrArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
{-# SPECIALISE freezeCharArray :: MutableByteArray s Int -> ST s (ByteArray Int) #-}
freezeCharArray (MutableByteArray l u arr#) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case freeze arr# n# s# of { (# s2#, frozen# #) ->
(# s2#, ByteArray l u frozen# #) }}
where
freeze :: MutableByteArray# s -- the thing
-> Int# -- size of thing to be frozen
-> State# s -- the Universe and everything
-> (# State# s, ByteArray# #)
freeze arr1# n# s1#
= case (newCharArray# n# s1#) of { (# s2#, newarr1# #) ->
case copy 0# n# arr1# newarr1# s2# of { (# s3#, newarr2# #) ->
unsafeFreezeByteArray# newarr2# s3#
}}
where
copy :: Int# -> Int#
-> MutableByteArray# s -> MutableByteArray# s
-> State# s
-> (# State# s, MutableByteArray# s #)
copy cur# end# from# to# st#
| cur# ==# end#
= (# st#, to# #)
| otherwise
= case (readCharArray# from# cur# st#) of { (# s2#, ele #) ->
case (writeCharArray# to# cur# ele s2#) of { s3# ->
copy (cur# +# 1#) end# from# to# s3#
}}
freezeIntArray (MutableByteArray l u arr#) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case freeze arr# n# s# of { (# s2#, frozen# #) ->
(# s2#, ByteArray l u frozen# #) }}
where
freeze :: MutableByteArray# s -- the thing
-> Int# -- size of thing to be frozen
-> State# s -- the Universe and everything
-> (# State# s, ByteArray# #)
freeze m_arr# n# s#
= case (newIntArray# n# s#) of { (# s2#, newarr1# #) ->
case copy 0# n# m_arr# newarr1# s2# of { (# s3#, newarr2# #) ->
unsafeFreezeByteArray# newarr2# s3#
}}
where
copy :: Int# -> Int#
-> MutableByteArray# s -> MutableByteArray# s
-> State# s
-> (# State# s, MutableByteArray# s #)
copy cur# end# from# to# s1#
| cur# ==# end#
= (# s1#, to# #)
| otherwise
= case (readIntArray# from# cur# s1#) of { (# s2#, ele #) ->
case (writeIntArray# to# cur# ele s2#) of { s3# ->
copy (cur# +# 1#) end# from# to# s3#
}}
freezeWordArray (MutableByteArray l u arr#) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case freeze arr# n# s# of { (# s2#, frozen# #) ->
(# s2#, ByteArray l u frozen# #) }}
where
freeze :: MutableByteArray# s -- the thing
-> Int# -- size of thing to be frozen
-> State# s -- the Universe and everything
-> (# State# s, ByteArray# #)
freeze m_arr# n# s1#
= case (newWordArray# n# s1#) of { (# s2#, newarr1# #) ->
case copy 0# n# m_arr# newarr1# s2# of { (# s3#, newarr2# #) ->
unsafeFreezeByteArray# newarr2# s3#
}}
where
copy :: Int# -> Int#
-> MutableByteArray# s -> MutableByteArray# s
-> State# s
-> (# State# s, MutableByteArray# s #)
copy cur# end# from# to# st#
| cur# ==# end# = (# st#, to# #)
| otherwise =
case (readWordArray# from# cur# st#) of { (# s2#, ele #) ->
case (writeWordArray# to# cur# ele s2#) of { s3# ->
copy (cur# +# 1#) end# from# to# s3#
}}
freezeAddrArray (MutableByteArray l u arr#) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
case freeze arr# n# s# of { (# s2#, frozen# #) ->
(# s2#, ByteArray l u frozen# #) }}
where
freeze :: MutableByteArray# s -- the thing
-> Int# -- size of thing to be frozen
-> State# s -- the Universe and everything
-> (# State# s, ByteArray# #)
freeze m_arr# n# s1#
= case (newAddrArray# n# s1#) of { (# s2#, newarr1# #) ->
case copy 0# n# m_arr# newarr1# s2# of { (# s3#, newarr2# #) ->
unsafeFreezeByteArray# newarr2# s3#
}}
where
copy :: Int# -> Int#
-> MutableByteArray# s -> MutableByteArray# s
-> State# s
-> (# State# s, MutableByteArray# s #)
copy cur# end# from# to# st#
| cur# ==# end#
= (# st#, to# #)
| otherwise
= case (readAddrArray# from# cur# st#) of { (# st1#, ele #) ->
case (writeAddrArray# to# cur# ele st1#) of { st2# ->
copy (cur# +# 1#) end# from# to# st2#
}}
unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
{-# SPECIALIZE unsafeFreezeByteArray :: MutableByteArray s Int -> ST s (ByteArray Int)
#-}
unsafeFreezeByteArray (MutableByteArray l u arr#) = ST $ \ s# ->
case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
(# s2#, ByteArray l u frozen# #) }
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment