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

Commit c81af7c

Browse files
garybgaryb
committed
Merge pull request #11 from dylex/master
Additions, improvements, and optimizations for StrMap
2 parents 3fc0d05 + 1811044 commit c81af7c

File tree

8 files changed

+293
-95
lines changed

8 files changed

+293
-95
lines changed

‎README.md‎

Lines changed: 51 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -140,13 +140,19 @@
140140

141141
instance eqStrMap :: (P.Eq a) => P.Eq (StrMap a)
142142

143+
instance foldableStrMap :: Foldable StrMap
144+
143145
instance functorStrMap :: P.Functor StrMap
144146

147+
instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a)
148+
145149
instance showStrMap :: (P.Show a) => P.Show (StrMap a)
146150

147151

148152
### Values
149153

154+
all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean
155+
150156
alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a
151157

152158
delete :: forall a. String -> StrMap a -> StrMap a
@@ -155,8 +161,14 @@
155161

156162
fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z
157163

164+
foldM :: forall a m z. (P.Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z
165+
166+
foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m
167+
158168
foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z
159169

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

162174
insert :: forall a. String -> a -> StrMap a -> StrMap a
@@ -173,8 +185,14 @@
173185

174186
member :: forall a. String -> StrMap a -> Boolean
175187

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

192+
size :: forall a. StrMap a -> Number
193+
194+
thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a)
195+
178196
toList :: forall a. StrMap a -> [Tuple String a]
179197

180198
union :: forall a. StrMap a -> StrMap a -> StrMap a
@@ -183,4 +201,36 @@
183201

184202
update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a
185203

186-
values :: forall a. StrMap a -> [a]
204+
values :: forall a. StrMap a -> [a]
205+
206+
207+
## Module Data.StrMap.ST
208+
209+
### Types
210+
211+
data STStrMap :: * -> * -> *
212+
213+
214+
### Values
215+
216+
delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a)
217+
218+
new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a)
219+
220+
peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a
221+
222+
poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a)
223+
224+
225+
## Module Data.StrMap.ST.Unsafe
226+
227+
### Values
228+
229+
unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a)
230+
231+
232+
## Module Data.StrMap.Unsafe
233+
234+
### Values
235+
236+
unsafeIndex :: forall a. StrMap a -> String -> a

‎bower.json‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,7 @@
2222
"package.json"
2323
],
2424
"devDependencies": {
25-
"purescript-quickcheck": "*",
26-
"purescript-arb-instances": "*"
25+
"purescript-quickcheck": "*"
2726
},
2827
"dependencies": {
2928
"purescript-arrays": "*",

‎src/Data/StrMap.purs‎

Lines changed: 142 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module Data.StrMap
88
( StrMap(),
99
empty,
1010
isEmpty,
11+
size,
1112
singleton,
1213
insert,
1314
lookup,
@@ -24,60 +25,135 @@ module Data.StrMap
2425
map,
2526
isSubmap,
2627
fold,
27-
foldMaybe
28+
foldMap,
29+
foldM,
30+
foldMaybe,
31+
all,
32+
33+
thawST,
34+
freezeST,
35+
runST
2836
) where
2937

3038
import qualified Prelude as P
3139

40+
import Control.Monad.Eff (Eff(), runPure)
41+
import qualified Control.Monad.ST as ST
3242
import qualified Data.Array as A
3343
import Data.Maybe
3444
import Data.Function
3545
import Data.Tuple
36-
import Data.Foldable (foldl)
46+
import Data.Foldable (Foldable, foldl, foldr, for_)
47+
import Data.Monoid
48+
import Data.Monoid.All
49+
import qualified Data.StrMap.ST as SM
3750

3851
foreign import data StrMap :: * -> *
3952

40-
foreign import _foldStrMap
41-
"function _foldStrMap(m, z0, f) {\
42-
\ var z = z0;\
43-
\ for (var k in m) {\
44-
\ if (m.hasOwnProperty(k)) z = f(z)(k)(m[k]);\
45-
\ }\
46-
\ return z;\
47-
\}" :: forall v z. Fn3 (StrMap v) z (z -> String -> v -> z) z
48-
49-
fold :: forall a z. (z -> String -> a -> z) -> z -> (StrMap a) -> z
50-
fold f z m = runFn3 _foldStrMap m z f
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)
5187

