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

Additions, improvements, and optimizations for StrMap #11

Merged
merged 5 commits into from
Oct 19, 2014
Merged

Additions, improvements, and optimizations for StrMap #11

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
7213be8
Improvements for StrMap: optimizations, add unsafeIndex, size, foldM,…
dylex Oct 11, 2014
b8bbc62
Basic STStrMap, allowing efficient mutation of records
dylex Oct 11, 2014
3668e60
Remove deprecated arb-instances dependency
dylex Oct 12, 2014
354a34b
Add Foldable StrMap instance
dylex Oct 12, 2014
1811044
Use STStrMap in StrMap constructors
dylex Oct 12, 2014
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
52 changes: 51 additions & 1 deletion README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -140,13 +140,19 @@

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

instance foldableStrMap :: Foldable StrMap

instance functorStrMap :: P.Functor StrMap

instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a)

instance showStrMap :: (P.Show a) => P.Show (StrMap a)


### Values

all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean

alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a

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

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

foldM :: forall a m z. (P.Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z

foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m

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

freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a)

fromList :: forall a. [Tuple String a] -> StrMap a

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

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

runST :: forall a r. (forall h. Eff (st :: ST.ST h | r) (SM.STStrMap h a)) -> Eff r (StrMap a)

singleton :: forall a. String -> a -> StrMap a

size :: forall a. StrMap a -> Number

thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a)

toList :: forall a. StrMap a -> [Tuple String a]

union :: forall a. StrMap a -> StrMap a -> StrMap a
Expand All @@ -183,4 +201,36 @@

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

values :: forall a. StrMap a -> [a]
values :: forall a. StrMap a -> [a]


## Module Data.StrMap.ST

### Types

data STStrMap :: * -> * -> *


### Values

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

new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a)

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

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


## Module Data.StrMap.ST.Unsafe

### Values

unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a)


## Module Data.StrMap.Unsafe

### Values

unsafeIndex :: forall a. StrMap a -> String -> a
3 changes: 1 addition & 2 deletions bower.json
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,7 @@
"package.json"
],
"devDependencies": {
"purescript-quickcheck": "*",
"purescript-arb-instances": "*"
"purescript-quickcheck": "*"
},
"dependencies": {
"purescript-arrays": "*",
Expand Down
206 changes: 142 additions & 64 deletions src/Data/StrMap.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ module Data.StrMap
( StrMap(),
empty,
isEmpty,
size,
singleton,
insert,
lookup,
Expand All @@ -24,60 +25,135 @@ module Data.StrMap
map,
isSubmap,
fold,
foldMaybe
foldMap,
foldM,
foldMaybe,
all,

thawST,
freezeST,
runST
) where

import qualified Prelude as P

import Control.Monad.Eff (Eff(), runPure)
import qualified Control.Monad.ST as ST
import qualified Data.Array as A
import Data.Maybe
import Data.Function
import Data.Tuple
import Data.Foldable (foldl)
import Data.Foldable (Foldable, foldl, foldr, for_)
import Data.Monoid
import Data.Monoid.All
import qualified Data.StrMap.ST as SM

foreign import data StrMap :: * -> *

foreign import _foldStrMap
"function _foldStrMap(m, z0, f) {\
\ var z = z0;\
\ for (var k in m) {\
\ if (m.hasOwnProperty(k)) z = f(z)(k)(m[k]);\
\ }\
\ return z;\
\}" :: forall v z. Fn3 (StrMap v) z (z -> String -> v -> z) z

fold :: forall a z. (z -> String -> a -> z) -> z -> (StrMap a) -> z
fold f z m = runFn3 _foldStrMap m z f
foreign import _copy """
function _copy(m) {
var r = {};
for (var k in m)
r[k] = m[k]
return r;
}""" :: forall a. StrMap a -> StrMap a

foreign import _copyEff """
function _copyEff(m) {
return function () {
return _copy(m);
};
}""" :: forall a b h r. a -> Eff (st :: ST.ST h | r) b

thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a)
thawST = _copyEff

freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a)
freezeST = _copyEff

foreign import runST """
function runST(f) {
return f;
}""" :: forall a r. (forall h. Eff (st :: ST.ST h | r) (SM.STStrMap h a)) -> Eff r (StrMap a)

pureST :: forall a b. (forall h e. Eff (st :: ST.ST h | e) (SM.STStrMap h a)) -> StrMap a
pureST f = runPure (runST f)

mutate :: forall a b. (forall h e. SM.STStrMap h a -> Eff (st :: ST.ST h | e) b) -> StrMap a -> StrMap a
mutate f m = pureST (do
s <- thawST m
f s
P.return s)

foreign import _fmapStrMap
"function _fmapStrMap(m0, f) {\
\ var m = {};\
\ for (var k in m0) {\
\ if (m0.hasOwnProperty(k)) m[k] = f(m0[k]);\
\ m[k] = f(m0[k]);\
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why the change to include inherited properties?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I tried to clarify this in the commit message: Since we know that all StrMap objects have prototype Object, we know they have no additional enumerable keys, so hasOwnProperty checks are unnecessary. The only exception would be if people added additional properties to Object.prototype, but that would break all sorts of stuff. Or if people unsafely cast created objects to StrMap, but then maybe they'd want this behavior.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Makes sense. I do an unsafe cast in purescript-argonaut because I don't want the overhead of JSON serialization, but that should still be safe since the data is guaranteed to be JSON and therefore extend Object.

\ }\
\ return m;\
\}" :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b)

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

