Skip to content

GitLab

Commit 9b910bc8 authored by sof's avatar sof
Browse files
Options

[project @ 1999-03-05 10:21:22 by sof] 

Support for unsafely thawing your (Byte)Arrays, i.e., added the
following ops:

 MutableArray.unsafeThawArray :: Ix ix => Array ix elt -> ST s (MutableArray s ix elt)
 MutableArray.unsafeThawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)
 MutableArray.thawByteArray :: Ix ix => ByteArray ix -> ST s (MutableByteArray s ix)

 ST.unsafeThawSTArray 	    :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
 LazyST.unsafeThawSTArray   :: Ix ix => Array ix elt -> ST s (STArray s ix elt)

 IOExts.unsafeFreezeIOArray :: Ix ix => IOArray ix elt -> IO (Array ix elt)
 IOExts.unsafeThawIOArray   :: Ix ix => Array ix elt -> IO (IOArray ix elt)

+ removed the re-exportation of Monad that ST and LazyST did.
parent 2ed3e0f4
Hide whitespace changes
Inline Side-by-side
Showing with 202 additions and 75 deletions
ghc/compiler/nativeGen/StixPrim.lhs
View file @ 9b910bc8
......@@ -109,6 +109,8 @@ primCode [lhs] UnsafeFreezeArrayOp [rhs]
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
......
ghc/compiler/prelude/PrimOp.lhs
View file @ 9b910bc8
......@@ -152,6 +152,7 @@ data PrimOp
| IndexOffForeignObjOp PrimRep
| UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
| UnsafeThawArrayOp | UnsafeThawByteArrayOp
| SizeofByteArrayOp | SizeofMutableByteArrayOp
-- Mutable variables
......@@ -497,48 +498,50 @@ tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(195)
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"
......@@ -760,6 +763,8 @@ allThePrimOps
WriteOffAddrOp Word64Rep,
UnsafeFreezeArrayOp,
UnsafeFreezeByteArrayOp,
UnsafeThawArrayOp,
UnsafeThawByteArrayOp,
SizeofByteArrayOp,
SizeofMutableByteArrayOp,
NewMutVarOp,
......@@ -1328,6 +1333,24 @@ primOpInfo UnsafeFreezeByteArrayOp
[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
......@@ -1838,6 +1861,11 @@ primOpOutOfLine op
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}
......
ghc/docs/users_guide/MutableArray.sgml
View file @ 9b910bc8
......@@ -25,7 +25,8 @@ writeArray :: Ix ix => MutableArray s ix elt -> ix -> elt -> ST s ()
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>
......@@ -34,6 +35,7 @@ unsafeFreezeArray :: Ix ix => MutableArray s ix elt -> ST s (Array ix elt)
<nidx>freezeArray</nidx>
<nidx>thawArray</nidx>
<nidx>unsafeFreezeArray</nidx>
<nidx>unsafeThawArray</nidx>
<bf/Remarks:/
......@@ -49,8 +51,9 @@ array in the process. Please don't :-)
<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/
......@@ -111,6 +114,9 @@ unsafeFreezeByteArray :: Ix ix => MutableByteArray s ix -> ST s (ByteArray ix)
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>
......@@ -150,6 +156,8 @@ sizeofMutableByteArray :: Ix ix => MutableByteArray s ix -> Int
<nidx>freezeFloatArray</nidx>
<nidx>freezeDoubleArray</nidx>
<nidx>unsafeFreezeByteArray</nidx>
<nidx>unsafeThawByteArray</nidx>
<nidx>thawByteArray</nidx>
<bf/Remarks:/
<itemize>
......@@ -192,7 +200,10 @@ into immutable byte arrays are also provided by the <tt/freeze*/
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
......
ghc/includes/PrimOps.h
View file @ 9b910bc8
/* -----------------------------------------------------------------------------
* $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
*
......@@ -575,6 +575,9 @@ extern I_ resetGenSymZh(void);
}
#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_))
......
ghc/lib/exts/IOExts.lhs
View file @ 9b910bc8
......@@ -30,6 +30,10 @@ module IOExts
, writeIOArray
, freezeIOArray
, thawIOArray
#ifndef __HUGS__
, unsafeFreezeIOArray
, unsafeThawIOArray
#endif
#ifdef __HUGS__
#else
......@@ -111,6 +115,10 @@ readIOArray :: Ix ix => IOArray ix elt -> ix -> IO elt
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
......@@ -139,6 +147,11 @@ freezeIOArray (IOArray arr) = stToIO (freezeArray arr)
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}
......
ghc/lib/exts/LazyST.lhs
View file @ 9b910bc8
......@@ -15,16 +15,13 @@ module LazyST (
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,
......@@ -117,6 +114,9 @@ thawSTArray arr =
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 ->
......
ghc/lib/exts/MutableArray.lhs
View file @ 9b910bc8
......@@ -55,7 +55,11 @@ module MutableArray
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
......@@ -378,3 +382,33 @@ boundsOfMutableByteArray :: Ix ix => MutableByteArray s ix -> (ix, ix)
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}
ghc/lib/exts/ST.lhs
View file @ 9b910bc8
......@@ -6,29 +6,35 @@
\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
......@@ -82,6 +88,11 @@ thawSTArray :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
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
......@@ -149,6 +160,8 @@ thawSTArray arr = thawArray arr >>= \starr -> return (STArray starr)
freezeSTArray (STArray arr) = freezeArray arr
unsafeFreezeSTArray (STArray arr) = unsafeFreezeArray arr
unsafeThawSTArray arr = unsafeThawArray arr >>= \ marr -> return (STArray marr)
#endif
\end{code}
......
ghc/lib/std/PrelArr.lhs
View file @ 9b910bc8
......@@ -637,4 +637,12 @@ thawArray (Array ixs arr#) = ST $ \ s# ->
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}
ghc/lib/std/PrelGHC.hi-boot
View file @ 9b910bc8
......@@ -277,6 +277,9 @@ __export PrelGHC
unsafeFreezzeArrayzh -- Note zz in the middle
unsafeFreezzeByteArrayzh -- Ditto
unsafeThawArrayzh
unsafeThawByteArrayzh
sizzeofByteArrayzh -- Ditto
sizzeofMutableByteArrayzh -- Ditto
......
ghc/rts/PrimOps.hc
View file @ 9b910bc8
/* -----------------------------------------------------------------------------
* $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
*
......@@ -297,6 +297,18 @@ FN_(makeForeignObjzh_fast)
}
#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
-------------------------------------------------------------------------- */
......
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