5288
foreign import _fmapStrMap
5389
"function _fmapStrMap(m0, f) {\
5490
\ var m = {};\
5591
\ for (var k in m0) {\
56-
\ if (m0.hasOwnProperty(k)) m[k] = f(m0[k]);\
92+
\ m[k] = f(m0[k]);\
5793
\ }\
5894
\ return m;\
5995
\}" :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b)
6096

6197
instance functorStrMap :: P.Functor StrMap where
6298
(<$>) f m = runFn2 _fmapStrMap m f
6399

100+
foreign import _foldM
101+
"function _foldM(bind) {\
102+
\ return function(f) {\
103+
\ return function (mz) {\
104+
\ return function (m) {\
105+
\ var k;\
106+
\ function g(z) {\
107+
\ return f(z)(k)(m[k]);\
108+
\ }\
109+
\ for (k in m)\
110+
\ mz = bind(mz)(g);\
111+
\ return mz;\
112+
\ };\
113+
\ };\
114+
\ };\
115+
\}" :: forall a m z. (m -> (z -> m) -> m) -> (z -> String -> a -> m) -> m -> StrMap a -> m
116+
117+
fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z
118+
fold = _foldM (P.(#))
119+
120+
foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m
121+
foldMap f = fold (\acc k v -> acc P.<> f k v) mempty
122+
123+
foldM :: forall a m z. (P.Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z
124+
foldM f z = _foldM P.(>>=) f (P.pure z)
125+
126+
instance foldableStrMap :: Foldable StrMap where
127+
foldl f = fold (\z _ -> f z)
128+
foldr f z m = foldr f z (values m)
129+
foldMap f = foldMap (P.const f)
130+
131+
-- Unfortunately the above are not short-circuitable (consider using purescript-machines)
132+
-- so we need special cases:
133+
64134
foreign import _foldSCStrMap
65-
"function _foldSCStrMap(m, z0, f, fromMaybe) { \
66-
\ var z = z0; \
135+
"function _foldSCStrMap(m, z, f, fromMaybe) { \
67136
\ for (var k in m) { \
68-
\ if (m.hasOwnProperty(k)) { \
69-
\ var maybeR = f(z)(k)(m[k]); \
70-
\ var r = fromMaybe(null)(maybeR); \
71-
\ if (r === null) return z; \
72-
\ else z = r; \
73-
\ } \
137+
\ var maybeR = f(z)(k)(m[k]); \
138+
\ var r = fromMaybe(null)(maybeR); \
139+
\ if (r === null) return z; \
140+
\ else z = r; \
74141
\ } \
75142
\ return z; \
76143
\}" :: forall a z. Fn4 (StrMap a) z (z -> String -> a -> Maybe z) (forall a. a -> Maybe a -> a) z
77144

78-
foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> (StrMap a) -> z
145+
foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z
79146
foldMaybe f z m = runFn4 _foldSCStrMap m z f fromMaybe
80147

148+
foreign import all
149+
"function all(f) {\
150+
\ return function (m) {\
151+
\ for (var k in m)\
152+
\ if (!f(k)(m[k])) return false;\
153+
\ return true;\
154+
\ };\
155+
\}" :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean
156+
81157
instance eqStrMap :: (P.Eq a) => P.Eq (StrMap a) where
82158
(==) m1 m2 = (isSubmap m1 m2) P.&& (isSubmap m2 m1)
83159
(/=) m1 m2 = P.not (m1 P.== m2)
@@ -88,53 +164,39 @@ instance showStrMap :: (P.Show a) => P.Show (StrMap a) where
88164
foreign import empty "var empty = {};" :: forall a. StrMap a
89165

90166
isSubmap :: forall a. (P.Eq a) => StrMap a -> StrMap a -> Boolean
91-
isSubmap m1 m2 = foldMaybe f true m1 where
92-
f acc k v = if (P.not acc) then (Nothing :: Maybe Boolean)
93-
else Just P.$ acc P.&& (maybe false (\v0 -> v0 P.== v) (lookup k m2))
167+
isSubmap m1 m2 = all f m1 where
168+
f k v = runFn4 _lookup false (P.(==) v) k m2
94169

95170
isEmpty :: forall a. StrMap a -> Boolean
96-
isEmpty m = size m P.== 0
171+
isEmpty = all (\_ _ -> false)
97172

98173
foreign import size "function size(m) {\
99174
\ var s = 0;\
100175
\ for (var k in m) {\
101-
\ if (m.hasOwnProperty(k)) ++s;\
176+
\ ++s;\
102177
\ }\
103178
\ return s;\
104179
\}" :: forall a. StrMap a -> Number
105180

