1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
-----------------------------------------------------------------------------
-- Strict State Thread module
--
-- This library provides support for both lazy and strict state threads,
-- as described in the PLDI '94 paper by John Launchbury and Simon Peyton
-- Jones. In addition to the monad ST, it also provides mutable
-- variables STRef and mutable arrays STArray. It is identical to the LazyST
-- module and ST modules except that it doesn't define any ST instances.
--
-- Suitable for use with Hugs 1.4.
-----------------------------------------------------------------------------
module STBase
( ST
, thenLazyST, thenStrictST, returnST
, unsafeInterleaveST
, fixST
, STRef
-- instance Eq (STRef s a)
, newSTRef
, readSTRef
, writeSTRef
, STArray
-- instance Eq (STArray s ix elt)
, newSTArray
, boundsSTArray
, readSTArray
, writeSTArray
, thawSTArray
, freezeSTArray
, unsafeFreezeSTArray
, Ix
) where
import Array(Array,Ix(index),bounds,assocs)
-----------------------------------------------------------------------------
primitive returnST "STReturn" :: a -> ST s a
primitive thenLazyST "STLazyBind" :: ST s a -> (a -> ST s b) -> ST s b
primitive thenStrictST "STStrictBind" :: ST s a -> (a -> ST s b) -> ST s b
primitive unsafeInterleaveST "STInter" :: ST s a -> ST s a
primitive fixST "STFix" :: (a -> ST s a) -> ST s a
-----------------------------------------------------------------------------
data STRef s a -- implemented as an internal primitive
primitive newSTRef "STNew" :: a -> ST s (STRef s a)
primitive readSTRef "STDeref" :: STRef s a -> ST s a
primitive writeSTRef "STAssign" :: STRef s a -> a -> ST s ()
primitive eqSTRef "STMutVarEq" :: STRef s a -> STRef s a -> Bool
instance Eq (STRef s a) where (==) = eqSTRef
-----------------------------------------------------------------------------
data STArray s ix elt -- implemented as an internal primitive
newSTArray :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
boundsSTArray :: Ix ix => STArray s ix elt -> (ix, ix)
readSTArray :: Ix ix => STArray s ix elt -> ix -> ST s elt
writeSTArray :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
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)
newSTArray bs e = primNewArr (index bs) bs e
boundsSTArray a = primBounds a
readSTArray a i = primReadArr index a i
writeSTArray a i e = primWriteArr index a i e
thawSTArray arr = newSTArray (bounds arr) err `thenStrictST` \ stArr ->
let
fillin [] = returnST stArr
fillin ((ix,v):ixvs) = writeSTArray stArr ix v
`thenStrictST` \ _ -> fillin ixvs
in fillin (assocs arr)
where
err = error "thawArray: element not overwritten" -- shouldnae happen
freezeSTArray a = primFreeze a
unsafeFreezeSTArray = freezeSTArray -- not as fast as GHC
instance Eq (STArray s ix elt) where
(==) = eqSTArray
primitive primNewArr "STNewArr"
:: (a -> Int) -> (a,a) -> b -> ST s (STArray s a b)
primitive primReadArr "STReadArr"
:: ((a,a) -> a -> Int) -> STArray s a b -> a -> ST s b
primitive primWriteArr "STWriteArr"
:: ((a,a) -> a -> Int) -> STArray s a b -> a -> b -> ST s ()
primitive primFreeze "STFreeze"
:: STArray s a b -> ST s (Array a b)
primitive primBounds "STBounds"
:: STArray s a b -> (a,a)
primitive eqSTArray "STArrEq"
:: STArray s a b -> STArray s a b -> Bool
-----------------------------------------------------------------------------
|
