Skip to content
This repository was archived by the owner on Oct 4, 2020. It is now read-only.

Commit 1811044

Browse files
dylexdylex
committed
Use STStrMap in StrMap constructors
Eliminate some duplicate code in _unsafe helper functions. Move all the ST functions that involve StrMap out of the ST module to do this, and make the ST module interface more directly parallel the STArray one (including an unsafe peek). It would be nice to have more ST operations, but it's not clear the best way to provide them safely without redundant code (the ones that were there before violated Eff semantics).
1 parent 354a34b commit 1811044

File tree

4 files changed

+88
-94
lines changed

4 files changed

+88
-94
lines changed

‎README.md‎

Lines changed: 9 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -167,6 +167,8 @@
167167

168168
foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z
169169

170+
freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a)
171+
170172
fromList :: forall a. [Tuple String a] -> StrMap a
171173

172174
insert :: forall a. String -> a -> StrMap a -> StrMap a
@@ -183,10 +185,14 @@
183185

184186
member :: forall a. String -> StrMap a -> Boolean
185187

188+
runST :: forall a r. (forall h. Eff (st :: ST.ST h | r) (SM.STStrMap h a)) -> Eff r (StrMap a)
189+
186190
singleton :: forall a. String -> a -> StrMap a
187191

188192
size :: forall a. StrMap a -> Number
189193

194+
thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a)
195+
190196
toList :: forall a. StrMap a -> [Tuple String a]
191197

192198
union :: forall a. StrMap a -> StrMap a -> StrMap a
@@ -209,26 +215,18 @@
209215

210216
delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a)
211217

212-
freeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (SM.StrMap a)
213-
214-
isEmpty :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Boolean
215-
216218
new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a)
217219

218-
peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (Maybe a)
219-
220-
poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) a
221-
222-
size :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Number
220+
peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a
223221

224-
thaw :: forall a h r. SM.StrMap a -> Eff (st :: ST h | r) (STStrMap h a)
222+
poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a)
225223

226224

227225
## Module Data.StrMap.ST.Unsafe
228226

229227
### Values
230228

231-
unsafePeek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a
229+
unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a)
232230

233231

234232
## Module Data.StrMap.Unsafe

‎src/Data/StrMap.purs‎

Lines changed: 58 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -28,21 +28,63 @@ module Data.StrMap
2828
foldMap,
2929
foldM,
3030
foldMaybe,
31-
all
31+
all,
32+
33+
thawST,
34+
freezeST,
35+
runST
3236
) where
3337

3438
import qualified Prelude as P
3539

40+
import Control.Monad.Eff (Eff(), runPure)
41+
import qualified Control.Monad.ST as ST
3642
import qualified Data.Array as A
3743
import Data.Maybe
3844
import Data.Function
3945
import Data.Tuple
40-
import Data.Foldable (Foldable, foldl, foldr)
46+
import Data.Foldable (Foldable, foldl, foldr, for_)
4147
import Data.Monoid
4248
import Data.Monoid.All
49+
import qualified Data.StrMap.ST as SM
4350

4451
foreign import data StrMap :: * -> *
4552

53+
foreign import _copy """
54+
function _copy(m) {
55+
var r = {};
56+
for (var k in m)
57+
r[k] = m[k]
58+
return r;
59+
}""" :: forall a. StrMap a -> StrMap a
60+
61+
foreign import _copyEff """
62+
function _copyEff(m) {
63+
return function () {
64+
return _copy(m);
65+
};
66+
}""" :: forall a b h r. a -> Eff (st :: ST.ST h | r) b
67+
68+
thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a)
69+
thawST = _copyEff
70+
71+
freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a)
72+
freezeST = _copyEff
73+
74+
foreign import runST """
75+
function runST(f) {
76+
return f;
77+
}""" :: forall a r. (forall h. Eff (st :: ST.ST h | r) (SM.STStrMap h a)) -> Eff r (StrMap a)
78+
79+
pureST :: forall a b. (forall h e. Eff (st :: ST.ST h | e) (SM.STStrMap h a)) -> StrMap a
80+
pureST f = runPure (runST f)
81+
82+
mutate :: forall a b. (forall h e. SM.STStrMap h a -> Eff (st :: ST.ST h | e) b) -> StrMap a -> StrMap a
83+
mutate f m = pureST (do
84+
s <- thawST m
85+
f s
86+
P.return s)
87+
4688
foreign import _fmapStrMap
4789
"function _fmapStrMap(m0, f) {\
4890
\ var m = {};\
@@ -137,7 +179,10 @@ foreign import size "function size(m) {\
137179
\}" :: forall a. StrMap a -> Number
138180

