primCode [lhs] UnsafeFreezeByteArrayOp [rhs]
= simpleCoercion PtrRep lhs rhs
+primCode [lhs] UnsafeThawByteArrayOp [rhs]
+ = simpleCoercion PtrRep lhs rhs
\end{code}
Returning the size of (mutable) byte arrays is just
| IndexOffForeignObjOp PrimRep
| UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
+ | UnsafeThawArrayOp | UnsafeThawByteArrayOp
| SizeofByteArrayOp | SizeofMutableByteArrayOp
-- Mutable variables
tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(196)
tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(197)
-tagOf_PrimOp SizeofByteArrayOp = ILIT(198)
-tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(199)
-
-tagOf_PrimOp NewMVarOp = ILIT(200)
-tagOf_PrimOp TakeMVarOp = ILIT(201)
-tagOf_PrimOp PutMVarOp = ILIT(202)
-tagOf_PrimOp SameMVarOp = ILIT(203)
-tagOf_PrimOp IsEmptyMVarOp = ILIT(204)
-tagOf_PrimOp MakeForeignObjOp = ILIT(205)
-tagOf_PrimOp WriteForeignObjOp = ILIT(206)
-tagOf_PrimOp MkWeakOp = ILIT(207)
-tagOf_PrimOp DeRefWeakOp = ILIT(208)
-tagOf_PrimOp FinalizeWeakOp = ILIT(209)
-tagOf_PrimOp MakeStableNameOp = ILIT(210)
-tagOf_PrimOp EqStableNameOp = ILIT(211)
-tagOf_PrimOp StableNameToIntOp = ILIT(212)
-tagOf_PrimOp MakeStablePtrOp = ILIT(213)
-tagOf_PrimOp DeRefStablePtrOp = ILIT(214)
-tagOf_PrimOp EqStablePtrOp = ILIT(215)
-tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(216)
-tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(217)
-tagOf_PrimOp SeqOp = ILIT(218)
-tagOf_PrimOp ParOp = ILIT(219)
-tagOf_PrimOp ForkOp = ILIT(220)
-tagOf_PrimOp KillThreadOp = ILIT(221)
-tagOf_PrimOp DelayOp = ILIT(222)
-tagOf_PrimOp WaitReadOp = ILIT(223)
-tagOf_PrimOp WaitWriteOp = ILIT(224)
-tagOf_PrimOp ParGlobalOp = ILIT(225)
-tagOf_PrimOp ParLocalOp = ILIT(226)
-tagOf_PrimOp ParAtOp = ILIT(227)
-tagOf_PrimOp ParAtAbsOp = ILIT(228)
-tagOf_PrimOp ParAtRelOp = ILIT(229)
-tagOf_PrimOp ParAtForNowOp = ILIT(230)
-tagOf_PrimOp CopyableOp = ILIT(231)
-tagOf_PrimOp NoFollowOp = ILIT(232)
-tagOf_PrimOp NewMutVarOp = ILIT(233)
-tagOf_PrimOp ReadMutVarOp = ILIT(234)
-tagOf_PrimOp WriteMutVarOp = ILIT(235)
-tagOf_PrimOp SameMutVarOp = ILIT(236)
-tagOf_PrimOp CatchOp = ILIT(237)
-tagOf_PrimOp RaiseOp = ILIT(238)
+tagOf_PrimOp UnsafeThawArrayOp = ILIT(198)
+tagOf_PrimOp UnsafeThawByteArrayOp = ILIT(199)
+tagOf_PrimOp SizeofByteArrayOp = ILIT(200)
+tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(201)
+
+tagOf_PrimOp NewMVarOp = ILIT(202)
+tagOf_PrimOp TakeMVarOp = ILIT(203)
+tagOf_PrimOp PutMVarOp = ILIT(204)
+tagOf_PrimOp SameMVarOp = ILIT(205)
+tagOf_PrimOp IsEmptyMVarOp = ILIT(206)
+tagOf_PrimOp MakeForeignObjOp = ILIT(207)
+tagOf_PrimOp WriteForeignObjOp = ILIT(208)
+tagOf_PrimOp MkWeakOp = ILIT(209)
+tagOf_PrimOp DeRefWeakOp = ILIT(210)
+tagOf_PrimOp FinalizeWeakOp = ILIT(211)
+tagOf_PrimOp MakeStableNameOp = ILIT(212)
+tagOf_PrimOp EqStableNameOp = ILIT(213)
+tagOf_PrimOp StableNameToIntOp = ILIT(214)
+tagOf_PrimOp MakeStablePtrOp = ILIT(215)
+tagOf_PrimOp DeRefStablePtrOp = ILIT(216)
+tagOf_PrimOp EqStablePtrOp = ILIT(217)
+tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(218)
+tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(219)
+tagOf_PrimOp SeqOp = ILIT(220)
+tagOf_PrimOp ParOp = ILIT(221)
+tagOf_PrimOp ForkOp = ILIT(222)
+tagOf_PrimOp KillThreadOp = ILIT(223)
+tagOf_PrimOp DelayOp = ILIT(224)
+tagOf_PrimOp WaitReadOp = ILIT(225)
+tagOf_PrimOp WaitWriteOp = ILIT(226)
+tagOf_PrimOp ParGlobalOp = ILIT(227)
+tagOf_PrimOp ParLocalOp = ILIT(228)
+tagOf_PrimOp ParAtOp = ILIT(229)
+tagOf_PrimOp ParAtAbsOp = ILIT(230)
+tagOf_PrimOp ParAtRelOp = ILIT(231)
+tagOf_PrimOp ParAtForNowOp = ILIT(232)
+tagOf_PrimOp CopyableOp = ILIT(233)
+tagOf_PrimOp NoFollowOp = ILIT(234)
+tagOf_PrimOp NewMutVarOp = ILIT(235)
+tagOf_PrimOp ReadMutVarOp = ILIT(236)
+tagOf_PrimOp WriteMutVarOp = ILIT(237)
+tagOf_PrimOp SameMutVarOp = ILIT(238)
+tagOf_PrimOp CatchOp = ILIT(239)
+tagOf_PrimOp RaiseOp = ILIT(240)
tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
--panic# "tagOf_PrimOp: pattern-match"
WriteOffAddrOp Word64Rep,
UnsafeFreezeArrayOp,
UnsafeFreezeByteArrayOp,
+ UnsafeThawArrayOp,
+ UnsafeThawByteArrayOp,
SizeofByteArrayOp,
SizeofMutableByteArrayOp,
NewMutVarOp,
[mkMutableByteArrayPrimTy s, state]
(unboxedPair [state, byteArrayPrimTy])
+primOpInfo UnsafeThawArrayOp
+ = let {
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ state = mkStatePrimTy s
+ } in
+ mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]
+ [mkArrayPrimTy elt, state]
+ (unboxedPair [state, mkMutableArrayPrimTy s elt])
+
+primOpInfo UnsafeThawByteArrayOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar;
+ state = mkStatePrimTy s
+ } in
+ mkGenPrimOp SLIT("unsafeThawByteArray#") [s_tv]
+ [byteArrayPrimTy, state]
+ (unboxedPair [state, mkMutableByteArrayPrimTy s])
+
---------------------------------------------------------------------------
primOpInfo SizeofByteArrayOp
= mkGenPrimOp
ForkOp -> True
KillThreadOp -> True
CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_
+ -- the next one doesn't perform any heap checks,
+ -- but it is of such an esoteric nature that
+ -- it is done out-of-line rather than require
+ -- the NCG to implement it.
+ UnsafeThawArrayOp -> True
_ -> False
\end{code}
freezeArray :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
thawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
-unsafeFreezeArray :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
+unsafeFreezeArray :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
+unsafeThawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
</code></tscreen>
<nidx>newArray</nidx>
<nidx>boundsOfArray</nidx>
<nidx>freezeArray</nidx>
<nidx>thawArray</nidx>
<nidx>unsafeFreezeArray</nidx>
+<nidx>unsafeThawArray</nidx>
<bf/Remarks:/
<item>
The operation <tt/thawArray/ goes the other way, converting
an immutable <tt/Array/ into a mutable one. This is done by
-copying. The operation <tt/unsafeThawArray/ is not provided
-(allthough it conceivably could be.)
+copying. The operation <tt/unsafeThawArray/ is also provided,
+which places the same kind of proof obligation on the programmer
+as <tt/unsafeFreezeArray/ does.
</itemize>
<sect3> <idx/Mutable byte arrays/
sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
+thawByteArray :: Ix ix => ByteArray ixt -> ST s (MutableByteArray s ix)
+unsafeThawByteArray :: Ix ix => ByteArray ixt -> ST s (MutableByteArray s ix)
+
</code></tscreen>
<nidx>newCharArray</nidx>
<nidx>newAddrArray</nidx>
<nidx>freezeFloatArray</nidx>
<nidx>freezeDoubleArray</nidx>
<nidx>unsafeFreezeByteArray</nidx>
+<nidx>unsafeThawByteArray</nidx>
+<nidx>thawByteArray</nidx>
<bf/Remarks:/
<itemize>
class of actions. There's also the non-copying
<tt/unsafeFreezeByteArray/.
<p>
-Thawing of byte arrays is currently not supported.
+<item>
+Operations for going the other way, where an immutable byte
+array is 'thawed' are also provided. <tt/thawByteArray/ does
+this by copying, whereas <tt/unsafeThawByteArray/ does not
<item>
The operation <tt/sizeofMutableByteArray/ returns the size of
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.22 1999/03/02 19:44:12 sof Exp $
+ * $Id: PrimOps.h,v 1.23 1999/03/05 10:21:29 sof Exp $
*
* (c) The GHC Team, 1998-1999
*
}
#define unsafeFreezzeByteArrayzh(r,a) r=(a)
+#define unsafeThawByteArrayzh(r,a) r=(a)
+
+EF_(unsafeThawArrayzh_fast);
#define sizzeofByteArrayzh(r,a) \
r = (((StgArrWords *)(a))->words * sizeof(W_))
, writeIOArray
, freezeIOArray
, thawIOArray
+#ifndef __HUGS__
+ , unsafeFreezeIOArray
+ , unsafeThawIOArray
+#endif
#ifdef __HUGS__
#else
writeIOArray :: Ix ix => IOArray ix elt -> ix -> elt -> IO ()
freezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt)
thawIOArray :: Ix ix => Array ix elt -> IO (IOArray ix elt)
+#ifndef __HUGS__
+unsafeFreezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt)
+unsafeThawIOArray :: Ix ix => Array ix elt -> IO (IOArray ix elt)
+#endif
#ifdef __HUGS__
type IOArray ix elt = STArray RealWorld ix elt
thawIOArray arr = do
marr <- stToIO (thawArray arr)
return (IOArray marr)
+
+unsafeFreezeIOArray (IOArray arr) = stToIO (unsafeFreezeArray arr)
+unsafeThawIOArray arr = do
+ marr <- stToIO (unsafeThawArray arr)
+ return (IOArray marr)
#endif
\end{code}
runST,
unsafeInterleaveST,
- -- ST is one, so you'll likely need some Monad bits
- module Monad,
-
ST.STRef,
newSTRef, readSTRef, writeSTRef,
STArray,
newSTArray, readSTArray, writeSTArray, boundsSTArray,
thawSTArray, freezeSTArray, unsafeFreezeSTArray,
- Ix,
+ unsafeThawSTArray,
ST.unsafeIOToST, ST.stToIO,
freezeSTArray (STArray arr) = strictToLazyST (freezeArray arr)
unsafeFreezeSTArray (STArray arr) = strictToLazyST (unsafeFreezeArray arr)
+unsafeThawSTArray arr =
+ strictToLazyST (unsafeThawArray arr) >>= \ marr ->
+ return (STArray marr)
strictToLazyST :: PrelST.ST s a -> ST s a
strictToLazyST m = ST $ \s ->
unsafeFreezeArray, -- :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
unsafeFreezeByteArray, -- :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
- thawArray, -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
+
+ thawArray, -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix)
+ thawByteArray, -- :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
+ unsafeThawArray, -- :: Ix ix => Array ix elt -> ST s (MutableArray s ix)
+ unsafeThawByteArray, -- :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
-- the sizes are reported back are *in bytes*.
sizeofMutableByteArray, -- :: Ix ix => MutableByteArray s ix -> Int
boundsOfMutableByteArray (MutableByteArray ixs _) = ixs
\end{code}
+
+\begin{code}
+thawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
+thawByteArray (ByteArray ixs barr#) =
+ {-
+ The implementation is made more complex by the
+ fact that the indexes are in units of whatever
+ base types that's stored in the byte array.
+ -}
+ case (sizeofByteArray# barr#) of
+ i# -> do
+ marr <- newCharArray (0,I# i#)
+ mapM_ (\ idx@(I# idx#) ->
+ writeCharArray marr idx (C# (indexCharArray# barr# idx#)))
+ [0..]
+ let (MutableByteArray _ arr#) = marr
+ return (MutableByteArray ixs arr#)
+
+{-
+ in-place conversion of immutable arrays to mutable ones places
+ a proof obligation on the user: no other parts of your code can
+ have a reference to the array at the point where you unsafely
+ thaw it (and, subsequently mutate it, I suspect.)
+-}
+unsafeThawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
+unsafeThawByteArray (ByteArray ixs barr#) = ST $ \ s# ->
+ case unsafeThawByteArray# barr# s# of
+ (# s2#, arr# #) -> (# s2#, MutableByteArray ixs arr# #)
+
+\end{code}
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
-module ST (
-
- ST,
-
- runST, -- :: (forall s. ST s a) -> a
- fixST, -- :: (a -> ST s a) -> ST s a
-
- unsafeInterleaveST,
-
- -- ST is one, so you'll likely need some Monad bits
- module Monad,
-
- STRef,
- newSTRef, readSTRef, writeSTRef,
-
- unsafeIOToST, stToIO,
-
- STArray,
- newSTArray, readSTArray, writeSTArray, boundsSTArray,
- thawSTArray, freezeSTArray, unsafeFreezeSTArray,
- Ix
+module ST
+ (
+ ST -- abstract, instance of Functor, Monad.
+ , runST -- :: (forall s. ST s a) -> a
+ , fixST -- :: (a -> ST s a) -> ST s a
+ , unsafeInterleaveST -- :: ST s a -> ST s a
+
+ , STRef
+ , newSTRef
+ , readSTRef
+ , writeSTRef
+
+ , unsafeIOToST
+ , stToIO
+
+ , STArray
+ , newSTArray
+ , readSTArray
+ , writeSTArray
+ , boundsSTArray
+ , thawSTArray
+ , freezeSTArray
+ , unsafeFreezeSTArray
+#ifndef __HUGS__
+-- no 'good' reason, just doesn't support it right now.
+ , unsafeThawSTArray
+#endif
- ) where
+ ) where
#ifdef __HUGS__
import PreludeBuiltin
freezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
+#ifndef __HUGS__
+-- see export list comment..
+unsafeThawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
+#endif
+
#ifdef __HUGS__
data STArray s ix elt = STArray (ix,ix) (PrimMutableArray s elt)
deriving Eq
freezeSTArray (STArray arr) = freezeArray arr
unsafeFreezeSTArray (STArray arr) = unsafeFreezeArray arr
+unsafeThawSTArray arr = unsafeThawArray arr >>= \ marr -> return (STArray marr)
+
#endif
\end{code}
case writeArray# to# cur# ele st# of { s1# ->
copy (cur# +# 1#) end# from# to# s1#
}}
+
+-- this is a quicker version of the above, just flipping the type
+-- (& representation) of an immutable array. And placing a
+-- proof obligation on the programmer.
+unsafeThawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
+unsafeThawArray (Array ixs arr#) = ST $ \ s# ->
+ case unsafeThawArray# arr# s# of
+ (# s2#, marr# #) -> (# s2#, MutableArray ixs marr# #)
\end{code}
unsafeFreezzeArrayzh -- Note zz in the middle
unsafeFreezzeByteArrayzh -- Ditto
+ unsafeThawArrayzh
+ unsafeThawByteArrayzh
+
sizzeofByteArrayzh -- Ditto
sizzeofMutableByteArrayzh -- Ditto
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.20 1999/03/03 19:11:43 sof Exp $
+ * $Id: PrimOps.hc,v 1.21 1999/03/05 10:21:27 sof Exp $
*
* (c) The GHC Team, 1998-1999
*
}
#endif
+/* These two are out-of-line for the benefit of the NCG */
+FN_(unsafeThawArrayzh_fast)
+{
+ FB_
+ SET_INFO((StgClosure *)R1.cl,&MUT_ARR_PTRS_info);
+ recordMutable((StgMutClosure*)R1.cl);
+
+ TICK_RET_UNBOXED_TUP(1);
+ RET_P(R1.p);
+ FE_
+}
+
/* -----------------------------------------------------------------------------
Weak Pointer Primitives
-------------------------------------------------------------------------- */
projects / ghc-hetmet.git / commitdiff