foreign import _foldM
"function _foldM(bind) {\
\ return function(f) {\
\ return function (mz) {\
\ return function (m) {\
\ var k;\
\ function g(z) {\
\ return f(z)(k)(m[k]);\
\ }\
\ for (k in m)\
\ mz = bind(mz)(g);\
\ return mz;\
\ };\
\ };\
\ };\
\}" :: forall a m z. (m -> (z -> m) -> m) -> (z -> String -> a -> m) -> m -> StrMap a -> m

fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z
fold = _foldM (P.(#))

foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m
foldMap f = fold (\acc k v -> acc P.<> f k v) mempty

foldM :: forall a m z. (P.Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z
foldM f z = _foldM P.(>>=) f (P.pure z)

instance foldableStrMap :: Foldable StrMap where
foldl f = fold (\z _ -> f z)
foldr f z m = foldr f z (values m)
foldMap f = foldMap (P.const f)

-- Unfortunately the above are not short-circuitable (consider using purescript-machines)
-- so we need special cases:

foreign import _foldSCStrMap
"function _foldSCStrMap(m, z0, f, fromMaybe) { \
\ var z = z0; \
"function _foldSCStrMap(m, z, f, fromMaybe) { \
\ for (var k in m) { \
\ if (m.hasOwnProperty(k)) { \
\ var maybeR = f(z)(k)(m[k]); \
\ var r = fromMaybe(null)(maybeR); \
\ if (r === null) return z; \
\ else z = r; \
\ } \
\ var maybeR = f(z)(k)(m[k]); \
\ var r = fromMaybe(null)(maybeR); \
\ if (r === null) return z; \
\ else z = r; \
\ } \
\ return z; \
\}" :: forall a z. Fn4 (StrMap a) z (z -> String -> a -> Maybe z) (forall a. a -> Maybe a -> a) z

foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> (StrMap a) -> z
foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z
foldMaybe f z m = runFn4 _foldSCStrMap m z f fromMaybe

foreign import all
"function all(f) {\
\ return function (m) {\
\ for (var k in m)\
\ if (!f(k)(m[k])) return false;\
\ return true;\
\ };\
\}" :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean

instance eqStrMap :: (P.Eq a) => P.Eq (StrMap a) where
(==) m1 m2 = (isSubmap m1 m2) P.&& (isSubmap m2 m1)
(/=) m1 m2 = P.not (m1 P.== m2)
Expand All @@ -88,53 +164,39 @@ instance showStrMap :: (P.Show a) => P.Show (StrMap a) where
foreign import empty "var empty = {};" :: forall a. StrMap a

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

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

foreign import size "function size(m) {\
\ var s = 0;\
\ for (var k in m) {\
\ if (m.hasOwnProperty(k)) ++s;\
\ ++s;\
\ }\
\ return s;\
\}" :: forall a. StrMap a -> Number

singleton :: forall a. String -> a -> StrMap a
singleton k v = insert k v empty
singleton k v = pureST (do
s <- SM.new
SM.poke s k v
P.return s)

foreign import _lookup
"function _lookup(m, k, yes, no) { \
\ if (m[k] !== undefined) return yes(m[k]); \
\ else return no; \
\}" :: forall a z. Fn4 (StrMap a) String (a -> z) z z
"function _lookup(no, yes, k, m) {\
\ return k in m ? yes(m[k]) : no;\
\}" :: forall a z. Fn4 z (a -> z) String (StrMap a) z

lookup :: forall a. String -> StrMap a -> Maybe a
lookup k m = runFn4 _lookup m k Just Nothing
lookup = runFn4 _lookup Nothing Just

member :: forall a. String -> StrMap a -> Boolean
member k m = isJust (k `lookup` m)

foreign import _cloneStrMap
"function _cloneStrMap(m0) { \
\ var m = {}; \
\ for (var k in m0) {\
\ if (m0.hasOwnProperty(k)) m[k] = m0[k];\
\ }\
\ return m;\
\}" :: forall a. (StrMap a) -> (StrMap a)

foreign import _unsafeInsertStrMap
"function _unsafeInsertStrMap(m, k, v) { \
\ m[k] = v; \
\ return m; \
\}" :: forall a. Fn3 (StrMap a) String a (StrMap a)
member = runFn4 _lookup false (P.const true)

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

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

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

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

toList :: forall a. StrMap a -> [Tuple String a]
toList m = fold f [] m where
f acc k v = acc P.++ [Tuple k v]

fromList :: forall a. [Tuple String a] -> StrMap a
fromList = foldl (\m (Tuple k v) -> insert k v m) empty
fromList l = pureST (do
s <- SM.new
for_ l (\(Tuple k v) -> SM.poke s k v)
P.return s)

foreign import _collect
"function _collect(f) {\
\ return function (m) {\
\ var r = [];\
\ for (var k in m)\
\ r.push(f(k)(m[k]));\
\ return r;\
\ };\
\}" :: forall a b . (String -> a -> b) -> StrMap a -> [b]

keys :: forall a. StrMap a -> [String]
keys m = fold f [] m where
f acc k v = acc P.++ [k]
toList :: forall a. StrMap a -> [Tuple String a]
toList = _collect Tuple

foreign import keys
"var keys = Object.keys || _collect(function (k) {\
\ return function () { return k; };\
\});" :: forall a. StrMap a -> [String]

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

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

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

map :: forall a b. (a -> b) -> StrMap a -> StrMap b
map = P.(<$>)
map = P.(<$>)

instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a) where
(<>) m1 m2 = mutate (\s -> foldM (\s k v2 -> SM.poke s k (runFn4 _lookup v2 (\v1 -> v1 P.<> v2) k m2)) s m1) m2
Loading