139181
singleton :: forall a. String -> a -> StrMap a
140-
singleton k v = insert k v empty
182+
singleton k v = pureST (do
183+
s <- SM.new
184+
SM.poke s k v
185+
P.return s)
141186

142187
foreign import _lookup
143188
"function _lookup(no, yes, k, m) {\
@@ -150,26 +195,8 @@ lookup = runFn4 _lookup Nothing Just
150195
member :: forall a. String -> StrMap a -> Boolean
151196
member = runFn4 _lookup false (P.const true)
152197

153-
foreign import _cloneStrMap
154-
"function _cloneStrMap(m0) { \
155-
\ var m = {}; \
156-
\ for (var k in m0) {\
157-
\ m[k] = m0[k];\
158-
\ }\
159-
\ return m;\
160-
\}" :: forall a. (StrMap a) -> (StrMap a)
161-
162-
foreign import _unsafeInsertStrMap
163-
"function _unsafeInsertStrMap(m, k, v) { \
164-
\ m[k] = v; \
165-
\ return m; \
166-
\}" :: forall a. Fn3 (StrMap a) String a (StrMap a)
167-
168-
_unsafeInsert :: forall a. StrMap a -> String -> a -> StrMap a
169-
_unsafeInsert = runFn3 _unsafeInsertStrMap
170-
171198
insert :: forall a. String -> a -> StrMap a -> StrMap a
172-
insert k v m = _unsafeInsert (_cloneStrMap m) k v
199+
insert k v = mutate (\s -> SM.poke s k v)
173200

174201
foreign import _unsafeDeleteStrMap
175202
"function _unsafeDeleteStrMap(m, k) { \
@@ -178,7 +205,7 @@ foreign import _unsafeDeleteStrMap
178205
\}" :: forall a. Fn2 (StrMap a) String (StrMap a)
179206

180207
delete :: forall a. String -> StrMap a -> StrMap a
181-
delete k m = runFn2 _unsafeDeleteStrMap (_cloneStrMap m) k
208+
delete k = mutate (\s -> SM.delete s k)
182209

183210
alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a
184211
alter f k m = case f (k `lookup` m) of
@@ -188,6 +215,12 @@ alter f k m = case f (k `lookup` m) of
188215
update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a
189216
update f k m = alter (maybe Nothing f) k m
190217

218+
fromList :: forall a. [Tuple String a] -> StrMap a
219+
fromList l = pureST (do
220+
s <- SM.new
221+
for_ l (\(Tuple k v) -> SM.poke s k v)
222+
P.return s)
223+
191224
foreign import _collect
192225
"function _collect(f) {\
193226
\ return function (m) {\
@@ -201,9 +234,6 @@ foreign import _collect
201234
toList :: forall a. StrMap a -> [Tuple String a]
202235
toList = _collect Tuple
203236

204-
fromList :: forall a. [Tuple String a] -> StrMap a
205-
fromList = foldl (\m (Tuple k v) -> _unsafeInsert m k v) (_cloneStrMap empty)
206-
207237
foreign import keys
208238
"var keys = Object.keys || _collect(function (k) {\
209239
\ return function () { return k; };\
@@ -214,7 +244,7 @@ values = _collect (\_ v -> v)
214244

215245
-- left-biased
216246
union :: forall a. StrMap a -> StrMap a -> StrMap a
217-
union m1 m2 = fold _unsafeInsert (_cloneStrMap m2) m1
247+
union m = mutate (\s -> foldM SM.poke s m)
218248

219249
unions :: forall a. [StrMap a] -> StrMap a
220250
unions = foldl union empty
@@ -223,5 +253,4 @@ map :: forall a b. (a -> b) -> StrMap a -> StrMap b
223253
map = P.(<$>)
224254

225255
instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a) where
226-
(<>) m1 m2 = fold f (_cloneStrMap m1) m2 where
227-
f m k v2 = _unsafeInsert m k (runFn4 _lookup v2 (\v1 -> v1 P.<> v2) k m)
256+
(<>) m1 m2 = mutate (\s -> foldM (\s k v2 -> SM.poke s k (runFn4 _lookup v2 (\v1 -> v1 P.<> v2) k m2)) s m1) m2