106181
singleton :: forall a. String -> a -> StrMap a
107-
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)
108186

109187
foreign import _lookup
110-
"function _lookup(m, k, yes, no) { \
111-
\ if (m[k] !== undefined) return yes(m[k]); \
112-
\ else return no; \
113-
\}" :: forall a z. Fn4 (StrMap a) String (a -> z) z z
188+
"function _lookup(no, yes, k, m) {\
189+
\ return k in m ? yes(m[k]) : no;\
190+
\}" :: forall a z. Fn4 z (a -> z) String (StrMap a) z
114191

115192
lookup :: forall a. String -> StrMap a -> Maybe a
116-
lookup k m = runFn4 _lookup m k Just Nothing
193+
lookup = runFn4 _lookup Nothing Just
117194

118195
member :: forall a. String -> StrMap a -> Boolean
119-
member k m = isJust (k `lookup` m)
120-
121-
foreign import _cloneStrMap
122-
"function _cloneStrMap(m0) { \
123-
\ var m = {}; \
124-
\ for (var k in m0) {\
125-
\ if (m0.hasOwnProperty(k)) m[k] = m0[k];\
126-
\ }\
127-
\ return m;\
128-
\}" :: forall a. (StrMap a) -> (StrMap a)
129-
130-
foreign import _unsafeInsertStrMap
131-
"function _unsafeInsertStrMap(m, k, v) { \
132-
\ m[k] = v; \
133-
\ return m; \
134-
\}" :: forall a. Fn3 (StrMap a) String a (StrMap a)
196+
member = runFn4 _lookup false (P.const true)
135197

136198
insert :: forall a. String -> a -> StrMap a -> StrMap a
137-
insert k v m = runFn3 _unsafeInsertStrMap (_cloneStrMap m) k v
199+
insert k v = mutate (\s -> SM.poke s k v)
138200

139201
foreign import _unsafeDeleteStrMap
140202
"function _unsafeDeleteStrMap(m, k) { \
@@ -143,7 +205,7 @@ foreign import _unsafeDeleteStrMap
143205
\}" :: forall a. Fn2 (StrMap a) String (StrMap a)
144206

145207
delete :: forall a. String -> StrMap a -> StrMap a
146-
delete k m = runFn2 _unsafeDeleteStrMap (_cloneStrMap m) k
208+
delete k = mutate (\s -> SM.delete s k)
147209

148210
alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a
149211
alter f k m = case f (k `lookup` m) of
@@ -153,26 +215,42 @@ alter f k m = case f (k `lookup` m) of
153215
update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a
154216
update f k m = alter (maybe Nothing f) k m
155217

156-
toList :: forall a. StrMap a -> [Tuple String a]
157-
toList m = fold f [] m where
158-
f acc k v = acc P.++ [Tuple k v]
159-
160218
fromList :: forall a. [Tuple String a] -> StrMap a
161-
fromList = foldl (\m (Tuple k v) -> insert k v m) empty
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+
224+
foreign import _collect
225+
"function _collect(f) {\
226+
\ return function (m) {\
227+
\ var r = [];\
228+
\ for (var k in m)\
229+
\ r.push(f(k)(m[k]));\
230+
\ return r;\
231+
\ };\
232+
\}" :: forall a b . (String -> a -> b) -> StrMap a -> [b]
162233

163-
keys :: forall a. StrMap a -> [String]
164-
keys m = fold f [] m where
165-
f acc k v = acc P.++ [k]
234+
toList :: forall a. StrMap a -> [Tuple String a]
235+
toList = _collect Tuple
236+
237+
foreign import keys
238+
"var keys = Object.keys || _collect(function (k) {\
239+
\ return function () { return k; };\
240+
\});" :: forall a. StrMap a -> [String]
166241

167242
values :: forall a. StrMap a -> [a]
168-
values m = fold f [] m where
169-
f acc k v = acc P.++ [v]
243+
values = _collect (\_ v -> v)
170244

245+
-- left-biased
171246
union :: forall a. StrMap a -> StrMap a -> StrMap a
172-
union m1 m2 = foldl (\m (Tuple k v) -> insert k v m) m2 (toList m1)
247+
union m = mutate (\s -> foldM SM.poke s m)
173248

174249
unions :: forall a. [StrMap a] -> StrMap a
175250
unions = foldl union empty
176251

177252
map :: forall a b. (a -> b) -> StrMap a -> StrMap b
178-
map = P.(<$>)
253+
map = P.(<$>)
254+
255+
instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a) where
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

0 commit comments

Comments
 (0)