‎src/Data/StrMap/ST.purs‎

Lines changed: 11 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,7 @@
11
module Data.StrMap.ST
22
( STStrMap()
33
, new
4-
, freeze
5-
, thaw
6-
, isEmpty
74
, peek
8-
, size
95
, poke
106
, delete
117
) where
@@ -14,8 +10,6 @@ import Control.Monad.Eff
1410
import Control.Monad.ST
1511
import Data.Maybe
1612

17-
import qualified Data.StrMap as SM
18-
1913
foreign import data STStrMap :: * -> * -> *
2014

2115
foreign import _new """
@@ -26,46 +20,26 @@ foreign import _new """
2620
new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a)
2721
new = _new
2822

29-
foreign import _copy """
30-
function _copy(m) {
31-
return function () {
32-
var r = {};
33-
for (var k in m)
34-
r[k] = m[k];
35-
return r;
36-
};
37-
}""" :: forall a b h r. a -> Eff (st :: ST h | r) b
38-
39-
thaw :: forall a h r. SM.StrMap a -> Eff (st :: ST h | r) (STStrMap h a)
40-
thaw = _copy
41-
42-
freeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (SM.StrMap a)
43-
freeze = _copy
44-
45-
foreign import _unST """
46-
function _unST(m) {
47-
return m;
48-
}""" :: forall a h. STStrMap h a -> SM.StrMap a
49-
50-
isEmpty :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Boolean
51-
isEmpty m = return (SM.isEmpty (_unST m))
52-
53-
peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (Maybe a)
54-
peek m k = return (SM.lookup k (_unST m))
55-
56-
size :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Number
57-
size m = return (SM.size (_unST m))
23+
foreign import peek """
24+
function peek(m) {
25+
return function (k) {
26+
return function () {
27+
return m[k];
28+
}
29+
}
30+
}""" :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a
5831

5932
foreign import poke """
6033
function poke(m) {
6134
return function (k) {
6235
return function (v) {
6336
return function () {
64-
return m[k] = v;
37+
m[k] = v;
38+
return m;
6539
};
6640
};
6741
};
68-
}""" :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) a
42+
}""" :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a)
6943

7044
foreign import _delete """
7145
function _delete(m) {
@@ -79,8 +53,3 @@ foreign import _delete """
7953

8054
delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a)
8155
delete = _delete
82-
83-
foreign import run """
84-
function run(f) {
85-
return f;
86-
}""" :: forall a r. (forall h. Eff (st :: ST h | r) (STStrMap h a)) -> Eff r (SM.StrMap a)

‎src/Data/StrMap/ST/Unsafe.purs‎

Lines changed: 10 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,17 +1,15 @@
11
module Data.StrMap.ST.Unsafe
2-
( unsafePeek
2+
( unsafeGet
33
) where
44

5-
import Control.Monad.Eff
6-
import Control.Monad.ST
7-
import Data.StrMap.Unsafe
8-
import Data.StrMap.ST
5+
import Control.Monad.Eff (Eff())
6+
import Control.Monad.ST (ST())
7+
import Data.StrMap (StrMap())
8+
import Data.StrMap.ST (STStrMap())
99

10-
foreign import unsafePeek """
11-
function unsafePeek(m) {
12-
return function (k) {
13-
return function () {
14-
return m[k];
15-
}
10+
foreign import unsafeGet """
11+
function unsafeGet(m) {
12+
return function () {
13+
return m;
1614
}
17-
}""" :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a
15+
}""" :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a)

0 commit comments

Comments
 (0)