From f4021fe480b8165bd177490cd2faed32b55042a4 Mon Sep 17 00:00:00 2001 From: "John A. De Goes" Date: Thu, 18 Sep 2014 08:33:21 -0600 Subject: [PATCH 001/125] added StrMap which is a Map implementation based on Javascript objects. the keys to the map must be strings --- Gruntfile.js | 2 +- README.md | 59 +++++++++++- bower.json | 4 +- src/Data/StrMap.purs | 178 +++++++++++++++++++++++++++++++++++ tests/Data/Map.purs | 205 +++++++++++++++++++++++++++++++++++++++++ tests/Data/StrMap.purs | 109 ++++++++++++++++++++++ tests/Tests.purs | 203 ++-------------------------------------- 7 files changed, 560 insertions(+), 200 deletions(-) create mode 100644 src/Data/StrMap.purs create mode 100644 tests/Data/Map.purs create mode 100644 tests/Data/StrMap.purs diff --git a/Gruntfile.js b/Gruntfile.js index 46f0f298..ce4d0063 100644 --- a/Gruntfile.js +++ b/Gruntfile.js @@ -29,7 +29,7 @@ module.exports = function(grunt) { module: "Tests", main: "Tests" }, - src: ["tests/Tests.purs", "<%=libFiles%>"], + src: ["tests/**/*.purs", "<%=libFiles%>"], dest: "tmp/tests.js" } }, diff --git a/README.md b/README.md index c9e0ad4d..ab33f1b4 100644 --- a/README.md +++ b/README.md @@ -126,4 +126,61 @@ union :: forall a. (P.Ord a) => Set a -> Set a -> Set a - unions :: forall a. (P.Ord a) => [Set a] -> Set a \ No newline at end of file + unions :: forall a. (P.Ord a) => [Set a] -> Set a + + +## Module Data.StrMap + +### Types + + data StrMap :: * -> * + + +### Type Class Instances + + instance eqStrMap :: (P.Eq a) => P.Eq (StrMap a) + + instance functorStrMap :: P.Functor StrMap + + instance showStrMap :: (P.Show a) => P.Show (StrMap a) + + +### Values + + alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a + + delete :: forall a. String -> StrMap a -> StrMap a + + empty :: forall a. StrMap a + + fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z + + foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z + + fromList :: forall a. [Tuple String a] -> StrMap a + + insert :: forall a. String -> a -> StrMap a -> StrMap a + + isEmpty :: forall a. StrMap a -> Boolean + + isSubmap :: forall a. (P.Eq a) => StrMap a -> StrMap a -> Boolean + + keys :: forall a. StrMap a -> [String] + + lookup :: forall a. String -> StrMap a -> Maybe a + + map :: forall a b. (a -> b) -> StrMap a -> StrMap b + + member :: forall a. String -> StrMap a -> Boolean + + singleton :: forall a. String -> a -> StrMap a + + toList :: forall a. StrMap a -> [Tuple String a] + + union :: forall a. StrMap a -> StrMap a -> StrMap a + + unions :: forall a. [StrMap a] -> StrMap a + + update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a + + values :: forall a. StrMap a -> [a] \ No newline at end of file diff --git a/bower.json b/bower.json index 99a00654..9ffb8877 100644 --- a/bower.json +++ b/bower.json @@ -2,7 +2,8 @@ "name": "purescript-maps", "homepage": "https://github.com/purescript/purescript-maps", "authors": [ - "Phil Freeman " + "Phil Freeman ", + "John A. De Goes " ], "description": "Purely functional maps implemented in PureScript", "keywords": [ @@ -27,6 +28,7 @@ "dependencies": { "purescript-arrays": "*", "purescript-foldable-traversable": "*", + "purescript-strings": "*", "purescript-math": "*", "purescript-maybe": "*", "purescript-tuples": "*" diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs new file mode 100644 index 00000000..7cf0f388 --- /dev/null +++ b/src/Data/StrMap.purs @@ -0,0 +1,178 @@ +-- +-- Native Javascript maps which require the keys to be strings. +-- To maximize performance, Javascript objects are not wrapped, +-- and some native code is used even when it's not necessary. +-- + +module Data.StrMap + ( StrMap(), + empty, + isEmpty, + singleton, + insert, + lookup, + toList, + fromList, + delete, + member, + alter, + update, + keys, + values, + union, + unions, + map, + isSubmap, + fold, + foldMaybe + ) where + +import qualified Prelude as P + +import qualified Data.Array as A +import Data.Maybe +import Data.Function +import Data.Tuple +import Data.Foldable (foldl) + +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 _fmapStrMap + "function _fmapStrMap(m0, f) {\ + \ var m = {};\ + \ for (var k in m0) {\ + \ if (m0.hasOwnProperty(k)) m[k] = f(m0[k]);\ + \ }\ + \ 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 _foldSCStrMap + "function _foldSCStrMap(m, z0, f, fromMaybe) { \ + \ var z = z0; \ + \ 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; \ + \ } \ + \ } \ + \ 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 f z m = runFn4 _foldSCStrMap m z f fromMaybe + +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) + +instance showStrMap :: (P.Show a) => P.Show (StrMap a) where + show m = "fromList " P.++ P.show (toList m) + +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)) + +isEmpty :: forall a. StrMap a -> Boolean +isEmpty m = size m P.== 0 + +foreign import size "function size(m) {\ + \ var s = 0;\ + \ for (var k in m) {\ + \ if (m.hasOwnProperty(k)) ++s;\ + \ }\ + \ return s;\ + \}" :: forall a. StrMap a -> Number + +singleton :: forall a. String -> a -> StrMap a +singleton k v = insert k v empty + +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 + +lookup :: forall a. String -> StrMap a -> Maybe a +lookup k m = runFn4 _lookup m k Just Nothing + +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) + +insert :: forall a. String -> a -> StrMap a -> StrMap a +insert k v m = runFn3 _unsafeInsertStrMap (_cloneStrMap m) k v + +foreign import _unsafeDeleteStrMap + "function _unsafeDeleteStrMap(m, k) { \ + \ delete m[k]; \ + \ return m; \ + \}" :: forall a. Fn2 (StrMap a) String (StrMap a) + +delete :: forall a. String -> StrMap a -> StrMap a +delete k m = runFn2 _unsafeDeleteStrMap (_cloneStrMap m) k + +alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a +alter f k m = case f (k `lookup` m) of + Nothing -> delete k m + Just v -> insert k v m + +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 + +keys :: forall a. StrMap a -> [String] +keys m = fold f [] m where + f acc k v = acc P.++ [k] + +values :: forall a. StrMap a -> [a] +values m = fold f [] m where + f acc k v = acc P.++ [v] + +union :: forall a. StrMap a -> StrMap a -> StrMap a +union m1 m2 = foldl (\m (Tuple k v) -> insert k v m) m2 (toList m1) + +unions :: forall a. [StrMap a] -> StrMap a +unions = foldl union empty + +map :: forall a b. (a -> b) -> StrMap a -> StrMap b +map = P.(<$>) \ No newline at end of file diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs new file mode 100644 index 00000000..6d5e315b --- /dev/null +++ b/tests/Data/Map.purs @@ -0,0 +1,205 @@ +module Tests.Data.Map where + +import Debug.Trace + +import Data.Maybe +import Data.Tuple +import Data.Array (map) +import Data.Function (on) +import Data.Foldable (foldl) + +import Test.QuickCheck +import Test.QuickCheck.Tuple + +import qualified Data.Map as M +import qualified Data.Set as S + +instance arbMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (M.Map k v) where + arbitrary = M.fromList <<< map runTestTuple <$> arbitrary + +instance arbSet :: (Eq a, Ord a, Arbitrary a) => Arbitrary (S.Set a) where + arbitrary = S.fromList <$> arbitrary + +data SmallKey = A | B | C | D | E | F | G | H | I | J + +instance showSmallKey :: Show SmallKey where + show A = "A" + show B = "B" + show C = "C" + show D = "D" + show E = "E" + show F = "F" + show G = "G" + show H = "H" + show I = "I" + show J = "J" + +instance eqSmallKey :: Eq SmallKey where + (==) A A = true + (==) B B = true + (==) C C = true + (==) D D = true + (==) E E = true + (==) F F = true + (==) G G = true + (==) H H = true + (==) I I = true + (==) J J = true + (==) _ _ = false + (/=) x y = not (x == y) + +smallKeyToNumber :: SmallKey -> Number +smallKeyToNumber A = 0 +smallKeyToNumber B = 1 +smallKeyToNumber C = 2 +smallKeyToNumber D = 3 +smallKeyToNumber E = 4 +smallKeyToNumber F = 5 +smallKeyToNumber G = 6 +smallKeyToNumber H = 7 +smallKeyToNumber I = 8 +smallKeyToNumber J = 9 + +instance ordSmallKey :: Ord SmallKey where + compare = compare `on` smallKeyToNumber + +instance arbSmallKey :: Arbitrary SmallKey where + arbitrary = do + n <- arbitrary + return case n of + _ | n < 0.1 -> A + _ | n < 0.2 -> B + _ | n < 0.3 -> C + _ | n < 0.4 -> D + _ | n < 0.5 -> E + _ | n < 0.6 -> F + _ | n < 0.7 -> G + _ | n < 0.8 -> H + _ | n < 0.9 -> I + _ -> J + +data Instruction k v = Insert k v | Delete k + +instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where + show (Insert k v) = "Insert (" ++ show k ++ ") (" ++ show v ++ ")" + show (Delete k) = "Delete (" ++ show k ++ ")" + +instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k v) where + arbitrary = do + b <- arbitrary + case b of + true -> do + k <- arbitrary + v <- arbitrary + return (Insert k v) + false -> do + k <- arbitrary + return (Delete k) + +runInstructions :: forall k v. (Ord k) => [Instruction k v] -> M.Map k v -> M.Map k v +runInstructions instrs t0 = foldl step t0 instrs + where + step tree (Insert k v) = M.insert k v tree + step tree (Delete k) = M.delete k tree + +smallKey :: SmallKey -> SmallKey +smallKey k = k + +number :: Number -> Number +number n = n + +mapTests = do + + -- Data.Map + + trace "Test inserting into empty tree" + quickCheck $ \k v -> M.lookup (smallKey k) (M.insert k v M.empty) == Just (number v) + ("k: " ++ show k ++ ", v: " ++ show v) + + trace "Test delete after inserting" + quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) + ("k: " ++ show k ++ ", v: " ++ show v) + + trace "Insert two, lookup first" + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 + ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + + trace "Insert two, lookup second" + quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v2 + ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + + trace "Insert two, delete one" + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty))) == Just v2 + ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + + trace "Check balance property" + quickCheck' 5000 $ \instrs -> + let + tree :: M.Map SmallKey Number + tree = runInstructions instrs M.empty + in M.checkValid tree ("Map not balanced:\n " ++ show tree ++ "\nGenerated by:\n " ++ show instrs) + + trace "Lookup from empty" + quickCheck $ \k -> M.lookup k (M.empty :: M.Map SmallKey Number) == Nothing + + trace "Lookup from singleton" + quickCheck $ \k v -> M.lookup (k :: SmallKey) (M.singleton k (v :: Number)) == Just v + + trace "Random lookup" + quickCheck' 5000 $ \instrs k v -> + let + tree :: M.Map SmallKey Number + tree = M.insert k v (runInstructions instrs M.empty) + in M.lookup k tree == Just v ("instrs:\n " ++ show instrs ++ "\nk:\n " ++ show k ++ "\nv:\n " ++ show v) + + trace "Singleton to list" + quickCheck $ \k v -> M.toList (M.singleton k v :: M.Map SmallKey Number) == [Tuple k v] + + trace "toList . fromList = id" + quickCheck $ \arr -> let f x = M.toList (M.fromList x) + arr' = runTestTuple <$> arr + in f (f arr') == f (arr' :: [Tuple SmallKey Number]) show arr + + trace "fromList . toList = id" + quickCheck $ \m -> let f m = M.fromList (M.toList m) in + M.toList (f m) == M.toList (m :: M.Map SmallKey Number) show m + + trace "Lookup from union" + quickCheck $ \m1 m2 k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of + Nothing -> M.lookup k m2 + Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) + + trace "Union is idempotent" + quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Number)) + + -- Data.Set + + trace "testMemberEmpty: member _ empty == false" + quickCheck $ \a -> S.member a (S.empty :: S.Set SmallKey) == false + + trace "testMemberSingleton: member a (singleton a) == true" + quickCheck $ \a -> S.member (a :: SmallKey) (S.singleton a) == true + + trace "testInsertDelete: member a (delete a (insert a empty) == false)" + quickCheck $ \a -> (S.member (a :: SmallKey) $ + S.delete a $ + S.insert a S.empty) == false + + trace "testSingletonToList: toList (singleton a) == [a]" + quickCheck $ \a -> S.toList (S.singleton a :: S.Set SmallKey) == [a] + + trace "testToListFromList: toList . fromList = id" + quickCheck $ \arr -> let f x = S.toList (S.fromList x) in + f (f arr) == f (arr :: [SmallKey]) + + trace "testFromListToList: fromList . toList = id" + quickCheck $ \s -> let f s = S.fromList (S.toList s) in + S.toList (f s) == S.toList (s :: S.Set SmallKey) + + trace "testUnionSymmetric: union s1 s2 == union s2 s1" + quickCheck $ \s1 s2 -> let s3 = s1 `S.union` (s2 :: S.Set SmallKey) in + let s4 = s2 `S.union` s1 in + S.toList s3 == S.toList s4 + + trace "testUnionIdempotent" + quickCheck $ \s1 s2 -> (s1 `S.union` s2) == ((s1 `S.union` s2) `S.union` (s2 :: S.Set SmallKey)) diff --git a/tests/Data/StrMap.purs b/tests/Data/StrMap.purs new file mode 100644 index 00000000..60cea612 --- /dev/null +++ b/tests/Data/StrMap.purs @@ -0,0 +1,109 @@ +module Tests.Data.StrMap where + +import Debug.Trace + +import Data.Maybe +import Data.Tuple +import qualified Data.String as S +import Data.Array (map) +import Data.Function (on) +import Data.Foldable (foldl) + +import Test.QuickCheck +import Test.QuickCheck.Tuple + +import qualified Data.StrMap as M + +instance arbStrMap :: (Arbitrary v) => Arbitrary (M.StrMap v) where + arbitrary = M.fromList <<< map runTestTuple <$> arbitrary + +type SmallKey = String + +instance arbSmallKey :: Arbitrary String where + arbitrary = do + nums <- arbitrary + return $ S.joinWith "" (S.fromCharCode <$> nums) + +data Instruction k v = Insert k v | Delete k + +instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where + show (Insert k v) = "Insert (" ++ show k ++ ") (" ++ show v ++ ")" + show (Delete k) = "Delete (" ++ show k ++ ")" + +instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where + arbitrary = do + b <- arbitrary + case b of + true -> do + k <- arbitrary + v <- arbitrary + return (Insert k v) + false -> do + k <- arbitrary + return (Delete k) + +runInstructions :: forall v. [Instruction String v] -> M.StrMap v -> M.StrMap v +runInstructions instrs t0 = foldl step t0 instrs + where + step tree (Insert k v) = M.insert k v tree + step tree (Delete k) = M.delete k tree + +smallKey :: SmallKey -> SmallKey +smallKey k = k + +number :: Number -> Number +number n = n + +strMapTests = do + trace "Test inserting into empty tree" + quickCheck $ \k v -> M.lookup (smallKey k) (M.insert k v M.empty) == Just (number v) + ("k: " ++ show k ++ ", v: " ++ show v) + + trace "Test delete after inserting" + quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) + ("k: " ++ show k ++ ", v: " ++ show v) + + trace "Insert two, lookup first" + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 + ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + + trace "Insert two, lookup second" + quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v2 + ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + + trace "Insert two, delete one" + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty))) == Just v2 + ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + + trace "Lookup from empty" + quickCheck $ \k -> M.lookup k (M.empty :: M.StrMap Number) == Nothing + + trace "Lookup from singleton" + quickCheck $ \k v -> M.lookup (k :: SmallKey) (M.singleton k (v :: Number)) == Just v + + trace "Random lookup" + quickCheck' 5000 $ \instrs k v -> + let + tree :: M.StrMap Number + tree = M.insert k v (runInstructions instrs M.empty) + in M.lookup k tree == Just v ("instrs:\n " ++ show instrs ++ "\nk:\n " ++ show k ++ "\nv:\n " ++ show v) + + trace "Singleton to list" + quickCheck $ \k v -> M.toList (M.singleton k v :: M.StrMap Number) == [Tuple k v] + + trace "toList . fromList = id" + quickCheck $ \arr -> let f x = M.toList (M.fromList x) + arr' = runTestTuple <$> arr + in f (f arr') == f (arr' :: [Tuple SmallKey Number]) show arr + + trace "fromList . toList = id" + quickCheck $ \m -> let f m = M.fromList (M.toList m) in + M.toList (f m) == M.toList (m :: M.StrMap Number) show m + + trace "Lookup from union" + quickCheck $ \m1 m2 k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of + Nothing -> M.lookup k m2 + Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) + + trace "Union is idempotent" + quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Number)) \ No newline at end of file diff --git a/tests/Tests.purs b/tests/Tests.purs index e1052de5..701e2286 100644 --- a/tests/Tests.purs +++ b/tests/Tests.purs @@ -1,205 +1,14 @@ module Tests where import Debug.Trace - -import Data.Maybe -import Data.Tuple -import Data.Array (map) -import Data.Function (on) -import Data.Foldable (foldl) - import Test.QuickCheck -import Test.QuickCheck.Tuple - -import qualified Data.Map as M -import qualified Data.Set as S - -instance arbMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (M.Map k v) where - arbitrary = M.fromList <<< map runTestTuple <$> arbitrary - -instance arbSet :: (Eq a, Ord a, Arbitrary a) => Arbitrary (S.Set a) where - arbitrary = S.fromList <$> arbitrary - -data SmallKey = A | B | C | D | E | F | G | H | I | J - -instance showSmallKey :: Show SmallKey where - show A = "A" - show B = "B" - show C = "C" - show D = "D" - show E = "E" - show F = "F" - show G = "G" - show H = "H" - show I = "I" - show J = "J" - -instance eqSmallKey :: Eq SmallKey where - (==) A A = true - (==) B B = true - (==) C C = true - (==) D D = true - (==) E E = true - (==) F F = true - (==) G G = true - (==) H H = true - (==) I I = true - (==) J J = true - (==) _ _ = false - (/=) x y = not (x == y) - -smallKeyToNumber :: SmallKey -> Number -smallKeyToNumber A = 0 -smallKeyToNumber B = 1 -smallKeyToNumber C = 2 -smallKeyToNumber D = 3 -smallKeyToNumber E = 4 -smallKeyToNumber F = 5 -smallKeyToNumber G = 6 -smallKeyToNumber H = 7 -smallKeyToNumber I = 8 -smallKeyToNumber J = 9 -instance ordSmallKey :: Ord SmallKey where - compare = compare `on` smallKeyToNumber - -instance arbSmallKey :: Arbitrary SmallKey where - arbitrary = do - n <- arbitrary - return case n of - _ | n < 0.1 -> A - _ | n < 0.2 -> B - _ | n < 0.3 -> C - _ | n < 0.4 -> D - _ | n < 0.5 -> E - _ | n < 0.6 -> F - _ | n < 0.7 -> G - _ | n < 0.8 -> H - _ | n < 0.9 -> I - _ -> J - -data Instruction k v = Insert k v | Delete k - -instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where - show (Insert k v) = "Insert (" ++ show k ++ ") (" ++ show v ++ ")" - show (Delete k) = "Delete (" ++ show k ++ ")" - -instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k v) where - arbitrary = do - b <- arbitrary - case b of - true -> do - k <- arbitrary - v <- arbitrary - return (Insert k v) - false -> do - k <- arbitrary - return (Delete k) - -runInstructions :: forall k v. (Ord k) => [Instruction k v] -> M.Map k v -> M.Map k v -runInstructions instrs t0 = foldl step t0 instrs - where - step tree (Insert k v) = M.insert k v tree - step tree (Delete k) = M.delete k tree - -smallKey :: SmallKey -> SmallKey -smallKey k = k - -number :: Number -> Number -number n = n +import Tests.Data.Map (mapTests) +import Tests.Data.StrMap (strMapTests) main = do - - -- Data.Map - - trace "Test inserting into empty tree" - quickCheck $ \k v -> M.lookup (smallKey k) (M.insert k v M.empty) == Just (number v) - ("k: " ++ show k ++ ", v: " ++ show v) - - trace "Test delete after inserting" - quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) - ("k: " ++ show k ++ ", v: " ++ show v) - - trace "Insert two, lookup first" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 - ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - - trace "Insert two, lookup second" - quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v2 - ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - - trace "Insert two, delete one" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty))) == Just v2 - ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - - trace "Check balance property" - quickCheck' 5000 $ \instrs -> - let - tree :: M.Map SmallKey Number - tree = runInstructions instrs M.empty - in M.checkValid tree ("Map not balanced:\n " ++ show tree ++ "\nGenerated by:\n " ++ show instrs) - - trace "Lookup from empty" - quickCheck $ \k -> M.lookup k (M.empty :: M.Map SmallKey Number) == Nothing - - trace "Lookup from singleton" - quickCheck $ \k v -> M.lookup (k :: SmallKey) (M.singleton k (v :: Number)) == Just v - - trace "Random lookup" - quickCheck' 5000 $ \instrs k v -> - let - tree :: M.Map SmallKey Number - tree = M.insert k v (runInstructions instrs M.empty) - in M.lookup k tree == Just v ("instrs:\n " ++ show instrs ++ "\nk:\n " ++ show k ++ "\nv:\n " ++ show v) - - trace "Singleton to list" - quickCheck $ \k v -> M.toList (M.singleton k v :: M.Map SmallKey Number) == [Tuple k v] - - trace "toList . fromList = id" - quickCheck $ \arr -> let f x = M.toList (M.fromList x) - arr' = runTestTuple <$> arr - in f (f arr') == f (arr' :: [Tuple SmallKey Number]) show arr - - trace "fromList . toList = id" - quickCheck $ \m -> let f m = M.fromList (M.toList m) in - M.toList (f m) == M.toList (m :: M.Map SmallKey Number) show m - - trace "Lookup from union" - quickCheck $ \m1 m2 k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of - Nothing -> M.lookup k m2 - Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) - - trace "Union is idempotent" - quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Number)) - - -- Data.Set - - trace "testMemberEmpty: member _ empty == false" - quickCheck $ \a -> S.member a (S.empty :: S.Set SmallKey) == false - - trace "testMemberSingleton: member a (singleton a) == true" - quickCheck $ \a -> S.member (a :: SmallKey) (S.singleton a) == true - - trace "testInsertDelete: member a (delete a (insert a empty) == false)" - quickCheck $ \a -> (S.member (a :: SmallKey) $ - S.delete a $ - S.insert a S.empty) == false - - trace "testSingletonToList: toList (singleton a) == [a]" - quickCheck $ \a -> S.toList (S.singleton a :: S.Set SmallKey) == [a] - - trace "testToListFromList: toList . fromList = id" - quickCheck $ \arr -> let f x = S.toList (S.fromList x) in - f (f arr) == f (arr :: [SmallKey]) - - trace "testFromListToList: fromList . toList = id" - quickCheck $ \s -> let f s = S.fromList (S.toList s) in - S.toList (f s) == S.toList (s :: S.Set SmallKey) - - trace "testUnionSymmetric: union s1 s2 == union s2 s1" - quickCheck $ \s1 s2 -> let s3 = s1 `S.union` (s2 :: S.Set SmallKey) in - let s4 = s2 `S.union` s1 in - S.toList s3 == S.toList s4 + trace "Running Map tests" + mapTests - trace "testUnionIdempotent" - quickCheck $ \s1 s2 -> (s1 `S.union` s2) == ((s1 `S.union` s2) `S.union` (s2 :: S.Set SmallKey)) + trace "Running StrMap tests" + strMapTests From 7213be82bea7e1d332d47b3a08b81d017fa70781 Mon Sep 17 00:00:00 2001 From: Dylan Simon Date: Sat, 11 Oct 2014 11:05:52 -0400 Subject: [PATCH 002/125] Improvements for StrMap: optimizations, add unsafeIndex, size, foldM, foldMap, Semigroup instance Since we know that all StrMap objects have prototype Object, we know they have no additional enumerable keys, so hasOwnProperty checks are unnecessary. Add efficient JS implementations for keys and values. Add standard Monoid and Monad fold functions, and use them internally. Minor other changes to eliminate unnecessary function layers and variables. Fix and update tests. --- README.md | 19 ++++- src/Data/StrMap.purs | 138 ++++++++++++++++++++++++------------ src/Data/StrMap/Unsafe.purs | 13 ++++ tests/Data/StrMap.purs | 34 ++++----- 4 files changed, 136 insertions(+), 68 deletions(-) create mode 100644 src/Data/StrMap/Unsafe.purs diff --git a/README.md b/README.md index ab33f1b4..3cb7b473 100644 --- a/README.md +++ b/README.md @@ -142,11 +142,15 @@ 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 @@ -155,6 +159,10 @@ 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 fromList :: forall a. [Tuple String a] -> StrMap a @@ -175,6 +183,8 @@ singleton :: forall a. String -> a -> StrMap a + size :: forall a. StrMap a -> Number + toList :: forall a. StrMap a -> [Tuple String a] union :: forall a. StrMap a -> StrMap a -> StrMap a @@ -183,4 +193,11 @@ update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a - values :: forall a. StrMap a -> [a] \ No newline at end of file + values :: forall a. StrMap a -> [a] + + +## Module Data.StrMap.Unsafe + +### Values + + unsafeIndex :: forall a. StrMap a -> String -> a diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 7cf0f388..0bdeba60 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -8,6 +8,7 @@ module Data.StrMap ( StrMap(), empty, isEmpty, + size, singleton, insert, lookup, @@ -24,7 +25,10 @@ module Data.StrMap map, isSubmap, fold, - foldMaybe + foldMap, + foldM, + foldMaybe, + all ) where import qualified Prelude as P @@ -34,26 +38,16 @@ import Data.Maybe import Data.Function import Data.Tuple import Data.Foldable (foldl) +import Data.Monoid +import Data.Monoid.All 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 _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]);\ \ }\ \ return m;\ \}" :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b) @@ -61,23 +55,60 @@ foreign import _fmapStrMap instance functorStrMap :: P.Functor StrMap where (<$>) f m = runFn2 _fmapStrMap m f +-- It would be nice to have a Foldable instance, but we're essentially unordered + +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) + +-- 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) @@ -88,17 +119,16 @@ 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 @@ -107,22 +137,21 @@ singleton :: forall a. String -> a -> StrMap a singleton k v = insert k v empty 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) +member = runFn4 _lookup false (P.const true) foreign import _cloneStrMap "function _cloneStrMap(m0) { \ \ var m = {}; \ \ for (var k in m0) {\ - \ if (m0.hasOwnProperty(k)) m[k] = m0[k];\ + \ m[k] = m0[k];\ \ }\ \ return m;\ \}" :: forall a. (StrMap a) -> (StrMap a) @@ -133,8 +162,11 @@ foreign import _unsafeInsertStrMap \ return m; \ \}" :: forall a. Fn3 (StrMap a) String a (StrMap a) +_unsafeInsert :: forall a. StrMap a -> String -> a -> StrMap a +_unsafeInsert = runFn3 _unsafeInsertStrMap + insert :: forall a. String -> a -> StrMap a -> StrMap a -insert k v m = runFn3 _unsafeInsertStrMap (_cloneStrMap m) k v +insert k v m = _unsafeInsert (_cloneStrMap m) k v foreign import _unsafeDeleteStrMap "function _unsafeDeleteStrMap(m, k) { \ @@ -153,26 +185,40 @@ 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 +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] + toList :: forall a. StrMap a -> [Tuple String a] -toList m = fold f [] m where - f acc k v = acc P.++ [Tuple k v] +toList = _collect Tuple fromList :: forall a. [Tuple String a] -> StrMap a -fromList = foldl (\m (Tuple k v) -> insert k v m) empty +fromList = foldl (\m (Tuple k v) -> _unsafeInsert m k v) (_cloneStrMap empty) -keys :: forall a. StrMap a -> [String] -keys m = fold f [] m where - f acc k v = acc P.++ [k] +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 m1 m2 = fold _unsafeInsert (_cloneStrMap m2) m1 unions :: forall a. [StrMap a] -> StrMap a unions = foldl union empty map :: forall a b. (a -> b) -> StrMap a -> StrMap b -map = P.(<$>) \ No newline at end of file +map = P.(<$>) + +instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a) where + (<>) m1 m2 = fold f (_cloneStrMap m1) m2 where + f m k v2 = _unsafeInsert m k (runFn4 _lookup v2 (\v1 -> v1 P.<> v2) k m) diff --git a/src/Data/StrMap/Unsafe.purs b/src/Data/StrMap/Unsafe.purs new file mode 100644 index 00000000..96a6941c --- /dev/null +++ b/src/Data/StrMap/Unsafe.purs @@ -0,0 +1,13 @@ +module Data.StrMap.Unsafe + ( unsafeIndex + ) where + +import Data.StrMap + +-- also known as (!) +foreign import unsafeIndex + "function unsafeIndex(m) { \ + \ return function (k) {\ + \ return m[k];\ + \ };\ + \}" :: forall a . StrMap a -> String -> a diff --git a/tests/Data/StrMap.purs b/tests/Data/StrMap.purs index 60cea612..fe6d29ed 100644 --- a/tests/Data/StrMap.purs +++ b/tests/Data/StrMap.purs @@ -17,13 +17,6 @@ import qualified Data.StrMap as M instance arbStrMap :: (Arbitrary v) => Arbitrary (M.StrMap v) where arbitrary = M.fromList <<< map runTestTuple <$> arbitrary -type SmallKey = String - -instance arbSmallKey :: Arbitrary String where - arbitrary = do - nums <- arbitrary - return $ S.joinWith "" (S.fromCharCode <$> nums) - data Instruction k v = Insert k v | Delete k instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where @@ -33,13 +26,12 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where arbitrary = do b <- arbitrary + k <- arbitrary case b of true -> do - k <- arbitrary v <- arbitrary return (Insert k v) false -> do - k <- arbitrary return (Delete k) runInstructions :: forall v. [Instruction String v] -> M.StrMap v -> M.StrMap v @@ -48,38 +40,35 @@ runInstructions instrs t0 = foldl step t0 instrs step tree (Insert k v) = M.insert k v tree step tree (Delete k) = M.delete k tree -smallKey :: SmallKey -> SmallKey -smallKey k = k - number :: Number -> Number number n = n strMapTests = do trace "Test inserting into empty tree" - quickCheck $ \k v -> M.lookup (smallKey k) (M.insert k v M.empty) == Just (number v) + quickCheck $ \k v -> M.lookup k (M.insert k v M.empty) == Just (number v) ("k: " ++ show k ++ ", v: " ++ show v) trace "Test delete after inserting" - quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) + quickCheck $ \k v -> M.isEmpty (M.delete k (M.insert k (number v) M.empty)) ("k: " ++ show k ++ ", v: " ++ show v) trace "Insert two, lookup first" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v1 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) trace "Insert two, lookup second" - quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v2 + quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) trace "Insert two, delete one" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty))) == Just v2 + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty))) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) trace "Lookup from empty" quickCheck $ \k -> M.lookup k (M.empty :: M.StrMap Number) == Nothing trace "Lookup from singleton" - quickCheck $ \k v -> M.lookup (k :: SmallKey) (M.singleton k (v :: Number)) == Just v + quickCheck $ \k v -> M.lookup k (M.singleton k (v :: Number)) == Just v trace "Random lookup" quickCheck' 5000 $ \instrs k v -> @@ -94,16 +83,19 @@ strMapTests = do trace "toList . fromList = id" quickCheck $ \arr -> let f x = M.toList (M.fromList x) arr' = runTestTuple <$> arr - in f (f arr') == f (arr' :: [Tuple SmallKey Number]) show arr + in f (f arr') == f (arr' :: [Tuple String Number]) show arr trace "fromList . toList = id" quickCheck $ \m -> let f m = M.fromList (M.toList m) in M.toList (f m) == M.toList (m :: M.StrMap Number) show m trace "Lookup from union" - quickCheck $ \m1 m2 k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of + quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 m2) == (case M.lookup k m1 of Nothing -> M.lookup k m2 Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) trace "Union is idempotent" - quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Number)) \ No newline at end of file + quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Number)) (show (M.size (m1 `M.union` m2)) ++ " != " ++ show (M.size ((m1 `M.union` m2) `M.union` m2))) + + trace "toList = zip keys values" + quickCheck $ \m -> M.toList m == zip (M.keys m) (M.values m :: [Number]) From b8bbc62b129c1f7035ec17636f5d0e0f32515870 Mon Sep 17 00:00:00 2001 From: Dylan Simon Date: Sat, 11 Oct 2014 17:03:14 -0400 Subject: [PATCH 003/125] Basic STStrMap, allowing efficient mutation of records --- README.md | 35 +++++++++++++- src/Data/StrMap/ST.purs | 86 ++++++++++++++++++++++++++++++++++ src/Data/StrMap/ST/Unsafe.purs | 17 +++++++ 3 files changed, 137 insertions(+), 1 deletion(-) create mode 100644 src/Data/StrMap/ST.purs create mode 100644 src/Data/StrMap/ST/Unsafe.purs diff --git a/README.md b/README.md index 3cb7b473..87ff6be0 100644 --- a/README.md +++ b/README.md @@ -196,8 +196,41 @@ 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) + + freeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (SM.StrMap a) + + isEmpty :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Boolean + + 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) (Maybe a) + + poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) a + + size :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Number + + thaw :: forall a h r. SM.StrMap a -> Eff (st :: ST h | r) (STStrMap h a) + + +## Module Data.StrMap.ST.Unsafe + +### Values + + unsafePeek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a + + ## Module Data.StrMap.Unsafe ### Values - unsafeIndex :: forall a. StrMap a -> String -> a + unsafeIndex :: forall a. StrMap a -> String -> a \ No newline at end of file diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs new file mode 100644 index 00000000..57ad2898 --- /dev/null +++ b/src/Data/StrMap/ST.purs @@ -0,0 +1,86 @@ +module Data.StrMap.ST + ( STStrMap() + , new + , freeze + , thaw + , isEmpty + , peek + , size + , poke + , delete + ) where + +import Control.Monad.Eff +import Control.Monad.ST +import Data.Maybe + +import qualified Data.StrMap as SM + +foreign import data STStrMap :: * -> * -> * + +foreign import _new """ + function _new() { + return {}; + }""" :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) + +new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) +new = _new + +foreign import _copy """ + function _copy(m) { + return function () { + var r = {}; + for (var k in m) + r[k] = m[k]; + return r; + }; + }""" :: forall a b h r. a -> Eff (st :: ST h | r) b + +thaw :: forall a h r. SM.StrMap a -> Eff (st :: ST h | r) (STStrMap h a) +thaw = _copy + +freeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (SM.StrMap a) +freeze = _copy + +foreign import _unST """ + function _unST(m) { + return m; + }""" :: forall a h. STStrMap h a -> SM.StrMap a + +isEmpty :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Boolean +isEmpty m = return (SM.isEmpty (_unST m)) + +peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (Maybe a) +peek m k = return (SM.lookup k (_unST m)) + +size :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Number +size m = return (SM.size (_unST m)) + +foreign import poke """ + function poke(m) { + return function (k) { + return function (v) { + return function () { + return m[k] = v; + }; + }; + }; + }""" :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) a + +foreign import _delete """ + function _delete(m) { + return function (k) { + return function () { + delete m[k]; + return m; + }; + }; + }""" :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) + +delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) +delete = _delete + +foreign import run """ + function run(f) { + return f; + }""" :: forall a r. (forall h. Eff (st :: ST h | r) (STStrMap h a)) -> Eff r (SM.StrMap a) diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs new file mode 100644 index 00000000..15115ef9 --- /dev/null +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -0,0 +1,17 @@ +module Data.StrMap.ST.Unsafe + ( unsafePeek + ) where + +import Control.Monad.Eff +import Control.Monad.ST +import Data.StrMap.Unsafe +import Data.StrMap.ST + +foreign import unsafePeek """ + function unsafePeek(m) { + return function (k) { + return function () { + return m[k]; + } + } + }""" :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a From 3668e602236c808682986729446a51f310106610 Mon Sep 17 00:00:00 2001 From: Dylan Simon Date: Sat, 11 Oct 2014 23:55:56 -0400 Subject: [PATCH 004/125] Remove deprecated arb-instances dependency --- bower.json | 3 +-- tests/Data/Map.purs | 6 ++---- tests/Data/StrMap.purs | 6 ++---- 3 files changed, 5 insertions(+), 10 deletions(-) diff --git a/bower.json b/bower.json index 9ffb8877..b82ec1f4 100644 --- a/bower.json +++ b/bower.json @@ -22,8 +22,7 @@ "package.json" ], "devDependencies": { - "purescript-quickcheck": "*", - "purescript-arb-instances": "*" + "purescript-quickcheck": "*" }, "dependencies": { "purescript-arrays": "*", diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index 6d5e315b..f69d4962 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -9,13 +9,12 @@ import Data.Function (on) import Data.Foldable (foldl) import Test.QuickCheck -import Test.QuickCheck.Tuple import qualified Data.Map as M import qualified Data.Set as S instance arbMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (M.Map k v) where - arbitrary = M.fromList <<< map runTestTuple <$> arbitrary + arbitrary = M.fromList <$> arbitrary instance arbSet :: (Eq a, Ord a, Arbitrary a) => Arbitrary (S.Set a) where arbitrary = S.fromList <$> arbitrary @@ -157,8 +156,7 @@ mapTests = do trace "toList . fromList = id" quickCheck $ \arr -> let f x = M.toList (M.fromList x) - arr' = runTestTuple <$> arr - in f (f arr') == f (arr' :: [Tuple SmallKey Number]) show arr + in f (f arr) == f (arr :: [Tuple SmallKey Number]) show arr trace "fromList . toList = id" quickCheck $ \m -> let f m = M.fromList (M.toList m) in diff --git a/tests/Data/StrMap.purs b/tests/Data/StrMap.purs index fe6d29ed..8752497e 100644 --- a/tests/Data/StrMap.purs +++ b/tests/Data/StrMap.purs @@ -10,12 +10,11 @@ import Data.Function (on) import Data.Foldable (foldl) import Test.QuickCheck -import Test.QuickCheck.Tuple import qualified Data.StrMap as M instance arbStrMap :: (Arbitrary v) => Arbitrary (M.StrMap v) where - arbitrary = M.fromList <<< map runTestTuple <$> arbitrary + arbitrary = M.fromList <$> arbitrary data Instruction k v = Insert k v | Delete k @@ -82,8 +81,7 @@ strMapTests = do trace "toList . fromList = id" quickCheck $ \arr -> let f x = M.toList (M.fromList x) - arr' = runTestTuple <$> arr - in f (f arr') == f (arr' :: [Tuple String Number]) show arr + in f (f arr) == f (arr :: [Tuple String Number]) show arr trace "fromList . toList = id" quickCheck $ \m -> let f m = M.fromList (M.toList m) in From 354a34b53f5062227a1d3e9888b728e2883948d2 Mon Sep 17 00:00:00 2001 From: Dylan Simon Date: Sun, 12 Oct 2014 00:03:12 -0400 Subject: [PATCH 005/125] Add Foldable StrMap instance --- README.md | 2 ++ src/Data/StrMap.purs | 9 ++++++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 87ff6be0..6d238786 100644 --- a/README.md +++ b/README.md @@ -140,6 +140,8 @@ 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) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 0bdeba60..65924997 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -37,7 +37,7 @@ 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) import Data.Monoid import Data.Monoid.All @@ -55,8 +55,6 @@ foreign import _fmapStrMap instance functorStrMap :: P.Functor StrMap where (<$>) f m = runFn2 _fmapStrMap m f --- It would be nice to have a Foldable instance, but we're essentially unordered - foreign import _foldM "function _foldM(bind) {\ \ return function(f) {\ @@ -83,6 +81,11 @@ 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: From 1811044f554d09e58805aea41ed146210c05d669 Mon Sep 17 00:00:00 2001 From: Dylan Simon Date: Sun, 12 Oct 2014 15:28:39 -0400 Subject: [PATCH 006/125] 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). --- README.md | 20 ++++---- src/Data/StrMap.purs | 87 ++++++++++++++++++++++------------ src/Data/StrMap/ST.purs | 53 +++++---------------- src/Data/StrMap/ST/Unsafe.purs | 22 ++++----- 4 files changed, 88 insertions(+), 94 deletions(-) diff --git a/README.md b/README.md index 6d238786..04f69f27 100644 --- a/README.md +++ b/README.md @@ -167,6 +167,8 @@ 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 @@ -183,10 +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 @@ -209,26 +215,18 @@ delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) - freeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (SM.StrMap a) - - isEmpty :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Boolean - 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) (Maybe a) - - poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) a - - size :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Number + peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a - thaw :: forall a h r. SM.StrMap a -> Eff (st :: ST h | r) (STStrMap h 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 - unsafePeek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a + unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) ## Module Data.StrMap.Unsafe diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 65924997..108dddb7 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -28,21 +28,63 @@ module Data.StrMap foldMap, foldM, foldMaybe, - all + 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 (Foldable, foldl, foldr) +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 _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 = {};\ @@ -137,7 +179,10 @@ foreign import size "function size(m) {\ \}" :: 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(no, yes, k, m) {\ @@ -150,26 +195,8 @@ lookup = runFn4 _lookup Nothing Just member :: forall a. String -> StrMap a -> Boolean member = runFn4 _lookup false (P.const true) -foreign import _cloneStrMap - "function _cloneStrMap(m0) { \ - \ var m = {}; \ - \ for (var k in m0) {\ - \ 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) - -_unsafeInsert :: forall a. StrMap a -> String -> a -> StrMap a -_unsafeInsert = runFn3 _unsafeInsertStrMap - insert :: forall a. String -> a -> StrMap a -> StrMap a -insert k v m = _unsafeInsert (_cloneStrMap m) k v +insert k v = mutate (\s -> SM.poke s k v) foreign import _unsafeDeleteStrMap "function _unsafeDeleteStrMap(m, k) { \ @@ -178,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 @@ -188,6 +215,12 @@ 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 +fromList :: forall a. [Tuple String a] -> StrMap a +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) {\ @@ -201,9 +234,6 @@ foreign import _collect toList :: forall a. StrMap a -> [Tuple String a] toList = _collect Tuple -fromList :: forall a. [Tuple String a] -> StrMap a -fromList = foldl (\m (Tuple k v) -> _unsafeInsert m k v) (_cloneStrMap empty) - foreign import keys "var keys = Object.keys || _collect(function (k) {\ \ return function () { return k; };\ @@ -214,7 +244,7 @@ values = _collect (\_ v -> v) -- left-biased union :: forall a. StrMap a -> StrMap a -> StrMap a -union m1 m2 = fold _unsafeInsert (_cloneStrMap m2) m1 +union m = mutate (\s -> foldM SM.poke s m) unions :: forall a. [StrMap a] -> StrMap a unions = foldl union empty @@ -223,5 +253,4 @@ map :: forall a b. (a -> b) -> StrMap a -> StrMap b map = P.(<$>) instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a) where - (<>) m1 m2 = fold f (_cloneStrMap m1) m2 where - f m k v2 = _unsafeInsert m k (runFn4 _lookup v2 (\v1 -> v1 P.<> v2) k m) + (<>) m1 m2 = mutate (\s -> foldM (\s k v2 -> SM.poke s k (runFn4 _lookup v2 (\v1 -> v1 P.<> v2) k m2)) s m1) m2 diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs index 57ad2898..51df2708 100644 --- a/src/Data/StrMap/ST.purs +++ b/src/Data/StrMap/ST.purs @@ -1,11 +1,7 @@ module Data.StrMap.ST ( STStrMap() , new - , freeze - , thaw - , isEmpty , peek - , size , poke , delete ) where @@ -14,8 +10,6 @@ import Control.Monad.Eff import Control.Monad.ST import Data.Maybe -import qualified Data.StrMap as SM - foreign import data STStrMap :: * -> * -> * foreign import _new """ @@ -26,46 +20,26 @@ foreign import _new """ new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) new = _new -foreign import _copy """ - function _copy(m) { - return function () { - var r = {}; - for (var k in m) - r[k] = m[k]; - return r; - }; - }""" :: forall a b h r. a -> Eff (st :: ST h | r) b - -thaw :: forall a h r. SM.StrMap a -> Eff (st :: ST h | r) (STStrMap h a) -thaw = _copy - -freeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (SM.StrMap a) -freeze = _copy - -foreign import _unST """ - function _unST(m) { - return m; - }""" :: forall a h. STStrMap h a -> SM.StrMap a - -isEmpty :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Boolean -isEmpty m = return (SM.isEmpty (_unST m)) - -peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (Maybe a) -peek m k = return (SM.lookup k (_unST m)) - -size :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) Number -size m = return (SM.size (_unST m)) +foreign import peek """ + function peek(m) { + return function (k) { + return function () { + return m[k]; + } + } + }""" :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a foreign import poke """ function poke(m) { return function (k) { return function (v) { return function () { - return m[k] = v; + m[k] = v; + return m; }; }; }; - }""" :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) a + }""" :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) foreign import _delete """ function _delete(m) { @@ -79,8 +53,3 @@ foreign import _delete """ delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) delete = _delete - -foreign import run """ - function run(f) { - return f; - }""" :: forall a r. (forall h. Eff (st :: ST h | r) (STStrMap h a)) -> Eff r (SM.StrMap a) diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs index 15115ef9..19ced3ac 100644 --- a/src/Data/StrMap/ST/Unsafe.purs +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -1,17 +1,15 @@ module Data.StrMap.ST.Unsafe - ( unsafePeek + ( unsafeGet ) where -import Control.Monad.Eff -import Control.Monad.ST -import Data.StrMap.Unsafe -import Data.StrMap.ST +import Control.Monad.Eff (Eff()) +import Control.Monad.ST (ST()) +import Data.StrMap (StrMap()) +import Data.StrMap.ST (STStrMap()) -foreign import unsafePeek """ - function unsafePeek(m) { - return function (k) { - return function () { - return m[k]; - } +foreign import unsafeGet """ + function unsafeGet(m) { + return function () { + return m; } - }""" :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a + }""" :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) From 1463e5976ab3542d81e8269c126ce19bd61c0ae1 Mon Sep 17 00:00:00 2001 From: joneshf Date: Wed, 22 Oct 2014 07:55:15 -0700 Subject: [PATCH 007/125] Added Foldable/Traversable Instances. --- README.md | 14 +++++--- src/Data/Map.purs | 86 ++++++++++++++++++++++++-------------------- src/Data/StrMap.purs | 21 ++++++----- 3 files changed, 71 insertions(+), 50 deletions(-) diff --git a/README.md b/README.md index 04f69f27..3b36c20d 100644 --- a/README.md +++ b/README.md @@ -5,14 +5,14 @@ ### Types data Edge k where - Edge :: k -> k -> Edge k + Edge :: k -> k -> Edge data Graph k v where - Graph :: [v] -> [Edge k] -> Graph k v + Graph :: [v] -> [Edge k] -> Graph data SCC v where - AcyclicSCC :: v -> SCC v - CyclicSCC :: [v] -> SCC v + AcyclicSCC :: v -> SCC + CyclicSCC :: [v] -> SCC ### Type Class Instances @@ -46,10 +46,14 @@ instance eqMap :: (P.Eq k, P.Eq v) => P.Eq (Map k v) + instance foldableMap :: Foldable (Map k) + instance functorMap :: P.Functor (Map k) instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) + instance traversableMap :: (P.Ord k) => Traversable (Map k) + ### Values @@ -148,6 +152,8 @@ instance showStrMap :: (P.Show a) => P.Show (StrMap a) + instance traversableStrMap :: Traversable StrMap + ### Values diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 43f30e15..3b06f5e2 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -4,7 +4,7 @@ -- Based on http://www.cs.princeton.edu/~dpw/courses/cos326-12/ass/2-3-trees.pdf -- -module Data.Map +module Data.Map ( Map(), showTree, empty, @@ -25,15 +25,16 @@ module Data.Map unions, map ) where - + import qualified Prelude as P import qualified Data.Array as A -import Data.Maybe +import Data.Maybe import Data.Tuple -import Data.Foldable (foldl) - -data Map k v +import Data.Foldable (foldl, foldMap, foldr, Foldable) +import Data.Traversable (traverse, Traversable) + +data Map k v = Leaf | Two (Map k v) k v (Map k v) | Three (Map k v) k v (Map k v) k v (Map k v) @@ -43,29 +44,38 @@ instance eqMap :: (P.Eq k, P.Eq v) => P.Eq (Map k v) where (/=) m1 m2 = P.not (m1 P.== m2) instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) where - show m = "fromList " P.++ P.show (toList m) + show m = "fromList " P.++ P.show (toList m) instance functorMap :: P.Functor (Map k) where (<$>) _ Leaf = Leaf (<$>) f (Two left k v right) = Two (f P.<$> left) k (f v) (f P.<$> right) (<$>) f (Three left k1 v1 mid k2 v2 right) = Three (f P.<$> left) k1 (f v1) (f P.<$> mid) k2 (f v2) (f P.<$> right) - -showTree :: forall k v. (P.Show k, P.Show v) => Map k v -> String + +instance foldableMap :: Foldable (Map k) where + foldl f z m = foldl f z (values m) + foldr f z m = foldr f z (values m) + foldMap f m = foldMap f (values m) + +instance traversableMap :: (P.Ord k) => Traversable (Map k) where + traverse f ms = foldr (\x acc -> union P.<$> x P.<*> acc) (P.pure empty) ((P.(<$>) (uncurry singleton)) P.<$> (traverse f P.<$> toList ms)) + sequence = traverse P.id + +showTree :: forall k v. (P.Show k, P.Show v) => Map k v -> String showTree Leaf = "Leaf" -showTree (Two left k v right) = - "Two (" P.++ showTree left P.++ - ") (" P.++ P.show k P.++ - ") (" P.++ P.show v P.++ +showTree (Two left k v right) = + "Two (" P.++ showTree left P.++ + ") (" P.++ P.show k P.++ + ") (" P.++ P.show v P.++ ") (" P.++ showTree right P.++ ")" -showTree (Three left k1 v1 mid k2 v2 right) = - "Three (" P.++ showTree left P.++ - ") (" P.++ P.show k1 P.++ - ") (" P.++ P.show v1 P.++ +showTree (Three left k1 v1 mid k2 v2 right) = + "Three (" P.++ showTree left P.++ + ") (" P.++ P.show k1 P.++ + ") (" P.++ P.show v1 P.++ ") (" P.++ showTree mid P.++ - ") (" P.++ P.show k2 P.++ - ") (" P.++ P.show v2 P.++ + ") (" P.++ P.show k2 P.++ + ") (" P.++ P.show v2 P.++ ") (" P.++ showTree right P.++ ")" - + empty :: forall k v. Map k v empty = Leaf @@ -75,15 +85,15 @@ isEmpty _ = false singleton :: forall k v. k -> v -> Map k v singleton k v = Two Leaf k v Leaf - + checkValid :: forall k v. Map k v -> Boolean checkValid tree = A.length (A.nub (allHeights tree)) P.== 1 where allHeights :: forall k v. Map k v -> [Number] allHeights Leaf = [0] allHeights (Two left _ _ right) = A.map (\n -> n P.+ 1) (allHeights left P.++ allHeights right) - allHeights (Three left _ _ mid _ _ right) = A.map (\n -> n P.+ 1) (allHeights left P.++ allHeights mid P.++ allHeights right) - + allHeights (Three left _ _ mid _ _ right) = A.map (\n -> n P.+ 1) (allHeights left P.++ allHeights mid P.++ allHeights right) + lookup :: forall k v. (P.Ord k) => k -> Map k v -> Maybe v lookup _ Leaf = Nothing lookup k (Two _ k1 v _) | k P.== k1 = Just v @@ -104,7 +114,7 @@ data TreeContext k v | ThreeLeft k v (Map k v) k v (Map k v) | ThreeMiddle (Map k v) k v k v (Map k v) | ThreeRight (Map k v) k v (Map k v) k v - + fromZipper :: forall k v. (P.Ord k) => [TreeContext k v] -> Map k v -> Map k v fromZipper [] tree = tree fromZipper (TwoLeft k1 v1 right : ctx) left = fromZipper ctx (Two left k1 v1 right) @@ -112,7 +122,7 @@ fromZipper (TwoRight left k1 v1 : ctx) right = fromZipper ctx (Two left k1 v1 ri fromZipper (ThreeLeft k1 v1 mid k2 v2 right : ctx) left = fromZipper ctx (Three left k1 v1 mid k2 v2 right) fromZipper (ThreeMiddle left k1 v1 k2 v2 right : ctx) mid = fromZipper ctx (Three left k1 v1 mid k2 v2 right) fromZipper (ThreeRight left k1 v1 mid k2 v2 : ctx) right = fromZipper ctx (Three left k1 v1 mid k2 v2 right) - + data KickUp k v = KickUp (Map k v) k v (Map k v) insert :: forall k v. (P.Ord k) => k -> v -> Map k v -> Map k v @@ -127,30 +137,30 @@ insert = down [] down ctx k v (Three left k1 v1 mid k2 _ right) | k P.== k2 = fromZipper ctx (Three left k1 v1 mid k v right) down ctx k v (Three left k1 v1 mid k2 v2 right) | k P.< k1 = down (ThreeLeft k1 v1 mid k2 v2 right P.: ctx) k v left down ctx k v (Three left k1 v1 mid k2 v2 right) | k1 P.< k P.&& k P.<= k2 = down (ThreeMiddle left k1 v1 k2 v2 right P.: ctx) k v mid - down ctx k v (Three left k1 v1 mid k2 v2 right) = down (ThreeRight left k1 v1 mid k2 v2 P.: ctx) k v right - + down ctx k v (Three left k1 v1 mid k2 v2 right) = down (ThreeRight left k1 v1 mid k2 v2 P.: ctx) k v right + up :: forall k v. (P.Ord k) => [TreeContext k v] -> KickUp k v -> Map k v up [] (KickUp left k v right) = Two left k v right up (TwoLeft k1 v1 right : ctx) (KickUp left k v mid) = fromZipper ctx (Three left k v mid k1 v1 right) up (TwoRight left k1 v1 : ctx) (KickUp mid k v right) = fromZipper ctx (Three left k1 v1 mid k v right) up (ThreeLeft k1 v1 c k2 v2 d : ctx) (KickUp a k v b) = up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) up (ThreeMiddle a k1 v1 k2 v2 d : ctx) (KickUp b k v c) = up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) - up (ThreeRight a k1 v1 b k2 v2 : ctx) (KickUp c k v d) = up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) - + up (ThreeRight a k1 v1 b k2 v2 : ctx) (KickUp c k v d) = up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) + delete :: forall k v. (P.Ord k) => k -> Map k v -> Map k v delete = down [] where down :: forall k v. (P.Ord k) => [TreeContext k v] -> k -> Map k v -> Map k v down ctx _ Leaf = fromZipper ctx Leaf down ctx k (Two Leaf k1 _ Leaf) | k P.== k1 = up ctx Leaf - down ctx k (Two left k1 _ right) | k P.== k1 = + down ctx k (Two left k1 _ right) | k P.== k1 = let max = maxNode left in removeMaxNode (TwoLeft max.key max.value right P.: ctx) left down ctx k (Two left k1 v1 right) | k P.< k1 = down (TwoLeft k1 v1 right P.: ctx) k left down ctx k (Two left k1 v1 right) = down (TwoRight left k1 v1 P.: ctx) k right down ctx k (Three Leaf k1 _ Leaf k2 v2 Leaf) | k P.== k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) down ctx k (Three Leaf k1 v1 Leaf k2 _ Leaf) | k P.== k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) - down ctx k (Three left k1 _ mid k2 v2 right) | k P.== k1 = + down ctx k (Three left k1 _ mid k2 v2 right) | k P.== k1 = let max = maxNode left in removeMaxNode (ThreeLeft max.key max.value mid k2 v2 right P.: ctx) left down ctx k (Three left k1 v1 mid k2 _ right) | k P.== k2 = @@ -158,8 +168,8 @@ delete = down [] in removeMaxNode (ThreeMiddle left k1 v1 max.key max.value right P.: ctx) mid down ctx k (Three left k1 v1 mid k2 v2 right) | k P.< k1 = down (ThreeLeft k1 v1 mid k2 v2 right P.: ctx) k left down ctx k (Three left k1 v1 mid k2 v2 right) | k1 P.< k P.&& k P.< k2 = down (ThreeMiddle left k1 v1 k2 v2 right P.: ctx) k mid - down ctx k (Three left k1 v1 mid k2 v2 right) = down (ThreeRight left k1 v1 mid k2 v2 P.: ctx) k right - + down ctx k (Three left k1 v1 mid k2 v2 right) = down (ThreeRight left k1 v1 mid k2 v2 P.: ctx) k right + up :: forall k v. (P.Ord k) => [TreeContext k v] -> Map k v -> Map k v up [] tree = tree up (TwoLeft k1 v1 Leaf : ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) @@ -179,27 +189,27 @@ delete = down [] up (ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e : ctx) d = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) up (ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e) : ctx) b = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) up (ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 : ctx) e = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - + maxNode :: forall k v. (P.Ord k) => Map k v -> { key :: k, value :: v } maxNode (Two _ k v Leaf) = { key: k, value: v } maxNode (Two _ _ _ right) = maxNode right maxNode (Three _ _ _ _ k v Leaf) = { key: k, value: v } maxNode (Three _ _ _ _ _ _ right) = maxNode right - + removeMaxNode :: forall k v. (P.Ord k) => [TreeContext k v] -> Map k v -> Map k v removeMaxNode ctx (Two Leaf _ _ Leaf) = up ctx Leaf removeMaxNode ctx (Two left k v right) = removeMaxNode (TwoRight left k v P.: ctx) right removeMaxNode ctx (Three Leaf k1 v1 Leaf _ _ Leaf) = up (TwoRight Leaf k1 v1 P.: ctx) Leaf removeMaxNode ctx (Three left k1 v1 mid k2 v2 right) = removeMaxNode (ThreeRight left k1 v1 mid k2 v2 P.: ctx) right - + alter :: forall k v. (P.Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v alter f k m = case f (k `lookup` m) of Nothing -> delete k m Just v -> insert k v m update :: forall k v. (P.Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v -update f k m = alter (maybe Nothing f) k m - +update f k m = alter (maybe Nothing f) k m + toList :: forall k v. Map k v -> [Tuple k v] toList Leaf = [] toList (Two left k v right) = toList left P.++ [Tuple k v] P.++ toList right diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 108dddb7..910798a5 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -34,18 +34,19 @@ module Data.StrMap 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 (Foldable, foldl, foldr, for_) +import Data.Function +import Data.Maybe import Data.Monoid import Data.Monoid.All +import Data.Tuple +import Data.Traversable (Traversable, traverse) +import qualified Control.Monad.ST as ST +import qualified Data.Array as A import qualified Data.StrMap.ST as SM foreign import data StrMap :: * -> * @@ -128,6 +129,10 @@ instance foldableStrMap :: Foldable StrMap where foldr f z m = foldr f z (values m) foldMap f = foldMap (P.const f) +instance traversableStrMap :: Traversable StrMap where + traverse f ms = foldr (\x acc -> union P.<$> x P.<*> acc) (P.pure empty) ((P.(<$>) (uncurry singleton)) P.<$> (traverse f P.<$> toList ms)) + sequence = traverse P.id + -- Unfortunately the above are not short-circuitable (consider using purescript-machines) -- so we need special cases: @@ -213,10 +218,10 @@ alter f k m = case f (k `lookup` m) of Just v -> insert k v m update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a -update f k m = alter (maybe Nothing f) k m +update f k m = alter (maybe Nothing f) k m fromList :: forall a. [Tuple String a] -> StrMap a -fromList l = pureST (do +fromList l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> SM.poke s k v) P.return s) From 629e6db790794326c763e0e01b2391ccec82358d Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 30 Oct 2014 14:10:32 +0000 Subject: [PATCH 008/125] Remove Data.Graph (moving to new package) --- README.md | 35 ----------- src/Data/Graph.purs | 138 -------------------------------------------- 2 files changed, 173 deletions(-) delete mode 100644 src/Data/Graph.purs diff --git a/README.md b/README.md index 3b36c20d..4479f53d 100644 --- a/README.md +++ b/README.md @@ -1,40 +1,5 @@ # Module Documentation -## Module Data.Graph - -### Types - - data Edge k where - Edge :: k -> k -> Edge - - data Graph k v where - Graph :: [v] -> [Edge k] -> Graph - - data SCC v where - AcyclicSCC :: v -> SCC - CyclicSCC :: [v] -> SCC - - -### Type Class Instances - - instance eqSCC :: (Eq v) => Eq (SCC v) - - instance showSCC :: (Show v) => Show (SCC v) - - -### Values - - scc :: forall v. (Eq v, Ord v) => Graph v v -> [SCC v] - - scc' :: forall k v. (Eq k, Ord k) => (v -> k) -> (k -> v) -> Graph k v -> [SCC v] - - topSort :: forall v. (Eq v, Ord v) => Graph v v -> [v] - - topSort' :: forall k v. (Eq k, Ord k) => (v -> k) -> (k -> v) -> Graph k v -> [v] - - vertices :: forall v. SCC v -> [v] - - ## Module Data.Map ### Types diff --git a/src/Data/Graph.purs b/src/Data/Graph.purs deleted file mode 100644 index 5574a46d..00000000 --- a/src/Data/Graph.purs +++ /dev/null @@ -1,138 +0,0 @@ -module Data.Graph ( - Edge(..), - Graph(..), - SCC(..), - - vertices, - - scc, - scc', - - topSort, - topSort' - ) where - -import Data.Maybe -import Data.Array (map, reverse, concatMap) -import Data.Foldable -import Data.Traversable - -import Control.Monad -import Control.Monad.Eff -import Control.Monad.ST - -import qualified Data.Map as M -import qualified Data.Set as S - -data Edge k = Edge k k - -data Graph k v = Graph [v] [Edge k] - -type Index = Number - -data SCC v = AcyclicSCC v | CyclicSCC [v] - -instance showSCC :: (Show v) => Show (SCC v) where - show (AcyclicSCC v) = "AcyclicSCC (" ++ show v ++ ")" - show (CyclicSCC vs) = "CyclicSCC " ++ show vs - -instance eqSCC :: (Eq v) => Eq (SCC v) where - (==) (AcyclicSCC v1) (AcyclicSCC v2) = v1 == v2 - (==) (CyclicSCC vs1) (CyclicSCC vs2) = vs1 == vs2 - (==) _ _ = false - (/=) scc1 scc2 = not (scc1 == scc2) - -vertices :: forall v. SCC v -> [v] -vertices (AcyclicSCC v) = [v] -vertices (CyclicSCC vs) = vs - -scc :: forall v. (Eq v, Ord v) => Graph v v -> [SCC v] -scc = scc' id id - -scc' :: forall k v. (Eq k, Ord k) => (v -> k) -> (k -> v) -> Graph k v -> [SCC v] -scc' makeKey makeVert (Graph vs es) = runPure (runST (do - index <- newSTRef 0 - path <- newSTRef [] - indexMap <- newSTRef M.empty - lowlinkMap <- newSTRef M.empty - components <- newSTRef [] - - (let - indexOf v = indexOfKey (makeKey v) - - indexOfKey k = do - m <- readSTRef indexMap - return $ M.lookup k m - - lowlinkOf v = lowlinkOfKey (makeKey v) - - lowlinkOfKey k = do - m <- readSTRef lowlinkMap - return $ M.lookup k m - - go [] = readSTRef components - go (v : vs) = do - currentIndex <- indexOf v - when (isNothing currentIndex) $ strongConnect (makeKey v) - go vs - - strongConnect k = do - let v = makeVert k - - i <- readSTRef index - - modifySTRef indexMap $ M.insert k i - modifySTRef lowlinkMap $ M.insert k i - - writeSTRef index $ i + 1 - modifySTRef path $ (:) v - - for es $ \(Edge k' l) -> when (k == k') $ do - wIndex <- indexOfKey l - currentPath <- readSTRef path - - case wIndex of - Nothing -> do - let w = makeVert l - strongConnect l - wLowlink <- lowlinkOfKey l - for_ wLowlink $ \lowlink -> - modifySTRef lowlinkMap $ M.alter (maybeMin lowlink) k - _ -> when (l `elem` map makeKey currentPath) $ do - wIndex <- indexOfKey l - for_ wIndex $ \index -> - modifySTRef lowlinkMap $ M.alter (maybeMin index) k - - vIndex <- indexOfKey k - vLowlink <- lowlinkOfKey k - - when (vIndex == vLowlink) $ do - currentPath <- readSTRef path - let newPath = popUntil makeKey v currentPath [] - modifySTRef components $ flip (++) [makeComponent newPath.component] - writeSTRef path newPath.path - return unit - - makeComponent [v] | not (isCycle (makeKey v)) = AcyclicSCC v - makeComponent vs = CyclicSCC vs - - isCycle k = any (\(Edge k1 k2) -> k1 == k && k2 == k) es - in go vs))) - -popUntil :: forall k v. (Eq k) => (v -> k) -> v -> [v] -> [v] -> { path :: [v], component :: [v] } -popUntil _ _ [] popped = { path: [], component: popped } -popUntil makeKey v (w : path) popped | makeKey v == makeKey w = { path: path, component: w : popped } -popUntil makeKey v (w : ws) popped = popUntil makeKey v ws (w : popped) - -maybeMin :: Index -> Maybe Index -> Maybe Index -maybeMin i Nothing = Just i -maybeMin i (Just j) = Just $ Math.min i j - --- | --- Topological sort --- -topSort :: forall v. (Eq v, Ord v) => Graph v v -> [v] -topSort = topSort' id id - -topSort' :: forall k v. (Eq k, Ord k) => (v -> k) -> (k -> v) -> Graph k v -> [v] -topSort' makeKey makeVert = reverse <<< concatMap vertices <<< scc' makeKey makeVert From 108bec05c4b9f0a3c423d087d736c3d6fb6c8bb3 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 30 Oct 2014 20:05:40 +0000 Subject: [PATCH 009/125] Remove Data.Set --- README.md | 39 ------------------------- src/Data/Set.purs | 71 --------------------------------------------- tests/Data/Map.purs | 36 ----------------------- 3 files changed, 146 deletions(-) delete mode 100644 src/Data/Set.purs diff --git a/README.md b/README.md index 4479f53d..a153cc56 100644 --- a/README.md +++ b/README.md @@ -59,45 +59,6 @@ values :: forall k v. Map k v -> [v] -## Module Data.Set - -### Types - - data Set a - - -### Type Class Instances - - instance eqSet :: (P.Eq a) => P.Eq (Set a) - - instance showSet :: (P.Show a) => P.Show (Set a) - - -### Values - - checkValid :: forall a. Set a -> Boolean - - delete :: forall a. (P.Ord a) => a -> Set a -> Set a - - empty :: forall a. Set a - - fromList :: forall a. (P.Ord a) => [a] -> Set a - - insert :: forall a. (P.Ord a) => a -> Set a -> Set a - - isEmpty :: forall a. Set a -> Boolean - - member :: forall a. (P.Ord a) => a -> Set a -> Boolean - - singleton :: forall a. a -> Set a - - toList :: forall a. Set a -> [a] - - union :: forall a. (P.Ord a) => Set a -> Set a -> Set a - - unions :: forall a. (P.Ord a) => [Set a] -> Set a - - ## Module Data.StrMap ### Types diff --git a/src/Data/Set.purs b/src/Data/Set.purs deleted file mode 100644 index 85f9ca4c..00000000 --- a/src/Data/Set.purs +++ /dev/null @@ -1,71 +0,0 @@ --- --- Sets as balanced 2-3 trees --- --- Based on http://www.cs.princeton.edu/~dpw/courses/cos326-12/ass/2-3-trees.pdf --- - -module Data.Set - ( Set(), - empty, - isEmpty, - singleton, - checkValid, - insert, - member, - delete, - toList, - fromList, - union, - unions - ) where - -import qualified Prelude as P - -import qualified Data.Map as M - -import Data.Array (map, nub, length) -import Data.Maybe -import Data.Tuple -import Data.Foldable (foldl) - -data Set a = Set (M.Map a P.Unit) - -instance eqSet :: (P.Eq a) => P.Eq (Set a) where - (==) (Set m1) (Set m2) = m1 P.== m2 - (/=) (Set m1) (Set m2) = m1 P./= m2 - -instance showSet :: (P.Show a) => P.Show (Set a) where - show s = "fromList " P.++ P.show (toList s) - -empty :: forall a. Set a -empty = Set M.empty - -isEmpty :: forall a. Set a -> Boolean -isEmpty (Set m) = M.isEmpty m - -singleton :: forall a. a -> Set a -singleton a = Set (M.singleton a P.unit) - -checkValid :: forall a. Set a -> Boolean -checkValid (Set m) = M.checkValid m - -member :: forall a. (P.Ord a) => a -> Set a -> Boolean -member a (Set m) = a `M.member` m - -insert :: forall a. (P.Ord a) => a -> Set a -> Set a -insert a (Set m) = Set (M.insert a P.unit m) - -delete :: forall a. (P.Ord a) => a -> Set a -> Set a -delete a (Set m) = Set (a `M.delete` m) - -toList :: forall a. Set a -> [a] -toList (Set m) = map fst (M.toList m) - -fromList :: forall a. (P.Ord a) => [a] -> Set a -fromList = foldl (\m a -> insert a m) empty - -union :: forall a. (P.Ord a) => Set a -> Set a -> Set a -union (Set m1) (Set m2) = Set (m1 `M.union` m2) - -unions :: forall a. (P.Ord a) => [Set a] -> Set a -unions = foldl union empty diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index f69d4962..1f7b73f6 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -11,14 +11,10 @@ import Data.Foldable (foldl) import Test.QuickCheck import qualified Data.Map as M -import qualified Data.Set as S instance arbMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (M.Map k v) where arbitrary = M.fromList <$> arbitrary -instance arbSet :: (Eq a, Ord a, Arbitrary a) => Arbitrary (S.Set a) where - arbitrary = S.fromList <$> arbitrary - data SmallKey = A | B | C | D | E | F | G | H | I | J instance showSmallKey :: Show SmallKey where @@ -169,35 +165,3 @@ mapTests = do trace "Union is idempotent" quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Number)) - - -- Data.Set - - trace "testMemberEmpty: member _ empty == false" - quickCheck $ \a -> S.member a (S.empty :: S.Set SmallKey) == false - - trace "testMemberSingleton: member a (singleton a) == true" - quickCheck $ \a -> S.member (a :: SmallKey) (S.singleton a) == true - - trace "testInsertDelete: member a (delete a (insert a empty) == false)" - quickCheck $ \a -> (S.member (a :: SmallKey) $ - S.delete a $ - S.insert a S.empty) == false - - trace "testSingletonToList: toList (singleton a) == [a]" - quickCheck $ \a -> S.toList (S.singleton a :: S.Set SmallKey) == [a] - - trace "testToListFromList: toList . fromList = id" - quickCheck $ \arr -> let f x = S.toList (S.fromList x) in - f (f arr) == f (arr :: [SmallKey]) - - trace "testFromListToList: fromList . toList = id" - quickCheck $ \s -> let f s = S.fromList (S.toList s) in - S.toList (f s) == S.toList (s :: S.Set SmallKey) - - trace "testUnionSymmetric: union s1 s2 == union s2 s1" - quickCheck $ \s1 s2 -> let s3 = s1 `S.union` (s2 :: S.Set SmallKey) in - let s4 = s2 `S.union` s1 in - S.toList s3 == S.toList s4 - - trace "testUnionIdempotent" - quickCheck $ \s1 s2 -> (s1 `S.union` s2) == ((s1 `S.union` s2) `S.union` (s2 :: S.Set SmallKey)) From 2ca0e5e02e3695472447e3333a2327fa371d4289 Mon Sep 17 00:00:00 2001 From: David Chambers Date: Wed, 5 Nov 2014 22:47:44 -0800 Subject: [PATCH 010/125] use triple-quoted strings to avoid backslashes --- src/Data/StrMap.purs | 173 +++++++++++++++++++-------------- src/Data/StrMap/ST.purs | 38 +++++--- src/Data/StrMap/ST/Unsafe.purs | 8 +- src/Data/StrMap/Unsafe.purs | 12 ++- 4 files changed, 136 insertions(+), 95 deletions(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 910798a5..53ca7cff 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -51,20 +51,25 @@ import qualified Data.StrMap.ST as SM foreign import data StrMap :: * -> * -foreign import _copy """ +foreign import _copy + """ function _copy(m) { var r = {}; - for (var k in m) - r[k] = m[k] + for (var k in m) { + r[k] = m[k]; + } return r; - }""" :: forall a. StrMap a -> StrMap a + } + """ :: forall a. StrMap a -> StrMap a -foreign import _copyEff """ +foreign import _copyEff + """ function _copyEff(m) { - return function () { + return function() { return _copy(m); }; - }""" :: forall a b h r. a -> Eff (st :: ST.ST h | r) b + } + """ :: 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 @@ -72,10 +77,12 @@ thawST = _copyEff freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a) freezeST = _copyEff -foreign import runST """ +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) + } + """ :: 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) @@ -87,33 +94,38 @@ mutate f m = pureST (do P.return s) foreign import _fmapStrMap - "function _fmapStrMap(m0, f) {\ - \ var m = {};\ - \ for (var k in m0) {\ - \ m[k] = f(m0[k]);\ - \ }\ - \ return m;\ - \}" :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b) + """ + function _fmapStrMap(m0, f) { + var m = {}; + for (var k in m0) { + m[k] = f(m0[k]); + } + 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 + """ + 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.(#)) @@ -137,27 +149,32 @@ instance traversableStrMap :: Traversable StrMap where -- so we need special cases: foreign import _foldSCStrMap - "function _foldSCStrMap(m, z, f, fromMaybe) { \ - \ for (var k in m) { \ - \ 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 + """ + function _foldSCStrMap(m, z, f, fromMaybe) { + for (var k in m) { + 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 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 + """ + 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) @@ -175,13 +192,16 @@ isSubmap m1 m2 = all f m1 where isEmpty :: forall a. StrMap a -> Boolean isEmpty = all (\_ _ -> false) -foreign import size "function size(m) {\ - \ var s = 0;\ - \ for (var k in m) {\ - \ ++s;\ - \ }\ - \ return s;\ - \}" :: forall a. StrMap a -> Number +foreign import size + """ + function size(m) { + var s = 0; + for (var k in m) { + ++s; + } + return s; + } + """ :: forall a. StrMap a -> Number singleton :: forall a. String -> a -> StrMap a singleton k v = pureST (do @@ -190,9 +210,11 @@ singleton k v = pureST (do P.return s) foreign import _lookup - "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 + """ + 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 = runFn4 _lookup Nothing Just @@ -204,10 +226,12 @@ insert :: forall a. String -> a -> StrMap a -> StrMap a insert k v = mutate (\s -> SM.poke s k v) foreign import _unsafeDeleteStrMap - "function _unsafeDeleteStrMap(m, k) { \ - \ delete m[k]; \ - \ return m; \ - \}" :: forall a. Fn2 (StrMap a) String (StrMap a) + """ + function _unsafeDeleteStrMap(m, k) { + delete m[k]; + return m; + } + """ :: forall a. Fn2 (StrMap a) String (StrMap a) delete :: forall a. String -> StrMap a -> StrMap a delete k = mutate (\s -> SM.delete s k) @@ -227,22 +251,27 @@ fromList l = pureST (do 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] + """ + 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] 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] + """ + var keys = Object.keys || _collect(function(k) { + return function() { return k; }; + }); + """ :: forall a. StrMap a -> [String] values :: forall a. StrMap a -> [a] values = _collect (\_ v -> v) diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs index 51df2708..2041ab4e 100644 --- a/src/Data/StrMap/ST.purs +++ b/src/Data/StrMap/ST.purs @@ -12,44 +12,52 @@ import Data.Maybe foreign import data STStrMap :: * -> * -> * -foreign import _new """ +foreign import _new + """ function _new() { return {}; - }""" :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) + } + """ :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) new = _new -foreign import peek """ +foreign import peek + """ function peek(m) { - return function (k) { - return function () { + return function(k) { + return function() { return m[k]; } } - }""" :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a + } + """ :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a -foreign import poke """ +foreign import poke + """ function poke(m) { - return function (k) { - return function (v) { - return function () { + return function(k) { + return function(v) { + return function() { m[k] = v; return m; }; }; }; - }""" :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) + } + """ :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) -foreign import _delete """ +foreign import _delete + """ function _delete(m) { - return function (k) { - return function () { + return function(k) { + return function() { delete m[k]; return m; }; }; - }""" :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) + } + """ :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) delete = _delete diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs index 19ced3ac..45b48c17 100644 --- a/src/Data/StrMap/ST/Unsafe.purs +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -7,9 +7,11 @@ import Control.Monad.ST (ST()) import Data.StrMap (StrMap()) import Data.StrMap.ST (STStrMap()) -foreign import unsafeGet """ +foreign import unsafeGet + """ function unsafeGet(m) { - return function () { + return function() { return m; } - }""" :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) + } + """ :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) diff --git a/src/Data/StrMap/Unsafe.purs b/src/Data/StrMap/Unsafe.purs index 96a6941c..7b73736e 100644 --- a/src/Data/StrMap/Unsafe.purs +++ b/src/Data/StrMap/Unsafe.purs @@ -6,8 +6,10 @@ import Data.StrMap -- also known as (!) foreign import unsafeIndex - "function unsafeIndex(m) { \ - \ return function (k) {\ - \ return m[k];\ - \ };\ - \}" :: forall a . StrMap a -> String -> a + """ + function unsafeIndex(m) { + return function(k) { + return m[k]; + }; + } + """ :: forall a . StrMap a -> String -> a From 5ef40e35bdc5116d43f659b29e2e901e971fac04 Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Mon, 17 Nov 2014 19:39:20 -0800 Subject: [PATCH 011/125] Fixes for 0.6.1 --- src/Data/Map.purs | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 3b06f5e2..68dd5388 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -152,23 +152,25 @@ delete = down [] where down :: forall k v. (P.Ord k) => [TreeContext k v] -> k -> Map k v -> Map k v down ctx _ Leaf = fromZipper ctx Leaf - down ctx k (Two Leaf k1 _ Leaf) | k P.== k1 = up ctx Leaf - down ctx k (Two left k1 _ right) | k P.== k1 = - let max = maxNode left - in removeMaxNode (TwoLeft max.key max.value right P.: ctx) left - down ctx k (Two left k1 v1 right) | k P.< k1 = down (TwoLeft k1 v1 right P.: ctx) k left - down ctx k (Two left k1 v1 right) = down (TwoRight left k1 v1 P.: ctx) k right - down ctx k (Three Leaf k1 _ Leaf k2 v2 Leaf) | k P.== k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) - down ctx k (Three Leaf k1 v1 Leaf k2 _ Leaf) | k P.== k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) - down ctx k (Three left k1 _ mid k2 v2 right) | k P.== k1 = - let max = maxNode left - in removeMaxNode (ThreeLeft max.key max.value mid k2 v2 right P.: ctx) left - down ctx k (Three left k1 v1 mid k2 _ right) | k P.== k2 = - let max = maxNode mid - in removeMaxNode (ThreeMiddle left k1 v1 max.key max.value right P.: ctx) mid - down ctx k (Three left k1 v1 mid k2 v2 right) | k P.< k1 = down (ThreeLeft k1 v1 mid k2 v2 right P.: ctx) k left - down ctx k (Three left k1 v1 mid k2 v2 right) | k1 P.< k P.&& k P.< k2 = down (ThreeMiddle left k1 v1 k2 v2 right P.: ctx) k mid - down ctx k (Three left k1 v1 mid k2 v2 right) = down (ThreeRight left k1 v1 mid k2 v2 P.: ctx) k right + down ctx k (Two Leaf k1 _ Leaf) + | k P.== k1 = up ctx Leaf + down ctx k (Two left k1 v1 right) + | k P.== k1 = let max = maxNode left + in removeMaxNode (TwoLeft max.key max.value right P.: ctx) left + | k P.< k1 = down (TwoLeft k1 v1 right P.: ctx) k left + | P.otherwise = down (TwoRight left k1 v1 P.: ctx) k right + down ctx k (Three Leaf k1 _ Leaf k2 v2 Leaf) + | k P.== k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) + down ctx k (Three Leaf k1 v1 Leaf k2 _ Leaf) + | k P.== k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) + down ctx k (Three left k1 v1 mid k2 v2 right) + | k P.== k1 = let max = maxNode left + in removeMaxNode (ThreeLeft max.key max.value mid k2 v2 right P.: ctx) left + | k P.== k2 = let max = maxNode mid + in removeMaxNode (ThreeMiddle left k1 v1 max.key max.value right P.: ctx) mid + | k P.< k1 = down (ThreeLeft k1 v1 mid k2 v2 right P.: ctx) k left + | k1 P.< k P.&& k P.< k2 = down (ThreeMiddle left k1 v1 k2 v2 right P.: ctx) k mid + | P.otherwise = down (ThreeRight left k1 v1 mid k2 v2 P.: ctx) k right up :: forall k v. (P.Ord k) => [TreeContext k v] -> Map k v -> Map k v up [] tree = tree From 55858a68c447935f10f9f1f9a082651cf9de8f9d Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Tue, 18 Nov 2014 09:51:51 -0800 Subject: [PATCH 012/125] Update Gruntfile, merge two cases as suggested by @joneshf. --- Gruntfile.js | 4 ++-- package.json | 2 +- src/Data/Map.purs | 3 +-- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/Gruntfile.js b/Gruntfile.js index ce4d0063..ef6d6795 100644 --- a/Gruntfile.js +++ b/Gruntfile.js @@ -16,7 +16,7 @@ module.exports = function(grunt) { pscMake: ["<%=libFiles%>"], dotPsci: ["<%=libFiles%>"], - docgen: { + pscDocs: { readme: { src: "src/**/*.purs", dest: "README.md" @@ -47,6 +47,6 @@ module.exports = function(grunt) { grunt.loadNpmTasks("grunt-execute"); grunt.registerTask("test", ["clean:tests", "psc", "execute"]); - grunt.registerTask("make", ["pscMake", "dotPsci", "docgen"]); + grunt.registerTask("make", ["pscMake", "dotPsci", "pscDocs"]); grunt.registerTask("default", ["make", "test"]); }; diff --git a/package.json b/package.json index ac083644..0b545e4e 100644 --- a/package.json +++ b/package.json @@ -2,7 +2,7 @@ "private": true, "dependencies": { "grunt": "~0.4.4", - "grunt-purescript": "~0.5.1", + "grunt-purescript": "~0.6.0", "grunt-contrib-clean": "~0.5.0", "grunt-execute": "~0.2.1" } diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 68dd5388..9731bd77 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -159,9 +159,8 @@ delete = down [] in removeMaxNode (TwoLeft max.key max.value right P.: ctx) left | k P.< k1 = down (TwoLeft k1 v1 right P.: ctx) k left | P.otherwise = down (TwoRight left k1 v1 P.: ctx) k right - down ctx k (Three Leaf k1 _ Leaf k2 v2 Leaf) + down ctx k (Three Leaf k1 v1 Leaf k2 v2 Leaf) | k P.== k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) - down ctx k (Three Leaf k1 v1 Leaf k2 _ Leaf) | k P.== k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) down ctx k (Three left k1 v1 mid k2 v2 right) | k P.== k1 = let max = maxNode left From 658ea6e87aa27d42b3ddacbfab4501f3b2a7111b Mon Sep 17 00:00:00 2001 From: Dylan Simon Date: Tue, 18 Nov 2014 14:55:22 -0500 Subject: [PATCH 013/125] Fix _copyEff not to directly reference _copy Fixes #19 --- src/Data/StrMap.purs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 53ca7cff..96682f90 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -66,7 +66,11 @@ foreign import _copyEff """ function _copyEff(m) { return function() { - return _copy(m); + var r = {}; + for (var k in m) { + r[k] = m[k]; + } + return r; }; } """ :: forall a b h r. a -> Eff (st :: ST.ST h | r) b From beb6cbb5900029104aedbfba61b19cb79e358971 Mon Sep 17 00:00:00 2001 From: Dylan Simon Date: Tue, 18 Nov 2014 15:21:49 -0500 Subject: [PATCH 014/125] Fix StrMap.foldM implementation It previously did not work correctly with monads that deferred evaluation (like Eff) because k had the wrong scope. This adds an explicit closure for k. Fixes #18 --- src/Data/StrMap.purs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 96682f90..df5ab307 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -117,12 +117,13 @@ foreign import _foldM return function(f) { return function(mz) { return function(m) { - var k; - function g(z) { - return f(z)(k)(m[k]); + function g(k) { + return function (z) { + return f(z)(k)(m[k]); + }; } - for (k in m) { - mz = bind(mz)(g); + for (var k in m) { + mz = bind(mz)(g(k)); } return mz; }; From c5cdcfe55dfc2094ce8c6d5c2e107533307174df Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Fri, 5 Dec 2014 08:39:31 +0000 Subject: [PATCH 015/125] add 'size' to Data.Map --- src/Data/Map.purs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 9731bd77..7edacf20 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -237,3 +237,6 @@ unions = foldl union empty map :: forall k a b. (a -> b) -> Map k a -> Map k b map = P.(<$>) + +size :: forall k v. Map k v -> Number +size = A.length P.<<< values From 757a0772037f741488e23f6f68085f0712eb3296 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Fri, 5 Dec 2014 08:52:43 +0000 Subject: [PATCH 016/125] add tests + docs --- README.md | 2 ++ src/Data/Map.purs | 3 ++- tests/Data/Map.purs | 7 ++++++- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index a153cc56..e79be4f6 100644 --- a/README.md +++ b/README.md @@ -48,6 +48,8 @@ singleton :: forall k v. k -> v -> Map k v + size :: forall k v. Map k v -> Number + toList :: forall k v. Map k v -> [Tuple k v] union :: forall k v. (P.Ord k) => Map k v -> Map k v -> Map k v diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 7edacf20..fd60efd4 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -23,7 +23,8 @@ module Data.Map values, union, unions, - map + map, + size ) where import qualified Prelude as P diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index 1f7b73f6..5bb628cb 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -4,7 +4,7 @@ import Debug.Trace import Data.Maybe import Data.Tuple -import Data.Array (map) +import Data.Array (map, length, nubBy) import Data.Function (on) import Data.Foldable (foldl) @@ -165,3 +165,8 @@ mapTests = do trace "Union is idempotent" quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Number)) + + trace "size" + quickCheck $ \xs -> + let xs' = nubBy ((==) `on` fst) xs + in M.size (M.fromList xs') == length (xs' :: [Tuple SmallKey Number]) From 1101ccab92b0ed5b480927f79de10d05314cc905 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Mon, 8 Dec 2014 13:15:08 +0000 Subject: [PATCH 017/125] add `unionWith` --- README.md | 2 ++ src/Data/Map.purs | 10 +++++++++- tests/Data/Map.purs | 10 +++++++++- 3 files changed, 20 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index e79be4f6..d101aa40 100644 --- a/README.md +++ b/README.md @@ -54,6 +54,8 @@ union :: forall k v. (P.Ord k) => Map k v -> Map k v -> Map k v + unionWith :: forall k v. (P.Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v + unions :: forall k v. (P.Ord k) => [Map k v] -> Map k v update :: forall k v. (P.Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v diff --git a/src/Data/Map.purs b/src/Data/Map.purs index fd60efd4..fb8e460c 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -22,6 +22,7 @@ module Data.Map keys, values, union, + unionWith, unions, map, size @@ -230,8 +231,15 @@ values Leaf = [] values (Two left _ v right) = values left P.++ [v] P.++ values right values (Three left _ v1 mid _ v2 right) = values left P.++ [v1] P.++ values mid P.++ [v2] P.++ values right +-- Computes the union of two maps, except that when a key exists in both maps, its value in the result +-- is computed by combining them with the supplied function. +unionWith :: forall k v. (P.Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v +unionWith f m1 m2 = foldl go m2 (toList m1) + where + go m (Tuple k v) = alter (Just P.<<< maybe v (f v)) k m + union :: forall k v. (P.Ord k) => Map k v -> Map k v -> Map k v -union m1 m2 = foldl (\m (Tuple k v) -> insert k v m) m2 (toList m1) +union = unionWith P.const unions :: forall k v. (P.Ord k) => [Map k v] -> Map k v unions = foldl union empty diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index 5bb628cb..5addaa6b 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -6,7 +6,7 @@ import Data.Maybe import Data.Tuple import Data.Array (map, length, nubBy) import Data.Function (on) -import Data.Foldable (foldl) +import Data.Foldable (foldl, for_) import Test.QuickCheck @@ -166,6 +166,14 @@ mapTests = do trace "Union is idempotent" quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Number)) + trace "unionWith" + for_ [Tuple (+) 0, Tuple (*) 1] $ \(Tuple op ident) -> + quickCheck $ \m1 m2 k -> + let u = M.unionWith op m1 m2 :: M.Map SmallKey Number + in case M.lookup k u of + Nothing -> not (M.member k m1 || M.member k m2) + Just v -> v == op (fromMaybe ident (M.lookup k m1)) (fromMaybe ident (M.lookup k m2)) + trace "size" quickCheck $ \xs -> let xs' = nubBy ((==) `on` fst) xs From e6c108ea47708b183a66601e524824150170ec53 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Mon, 8 Dec 2014 18:42:18 +0000 Subject: [PATCH 018/125] add more tests --- tests/Data/Map.purs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index 5addaa6b..33ca7fb9 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -2,6 +2,7 @@ module Tests.Data.Map where import Debug.Trace +import Control.Alt ((<|>)) import Data.Maybe import Data.Tuple import Data.Array (map, length, nubBy) @@ -166,6 +167,9 @@ mapTests = do trace "Union is idempotent" quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Number)) + trace "Union prefers left" + quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 (m2 :: M.Map SmallKey Number)) == (M.lookup k m1 <|> M.lookup k m2) + trace "unionWith" for_ [Tuple (+) 0, Tuple (*) 1] $ \(Tuple op ident) -> quickCheck $ \m1 m2 k -> @@ -174,6 +178,19 @@ mapTests = do Nothing -> not (M.member k m1 || M.member k m2) Just v -> v == op (fromMaybe ident (M.lookup k m1)) (fromMaybe ident (M.lookup k m2)) + trace "unionWith argument order" + quickCheck $ \m1 m2 k -> + let u = M.unionWith (-) m1 m2 :: M.Map SmallKey Number + in1 = M.member k m1 + v1 = M.lookup k m1 + in2 = M.member k m2 + v2 = M.lookup k m2 + in case M.lookup k u of + Just v | in1 && in2 -> Just v == ((-) <$> v1 <*> v2) + Just v | in1 -> Just v == v1 + Just v -> Just v == v2 + Nothing -> not (in1 || in2) + trace "size" quickCheck $ \xs -> let xs' = nubBy ((==) `on` fst) xs From 025eac26d8c2302ce9f5762662a3e7ca36206a09 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Mon, 8 Dec 2014 18:44:34 +0000 Subject: [PATCH 019/125] Add semigroup instance --- README.md | 2 ++ src/Data/Map.purs | 3 +++ 2 files changed, 5 insertions(+) diff --git a/README.md b/README.md index e79be4f6..8ff0b8b9 100644 --- a/README.md +++ b/README.md @@ -15,6 +15,8 @@ instance functorMap :: P.Functor (Map k) + instance semigroupMap :: (P.Ord k) => P.Semigroup (Map k v) + instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) instance traversableMap :: (P.Ord k) => Traversable (Map k) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index fd60efd4..b2ecc758 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -47,6 +47,9 @@ instance eqMap :: (P.Eq k, P.Eq v) => P.Eq (Map k v) where instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) where show m = "fromList " P.++ P.show (toList m) +instance semigroupMap :: (P.Ord k) => P.Semigroup (Map k v) where + (<>) = union + instance functorMap :: P.Functor (Map k) where (<$>) _ Leaf = Leaf (<$>) f (Two left k v right) = Two (f P.<$> left) k (f v) (f P.<$> right) From 166e3a064e6c7218acb5920e292b7fedaf133155 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Mon, 8 Dec 2014 21:12:45 +0000 Subject: [PATCH 020/125] Add Monoid instance for Map k v --- README.md | 2 ++ src/Data/Map.purs | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/README.md b/README.md index 8ff0b8b9..43f5ce35 100644 --- a/README.md +++ b/README.md @@ -15,6 +15,8 @@ instance functorMap :: P.Functor (Map k) + instance monoidMap :: (P.Ord k) => Monoid (Map k v) + instance semigroupMap :: (P.Ord k) => P.Semigroup (Map k v) instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index b2ecc758..1a75b137 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -32,6 +32,7 @@ import qualified Prelude as P import qualified Data.Array as A import Data.Maybe import Data.Tuple +import Data.Monoid (Monoid) import Data.Foldable (foldl, foldMap, foldr, Foldable) import Data.Traversable (traverse, Traversable) @@ -50,6 +51,9 @@ instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) where instance semigroupMap :: (P.Ord k) => P.Semigroup (Map k v) where (<>) = union +instance monoidMap :: (P.Ord k) => Monoid (Map k v) where + mempty = empty + instance functorMap :: P.Functor (Map k) where (<$>) _ Leaf = Leaf (<$>) f (Two left k v right) = Two (f P.<$> left) k (f v) (f P.<$> right) From 5ea88a7615ad8c0994ace72387ec45249be93dda Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sat, 10 Jan 2015 14:27:49 +0000 Subject: [PATCH 021/125] Version dependencies --- bower.json | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/bower.json b/bower.json index b82ec1f4..ed1e22a9 100644 --- a/bower.json +++ b/bower.json @@ -25,11 +25,11 @@ "purescript-quickcheck": "*" }, "dependencies": { - "purescript-arrays": "*", - "purescript-foldable-traversable": "*", - "purescript-strings": "*", - "purescript-math": "*", - "purescript-maybe": "*", - "purescript-tuples": "*" + "purescript-arrays": "~0.3.0", + "purescript-foldable-traversable": "~0.2.1", + "purescript-strings": "~0.4.2", + "purescript-math": "~0.1.0", + "purescript-maybe": "~0.2.1", + "purescript-tuples": "~0.2.3" } } From 465226da11918f89a83cd4a0d881ad83d1bdd37f Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sat, 21 Feb 2015 12:21:37 +0000 Subject: [PATCH 022/125] Update dependencies --- README.md | 468 ++++++++++++++++++++++++++++++++++++++++++++--------- bower.json | 6 +- 2 files changed, 393 insertions(+), 81 deletions(-) diff --git a/README.md b/README.md index a28bb60b..b70fb36a 100644 --- a/README.md +++ b/README.md @@ -2,175 +2,487 @@ ## Module Data.Map -### Types +#### `Map` - data Map k v +``` purescript +data Map k v +``` -### Type Class Instances +#### `eqMap` - instance eqMap :: (P.Eq k, P.Eq v) => P.Eq (Map k v) +``` purescript +instance eqMap :: (P.Eq k, P.Eq v) => P.Eq (Map k v) +``` - instance foldableMap :: Foldable (Map k) - instance functorMap :: P.Functor (Map k) +#### `showMap` - instance monoidMap :: (P.Ord k) => Monoid (Map k v) +``` purescript +instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) +``` - instance semigroupMap :: (P.Ord k) => P.Semigroup (Map k v) - instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) +#### `semigroupMap` - instance traversableMap :: (P.Ord k) => Traversable (Map k) +``` purescript +instance semigroupMap :: (P.Ord k) => P.Semigroup (Map k v) +``` -### Values +#### `monoidMap` - alter :: forall k v. (P.Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v +``` purescript +instance monoidMap :: (P.Ord k) => Monoid (Map k v) +``` - checkValid :: forall k v. Map k v -> Boolean - delete :: forall k v. (P.Ord k) => k -> Map k v -> Map k v +#### `functorMap` - empty :: forall k v. Map k v +``` purescript +instance functorMap :: P.Functor (Map k) +``` - fromList :: forall k v. (P.Ord k) => [Tuple k v] -> Map k v - insert :: forall k v. (P.Ord k) => k -> v -> Map k v -> Map k v +#### `foldableMap` - isEmpty :: forall k v. Map k v -> Boolean +``` purescript +instance foldableMap :: Foldable (Map k) +``` - keys :: forall k v. Map k v -> [k] - lookup :: forall k v. (P.Ord k) => k -> Map k v -> Maybe v +#### `traversableMap` - map :: forall k a b. (a -> b) -> Map k a -> Map k b +``` purescript +instance traversableMap :: (P.Ord k) => Traversable (Map k) +``` - member :: forall k v. (P.Ord k) => k -> Map k v -> Boolean - showTree :: forall k v. (P.Show k, P.Show v) => Map k v -> String +#### `showTree` - singleton :: forall k v. k -> v -> Map k v +``` purescript +showTree :: forall k v. (P.Show k, P.Show v) => Map k v -> String +``` - size :: forall k v. Map k v -> Number - toList :: forall k v. Map k v -> [Tuple k v] +#### `empty` - union :: forall k v. (P.Ord k) => Map k v -> Map k v -> Map k v +``` purescript +empty :: forall k v. Map k v +``` - unionWith :: forall k v. (P.Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v - unions :: forall k v. (P.Ord k) => [Map k v] -> Map k v +#### `isEmpty` - update :: forall k v. (P.Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v +``` purescript +isEmpty :: forall k v. Map k v -> Boolean +``` + + +#### `singleton` + +``` purescript +singleton :: forall k v. k -> v -> Map k v +``` + + +#### `checkValid` + +``` purescript +checkValid :: forall k v. Map k v -> Boolean +``` + + +#### `lookup` + +``` purescript +lookup :: forall k v. (P.Ord k) => k -> Map k v -> Maybe v +``` + + +#### `member` + +``` purescript +member :: forall k v. (P.Ord k) => k -> Map k v -> Boolean +``` + + +#### `insert` + +``` purescript +insert :: forall k v. (P.Ord k) => k -> v -> Map k v -> Map k v +``` + + +#### `delete` + +``` purescript +delete :: forall k v. (P.Ord k) => k -> Map k v -> Map k v +``` + + +#### `alter` + +``` purescript +alter :: forall k v. (P.Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v +``` + + +#### `update` + +``` purescript +update :: forall k v. (P.Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v +``` + + +#### `toList` + +``` purescript +toList :: forall k v. Map k v -> [Tuple k v] +``` + + +#### `fromList` + +``` purescript +fromList :: forall k v. (P.Ord k) => [Tuple k v] -> Map k v +``` + + +#### `keys` + +``` purescript +keys :: forall k v. Map k v -> [k] +``` + + +#### `values` + +``` purescript +values :: forall k v. Map k v -> [v] +``` + + +#### `unionWith` + +``` purescript +unionWith :: forall k v. (P.Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v +``` + +#### `union` + +``` purescript +union :: forall k v. (P.Ord k) => Map k v -> Map k v -> Map k v +``` + + +#### `unions` + +``` purescript +unions :: forall k v. (P.Ord k) => [Map k v] -> Map k v +``` + + +#### `map` + +``` purescript +map :: forall k a b. (a -> b) -> Map k a -> Map k b +``` + + +#### `size` + +``` purescript +size :: forall k v. Map k v -> Number +``` - values :: forall k v. Map k v -> [v] ## Module Data.StrMap -### Types +#### `StrMap` + +``` purescript +data StrMap :: * -> * +``` + + +#### `thawST` + +``` purescript +thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a) +``` + + +#### `freezeST` + +``` purescript +freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a) +``` + + +#### `runST` - data StrMap :: * -> * +``` purescript +runST :: forall a r. (forall h. Eff (st :: ST.ST h | r) (SM.STStrMap h a)) -> Eff r (StrMap a) +``` -### Type Class Instances +#### `functorStrMap` - instance eqStrMap :: (P.Eq a) => P.Eq (StrMap a) +``` purescript +instance functorStrMap :: P.Functor StrMap +``` - instance foldableStrMap :: Foldable StrMap - instance functorStrMap :: P.Functor StrMap +#### `fold` - instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a) +``` purescript +fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z +``` - instance showStrMap :: (P.Show a) => P.Show (StrMap a) - instance traversableStrMap :: Traversable StrMap +#### `foldMap` +``` purescript +foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m +``` -### Values - all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean +#### `foldM` - alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a +``` purescript +foldM :: forall a m z. (P.Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z +``` - delete :: forall a. String -> StrMap a -> StrMap a - empty :: forall a. StrMap a +#### `foldableStrMap` - fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z +``` purescript +instance foldableStrMap :: Foldable StrMap +``` - 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 +#### `traversableStrMap` - foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z +``` purescript +instance traversableStrMap :: Traversable StrMap +``` - 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 +#### `foldMaybe` - insert :: forall a. String -> a -> StrMap a -> StrMap a +``` purescript +foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z +``` - isEmpty :: forall a. StrMap a -> Boolean - isSubmap :: forall a. (P.Eq a) => StrMap a -> StrMap a -> Boolean +#### `all` - keys :: forall a. StrMap a -> [String] +``` purescript +all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean +``` - lookup :: forall a. String -> StrMap a -> Maybe a - map :: forall a b. (a -> b) -> StrMap a -> StrMap b +#### `eqStrMap` - member :: forall a. String -> StrMap a -> Boolean +``` purescript +instance eqStrMap :: (P.Eq a) => P.Eq (StrMap a) +``` - 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 +#### `showStrMap` - size :: forall a. StrMap a -> Number +``` purescript +instance showStrMap :: (P.Show a) => P.Show (StrMap a) +``` - 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] +#### `empty` - union :: forall a. StrMap a -> StrMap a -> StrMap a +``` purescript +empty :: forall a. StrMap a +``` - unions :: forall a. [StrMap a] -> StrMap a - update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a +#### `isSubmap` + +``` purescript +isSubmap :: forall a. (P.Eq a) => StrMap a -> StrMap a -> Boolean +``` + + +#### `isEmpty` + +``` purescript +isEmpty :: forall a. StrMap a -> Boolean +``` + + +#### `size` + +``` purescript +size :: forall a. StrMap a -> Number +``` + + +#### `singleton` + +``` purescript +singleton :: forall a. String -> a -> StrMap a +``` + + +#### `lookup` + +``` purescript +lookup :: forall a. String -> StrMap a -> Maybe a +``` + + +#### `member` + +``` purescript +member :: forall a. String -> StrMap a -> Boolean +``` + + +#### `insert` + +``` purescript +insert :: forall a. String -> a -> StrMap a -> StrMap a +``` + + +#### `delete` + +``` purescript +delete :: forall a. String -> StrMap a -> StrMap a +``` + + +#### `alter` + +``` purescript +alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a +``` + + +#### `update` + +``` purescript +update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a +``` + + +#### `fromList` + +``` purescript +fromList :: forall a. [Tuple String a] -> StrMap a +``` + + +#### `toList` + +``` purescript +toList :: forall a. StrMap a -> [Tuple String a] +``` + + +#### `keys` + +``` purescript +keys :: forall a. StrMap a -> [String] +``` + + +#### `values` + +``` purescript +values :: forall a. StrMap a -> [a] +``` + + +#### `union` + +``` purescript +union :: forall a. StrMap a -> StrMap a -> StrMap a +``` + +#### `unions` + +``` purescript +unions :: forall a. [StrMap a] -> StrMap a +``` + + +#### `map` + +``` purescript +map :: forall a b. (a -> b) -> StrMap a -> StrMap b +``` + + +#### `semigroupStrMap` + +``` purescript +instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a) +``` - values :: forall a. StrMap a -> [a] ## Module Data.StrMap.ST -### Types +#### `STStrMap` + +``` purescript +data STStrMap :: * -> * -> * +``` - data STStrMap :: * -> * -> * +#### `new` -### Values +``` purescript +new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) +``` - 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` - peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a +``` purescript +peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a +``` + + +#### `poke` + +``` purescript +poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) +``` + + +#### `delete` + +``` purescript +delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h 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` + +``` purescript +unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) +``` - unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) ## Module Data.StrMap.Unsafe -### Values +#### `unsafeIndex` - unsafeIndex :: forall a. StrMap a -> String -> a \ No newline at end of file +``` purescript +unsafeIndex :: forall a. StrMap a -> String -> a +``` \ No newline at end of file diff --git a/bower.json b/bower.json index ed1e22a9..12e1f15f 100644 --- a/bower.json +++ b/bower.json @@ -22,14 +22,14 @@ "package.json" ], "devDependencies": { - "purescript-quickcheck": "*" + "purescript-quickcheck": "~0.5.0" }, "dependencies": { "purescript-arrays": "~0.3.0", - "purescript-foldable-traversable": "~0.2.1", + "purescript-foldable-traversable": "~0.3.0", "purescript-strings": "~0.4.2", "purescript-math": "~0.1.0", "purescript-maybe": "~0.2.1", - "purescript-tuples": "~0.2.3" + "purescript-tuples": "~0.3.0" } } From 7231fb93beac6529c97bccbf4d5822c4007bd9b2 Mon Sep 17 00:00:00 2001 From: Michael Xavier Date: Mon, 23 Feb 2015 22:13:39 -0800 Subject: [PATCH 023/125] Add Monoid instance for StrMap --- README.md | 7 +++++++ src/Data/StrMap.purs | 3 +++ 2 files changed, 10 insertions(+) diff --git a/README.md b/README.md index b70fb36a..f507b5f4 100644 --- a/README.md +++ b/README.md @@ -430,6 +430,13 @@ instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a) ``` +#### `monoidStrMap` + +``` purescript +instance monoidStrMap :: (P.Semigroup a) => Monoid (StrMap a) +``` + + ## Module Data.StrMap.ST diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index df5ab307..0920d7ce 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -293,3 +293,6 @@ 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 + +instance monoidStrMap :: (P.Semigroup a) => Monoid (StrMap a) where + mempty = empty From 1be88e0c3f7da2e82e59c8a99107a037b3fe052b Mon Sep 17 00:00:00 2001 From: Eric Easley Date: Mon, 2 Mar 2015 03:17:26 -0500 Subject: [PATCH 024/125] Added `fromListWith` --- src/Data/Map.purs | 6 ++++++ src/Data/StrMap.purs | 16 ++++++++++++++++ 2 files changed, 22 insertions(+) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 7ef9a344..73bc8489 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -15,6 +15,7 @@ module Data.Map lookup, toList, fromList, + fromListWith, delete, member, alter, @@ -228,6 +229,11 @@ toList (Three left k1 v1 mid k2 v2 right) = toList left P.++ [Tuple k1 v1] P.++ fromList :: forall k v. (P.Ord k) => [Tuple k v] -> Map k v fromList = foldl (\m (Tuple k v) -> insert k v m) empty +fromListWith :: forall k v. (P.Ord k) => (v -> v -> v) -> [Tuple k v] -> Map k v +fromListWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where + combine v (Just v') = Just P.$ f v v' + combine v Nothing = Just v + keys :: forall k v. Map k v -> [k] keys Leaf = [] keys (Two left k _ right) = keys left P.++ [k] P.++ keys right diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 0920d7ce..22e6e9fd 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -14,6 +14,7 @@ module Data.StrMap lookup, toList, fromList, + fromListWith, delete, member, alter, @@ -255,6 +256,21 @@ fromList l = pureST (do for_ l (\(Tuple k v) -> SM.poke s k v) P.return s) +foreign import _lookupST + """ + function _lookupST(no, yes, k, m) { + return function() { + return k in m ? yes(m[k]) : no; + } + } + """ :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z) + +fromListWith :: forall a. (a -> a -> a) -> [Tuple String a] -> StrMap a +fromListWith f l = pureST (do + s <- SM.new + for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s P.>>= SM.poke s k) + P.return s) + foreign import _collect """ function _collect(f) { From 4e23eb9ae1f614adcc36c07b4d337540b87dc5bd Mon Sep 17 00:00:00 2001 From: Eric Easley Date: Mon, 2 Mar 2015 18:34:57 -0500 Subject: [PATCH 025/125] Tests for `fromListWith` --- tests/Data/Map.purs | 16 ++++++++++++++-- tests/Data/StrMap.purs | 16 ++++++++++++++-- 2 files changed, 28 insertions(+), 4 deletions(-) diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index 33ca7fb9..d9a4a610 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -5,7 +5,7 @@ import Debug.Trace import Control.Alt ((<|>)) import Data.Maybe import Data.Tuple -import Data.Array (map, length, nubBy) +import Data.Array (groupBy, map, length, nubBy, sortBy) import Data.Function (on) import Data.Foldable (foldl, for_) @@ -158,7 +158,19 @@ mapTests = do trace "fromList . toList = id" quickCheck $ \m -> let f m = M.fromList (M.toList m) in M.toList (f m) == M.toList (m :: M.Map SmallKey Number) show m - + + trace "fromListWith const = fromList" + quickCheck $ \arr -> M.fromListWith const arr == + M.fromList (arr :: [Tuple SmallKey Number]) show arr + + trace "fromListWith (<>) = fromList . collapse with (<>) . group on fst" + quickCheck $ \arr -> + let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) + foldl1 g (x : xs) = foldl g x xs + f = M.fromList <<< (<$>) (foldl1 combine) <<< + groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in + M.fromListWith (<>) arr == f (arr :: [Tuple String String]) show arr + trace "Lookup from union" quickCheck $ \m1 m2 k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of Nothing -> M.lookup k m2 diff --git a/tests/Data/StrMap.purs b/tests/Data/StrMap.purs index 8752497e..f196c6b7 100644 --- a/tests/Data/StrMap.purs +++ b/tests/Data/StrMap.purs @@ -5,7 +5,7 @@ import Debug.Trace import Data.Maybe import Data.Tuple import qualified Data.String as S -import Data.Array (map) +import Data.Array (groupBy, map, sortBy) import Data.Function (on) import Data.Foldable (foldl) @@ -86,7 +86,19 @@ strMapTests = do trace "fromList . toList = id" quickCheck $ \m -> let f m = M.fromList (M.toList m) in M.toList (f m) == M.toList (m :: M.StrMap Number) show m - + + trace "fromListWith const = fromList" + quickCheck $ \arr -> M.fromListWith const arr == + M.fromList (arr :: [Tuple String Number]) show arr + + trace "fromListWith (<>) = fromList . collapse with (<>) . group on fst" + quickCheck $ \arr -> + let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) + foldl1 g (x : xs) = foldl g x xs + f = M.fromList <<< (<$>) (foldl1 combine) <<< + groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in + M.fromListWith (<>) arr == f (arr :: [Tuple String String]) show arr + trace "Lookup from union" quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 m2) == (case M.lookup k m1 of Nothing -> M.lookup k m2 From 44ccb2f607ae6c0bd03fc9144242e5f7c6bf9949 Mon Sep 17 00:00:00 2001 From: Eric Easley Date: Mon, 2 Mar 2015 18:37:43 -0500 Subject: [PATCH 026/125] Removed excess whitespace --- tests/Data/Map.purs | 30 +++++++++++++++--------------- tests/Data/StrMap.purs | 20 ++++++++++---------- 2 files changed, 25 insertions(+), 25 deletions(-) diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index d9a4a610..f6e912a0 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -43,7 +43,7 @@ instance eqSmallKey :: Eq SmallKey where (==) J J = true (==) _ _ = false (/=) x y = not (x == y) - + smallKeyToNumber :: SmallKey -> Number smallKeyToNumber A = 0 smallKeyToNumber B = 1 @@ -54,7 +54,7 @@ smallKeyToNumber F = 5 smallKeyToNumber G = 6 smallKeyToNumber H = 7 smallKeyToNumber I = 8 -smallKeyToNumber J = 9 +smallKeyToNumber J = 9 instance ordSmallKey :: Ord SmallKey where compare = compare `on` smallKeyToNumber @@ -91,7 +91,7 @@ instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction false -> do k <- arbitrary return (Delete k) - + runInstructions :: forall k v. (Ord k) => [Instruction k v] -> M.Map k v -> M.Map k v runInstructions instrs t0 = foldl step t0 instrs where @@ -105,36 +105,36 @@ number :: Number -> Number number n = n mapTests = do - + -- Data.Map - + trace "Test inserting into empty tree" quickCheck $ \k v -> M.lookup (smallKey k) (M.insert k v M.empty) == Just (number v) ("k: " ++ show k ++ ", v: " ++ show v) trace "Test delete after inserting" - quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) + quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) ("k: " ++ show k ++ ", v: " ++ show v) trace "Insert two, lookup first" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) trace "Insert two, lookup second" - quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v2 + quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) trace "Insert two, delete one" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty))) == Just v2 + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty))) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - + trace "Check balance property" - quickCheck' 5000 $ \instrs -> + quickCheck' 5000 $ \instrs -> let tree :: M.Map SmallKey Number tree = runInstructions instrs M.empty in M.checkValid tree ("Map not balanced:\n " ++ show tree ++ "\nGenerated by:\n " ++ show instrs) - + trace "Lookup from empty" quickCheck $ \k -> M.lookup k (M.empty :: M.Map SmallKey Number) == Nothing @@ -152,7 +152,7 @@ mapTests = do quickCheck $ \k v -> M.toList (M.singleton k v :: M.Map SmallKey Number) == [Tuple k v] trace "toList . fromList = id" - quickCheck $ \arr -> let f x = M.toList (M.fromList x) + quickCheck $ \arr -> let f x = M.toList (M.fromList x) in f (f arr) == f (arr :: [Tuple SmallKey Number]) show arr trace "fromList . toList = id" @@ -172,10 +172,10 @@ mapTests = do M.fromListWith (<>) arr == f (arr :: [Tuple String String]) show arr trace "Lookup from union" - quickCheck $ \m1 m2 k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of + quickCheck $ \m1 m2 k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of Nothing -> M.lookup k m2 Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) - + trace "Union is idempotent" quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Number)) diff --git a/tests/Data/StrMap.purs b/tests/Data/StrMap.purs index f196c6b7..63a37fd5 100644 --- a/tests/Data/StrMap.purs +++ b/tests/Data/StrMap.purs @@ -32,7 +32,7 @@ instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) whe return (Insert k v) false -> do return (Delete k) - + runInstructions :: forall v. [Instruction String v] -> M.StrMap v -> M.StrMap v runInstructions instrs t0 = foldl step t0 instrs where @@ -42,27 +42,27 @@ runInstructions instrs t0 = foldl step t0 instrs number :: Number -> Number number n = n -strMapTests = do +strMapTests = do trace "Test inserting into empty tree" quickCheck $ \k v -> M.lookup k (M.insert k v M.empty) == Just (number v) ("k: " ++ show k ++ ", v: " ++ show v) trace "Test delete after inserting" - quickCheck $ \k v -> M.isEmpty (M.delete k (M.insert k (number v) M.empty)) + quickCheck $ \k v -> M.isEmpty (M.delete k (M.insert k (number v) M.empty)) ("k: " ++ show k ++ ", v: " ++ show v) trace "Insert two, lookup first" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v1 + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v1 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) trace "Insert two, lookup second" - quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v2 + quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) trace "Insert two, delete one" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty))) == Just v2 + quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty))) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - + trace "Lookup from empty" quickCheck $ \k -> M.lookup k (M.empty :: M.StrMap Number) == Nothing @@ -80,7 +80,7 @@ strMapTests = do quickCheck $ \k v -> M.toList (M.singleton k v :: M.StrMap Number) == [Tuple k v] trace "toList . fromList = id" - quickCheck $ \arr -> let f x = M.toList (M.fromList x) + quickCheck $ \arr -> let f x = M.toList (M.fromList x) in f (f arr) == f (arr :: [Tuple String Number]) show arr trace "fromList . toList = id" @@ -100,10 +100,10 @@ strMapTests = do M.fromListWith (<>) arr == f (arr :: [Tuple String String]) show arr trace "Lookup from union" - quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 m2) == (case M.lookup k m1 of + quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 m2) == (case M.lookup k m1 of Nothing -> M.lookup k m2 Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) - + trace "Union is idempotent" quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Number)) (show (M.size (m1 `M.union` m2)) ++ " != " ++ show (M.size ((m1 `M.union` m2) `M.union` m2))) From a9e88d662eab9f7b898e9f7b9a7a3fb74117150c Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Thu, 19 Mar 2015 19:13:20 -0700 Subject: [PATCH 027/125] Docs --- README.md | 163 ++++++++++++++++++++---- src/Data/Map.purs | 220 ++++++++++++++++++--------------- src/Data/StrMap.purs | 101 ++++++++++----- src/Data/StrMap/ST.purs | 13 ++ src/Data/StrMap/ST/Unsafe.purs | 3 + src/Data/StrMap/Unsafe.purs | 4 +- 6 files changed, 345 insertions(+), 159 deletions(-) diff --git a/README.md b/README.md index f507b5f4..a1766975 100644 --- a/README.md +++ b/README.md @@ -2,45 +2,50 @@ ## Module Data.Map + +This module defines a type of maps as balanced 2-3 trees, based on + + #### `Map` ``` purescript data Map k v ``` +`Map k v` represents maps from keys of type `k` to values of type `v`. #### `eqMap` ``` purescript -instance eqMap :: (P.Eq k, P.Eq v) => P.Eq (Map k v) +instance eqMap :: (Eq k, Eq v) => Eq (Map k v) ``` #### `showMap` ``` purescript -instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) +instance showMap :: (Show k, Show v) => Show (Map k v) ``` #### `semigroupMap` ``` purescript -instance semigroupMap :: (P.Ord k) => P.Semigroup (Map k v) +instance semigroupMap :: (Ord k) => Semigroup (Map k v) ``` #### `monoidMap` ``` purescript -instance monoidMap :: (P.Ord k) => Monoid (Map k v) +instance monoidMap :: (Ord k) => Monoid (Map k v) ``` #### `functorMap` ``` purescript -instance functorMap :: P.Functor (Map k) +instance functorMap :: Functor (Map k) ``` @@ -54,16 +59,17 @@ instance foldableMap :: Foldable (Map k) #### `traversableMap` ``` purescript -instance traversableMap :: (P.Ord k) => Traversable (Map k) +instance traversableMap :: (Ord k) => Traversable (Map k) ``` #### `showTree` ``` purescript -showTree :: forall k v. (P.Show k, P.Show v) => Map k v -> String +showTree :: forall k v. (Show k, Show v) => Map k v -> String ``` +Render a `Map` as a `String` #### `empty` @@ -71,6 +77,7 @@ showTree :: forall k v. (P.Show k, P.Show v) => Map k v -> String empty :: forall k v. Map k v ``` +An empty map #### `isEmpty` @@ -78,6 +85,7 @@ empty :: forall k v. Map k v isEmpty :: forall k v. Map k v -> Boolean ``` +Test if a map is empty #### `singleton` @@ -85,6 +93,7 @@ isEmpty :: forall k v. Map k v -> Boolean singleton :: forall k v. k -> v -> Map k v ``` +Create a map with one key/value pair #### `checkValid` @@ -92,48 +101,57 @@ singleton :: forall k v. k -> v -> Map k v checkValid :: forall k v. Map k v -> Boolean ``` +Check whether the underlying tree satisfies the 2-3 invariant + +This function is provided for internal use. #### `lookup` ``` purescript -lookup :: forall k v. (P.Ord k) => k -> Map k v -> Maybe v +lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v ``` +Lookup a value for the specified key #### `member` ``` purescript -member :: forall k v. (P.Ord k) => k -> Map k v -> Boolean +member :: forall k v. (Ord k) => k -> Map k v -> Boolean ``` +Test if a key is a member of a map #### `insert` ``` purescript -insert :: forall k v. (P.Ord k) => k -> v -> Map k v -> Map k v +insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v ``` +Insert a key/value pair into a map #### `delete` ``` purescript -delete :: forall k v. (P.Ord k) => k -> Map k v -> Map k v +delete :: forall k v. (Ord k) => k -> Map k v -> Map k v ``` +Delete a key and its corresponding value from a map #### `alter` ``` purescript -alter :: forall k v. (P.Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v +alter :: forall k v. (Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v ``` +Insert the value, delete a value, or update a value for a key in a map #### `update` ``` purescript -update :: forall k v. (P.Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v +update :: forall k v. (Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v ``` +Update or delete the value for a key in a map #### `toList` @@ -141,13 +159,24 @@ update :: forall k v. (P.Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v toList :: forall k v. Map k v -> [Tuple k v] ``` +Convert a map to an array of key/value pairs #### `fromList` ``` purescript -fromList :: forall k v. (P.Ord k) => [Tuple k v] -> Map k v +fromList :: forall k v. (Ord k) => [Tuple k v] -> Map k v +``` + +Create a map from an array of key/value pairs + +#### `fromListWith` + +``` purescript +fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> [Tuple k v] -> Map k v ``` +Create a map from an array of key/value pairs, using the specified function +to combine values for duplicate keys. #### `keys` @@ -155,6 +184,7 @@ fromList :: forall k v. (P.Ord k) => [Tuple k v] -> Map k v keys :: forall k v. Map k v -> [k] ``` +Get an array of the keys contained in a map #### `values` @@ -162,26 +192,33 @@ keys :: forall k v. Map k v -> [k] values :: forall k v. Map k v -> [v] ``` +Get an array of the values contained in a map #### `unionWith` ``` purescript -unionWith :: forall k v. (P.Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v +unionWith :: forall k v. (Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v ``` +Compute the union of two maps, using the specified function +to combine values for duplicate keys. + #### `union` ``` purescript -union :: forall k v. (P.Ord k) => Map k v -> Map k v -> Map k v +union :: forall k v. (Ord k) => Map k v -> Map k v -> Map k v ``` +Compute the union of two maps, preferring values from the first map in the case +of duplicate keys #### `unions` ``` purescript -unions :: forall k v. (P.Ord k) => [Map k v] -> Map k v +unions :: forall k v. (Ord k) => [Map k v] -> Map k v ``` +Compute the union of a collection of maps #### `map` @@ -189,6 +226,7 @@ unions :: forall k v. (P.Ord k) => [Map k v] -> Map k v map :: forall k a b. (a -> b) -> Map k a -> Map k b ``` +Apply a function to the values in a map #### `size` @@ -196,16 +234,25 @@ map :: forall k a b. (a -> b) -> Map k a -> Map k b size :: forall k v. Map k v -> Number ``` +Calculate the number of key/value pairs in a map ## Module Data.StrMap + +This module defines a type of native Javascript maps which +require the keys to be strings. + +To maximize performance, Javascript objects are not wrapped, +and some native code is used even when it's not necessary. + #### `StrMap` ``` purescript data StrMap :: * -> * ``` +`StrMap a` represents a map from `String`s to values of type `a`. #### `thawST` @@ -213,6 +260,7 @@ data StrMap :: * -> * thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a) ``` +Convert an immutable map into a mutable map #### `freezeST` @@ -220,6 +268,7 @@ thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a) freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a) ``` +Convert a mutable map into an immutable map #### `runST` @@ -227,11 +276,15 @@ freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a) runST :: forall a r. (forall h. Eff (st :: ST.ST h | r) (SM.STStrMap h a)) -> Eff r (StrMap a) ``` +Freeze a mutable map, creating an immutable map. Use this function as you would use +`Prelude.runST` to freeze a mutable reference. + +The rank-2 type prevents the map from escaping the scope of `runST`. #### `functorStrMap` ``` purescript -instance functorStrMap :: P.Functor StrMap +instance functorStrMap :: Functor StrMap ``` @@ -241,6 +294,7 @@ instance functorStrMap :: P.Functor StrMap fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z ``` +Fold the keys and values of a map #### `foldMap` @@ -248,13 +302,17 @@ fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m ``` +Fold the keys and values of a map, accumulating values using +some `Monoid`. #### `foldM` ``` purescript -foldM :: forall a m z. (P.Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z +foldM :: forall a m z. (Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z ``` +Fold the keys and values of a map, accumulating values and effects in +some `Monad`. #### `foldableStrMap` @@ -276,6 +334,10 @@ instance traversableStrMap :: Traversable StrMap foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z ``` +Fold the keys and values of a map. + +This function allows the folding function to terminate the fold early, +using `Maybe`. #### `all` @@ -283,18 +345,19 @@ foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean ``` +Test whether all key/value pairs in a `StrMap` satisfy a predicate. #### `eqStrMap` ``` purescript -instance eqStrMap :: (P.Eq a) => P.Eq (StrMap a) +instance eqStrMap :: (Eq a) => Eq (StrMap a) ``` #### `showStrMap` ``` purescript -instance showStrMap :: (P.Show a) => P.Show (StrMap a) +instance showStrMap :: (Show a) => Show (StrMap a) ``` @@ -304,13 +367,15 @@ instance showStrMap :: (P.Show a) => P.Show (StrMap a) empty :: forall a. StrMap a ``` +An empty map #### `isSubmap` ``` purescript -isSubmap :: forall a. (P.Eq a) => StrMap a -> StrMap a -> Boolean +isSubmap :: forall a. (Eq a) => StrMap a -> StrMap a -> Boolean ``` +Test whether one map contains all of the keys and values contained in another map #### `isEmpty` @@ -318,6 +383,7 @@ isSubmap :: forall a. (P.Eq a) => StrMap a -> StrMap a -> Boolean isEmpty :: forall a. StrMap a -> Boolean ``` +Test whether a map is empty #### `size` @@ -325,6 +391,7 @@ isEmpty :: forall a. StrMap a -> Boolean size :: forall a. StrMap a -> Number ``` +Calculate the number of key/value pairs in a map #### `singleton` @@ -332,6 +399,7 @@ size :: forall a. StrMap a -> Number singleton :: forall a. String -> a -> StrMap a ``` +Create a map with one key/value pair #### `lookup` @@ -339,6 +407,7 @@ singleton :: forall a. String -> a -> StrMap a lookup :: forall a. String -> StrMap a -> Maybe a ``` +Lookup the value for a key in a map #### `member` @@ -346,6 +415,7 @@ lookup :: forall a. String -> StrMap a -> Maybe a member :: forall a. String -> StrMap a -> Boolean ``` +Test whether a `String` appears as a key in a map #### `insert` @@ -353,6 +423,7 @@ member :: forall a. String -> StrMap a -> Boolean insert :: forall a. String -> a -> StrMap a -> StrMap a ``` +Insert a key and value into a map #### `delete` @@ -360,6 +431,7 @@ insert :: forall a. String -> a -> StrMap a -> StrMap a delete :: forall a. String -> StrMap a -> StrMap a ``` +Delete a key and value from a map #### `alter` @@ -367,6 +439,7 @@ delete :: forall a. String -> StrMap a -> StrMap a alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a ``` +Insert, remove or update a value for a key in a map #### `update` @@ -374,6 +447,7 @@ alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a ``` +Remove or update a value for a key in a map #### `fromList` @@ -381,6 +455,16 @@ update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a fromList :: forall a. [Tuple String a] -> StrMap a ``` +Create a map from an array of key/value pairs + +#### `fromListWith` + +``` purescript +fromListWith :: forall a. (a -> a -> a) -> [Tuple String a] -> StrMap a +``` + +Create a map from an array of key/value pairs, using the specified function +to combine values for duplicate keys. #### `toList` @@ -388,6 +472,7 @@ fromList :: forall a. [Tuple String a] -> StrMap a toList :: forall a. StrMap a -> [Tuple String a] ``` +Convert a map into an array of key/value pairs #### `keys` @@ -395,6 +480,7 @@ toList :: forall a. StrMap a -> [Tuple String a] keys :: forall a. StrMap a -> [String] ``` +Get an array of the keys in a map #### `values` @@ -402,6 +488,7 @@ keys :: forall a. StrMap a -> [String] values :: forall a. StrMap a -> [a] ``` +Get an array of the values in a map #### `union` @@ -409,12 +496,16 @@ values :: forall a. StrMap a -> [a] union :: forall a. StrMap a -> StrMap a -> StrMap a ``` +Compute the union of two maps, preferring the first map in the case of +duplicate keys. + #### `unions` ``` purescript unions :: forall a. [StrMap a] -> StrMap a ``` +Compute the union of a collection of maps #### `map` @@ -422,30 +513,41 @@ unions :: forall a. [StrMap a] -> StrMap a map :: forall a b. (a -> b) -> StrMap a -> StrMap b ``` +Map a function over the values in a map #### `semigroupStrMap` ``` purescript -instance semigroupStrMap :: (P.Semigroup a) => P.Semigroup (StrMap a) +instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) ``` #### `monoidStrMap` ``` purescript -instance monoidStrMap :: (P.Semigroup a) => Monoid (StrMap a) +instance monoidStrMap :: (Semigroup a) => Monoid (StrMap a) ``` ## Module Data.StrMap.ST + +Helper functions for working with mutable maps using the `ST` effect. + +This module can be used when performance is important and mutation is a local effect. + #### `STStrMap` ``` purescript data STStrMap :: * -> * -> * ``` +A reference to a mutable map + +The first type parameter represents the memory region which the map belongs to. The second type parameter defines the type of elements of the mutable array. + +The runtime representation of a value of type `STStrMap h a` is the same as that of `StrMap a`, except that mutation is allowed. #### `new` @@ -453,6 +555,7 @@ data STStrMap :: * -> * -> * new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) ``` +Create a new, empty mutable map #### `peek` @@ -460,6 +563,7 @@ 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 ``` +Get the value for a key in a mutable map #### `poke` @@ -467,6 +571,7 @@ 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) ``` +Update the value for a key in a mutable map #### `delete` @@ -474,6 +579,7 @@ poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStr delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) ``` +Remove a key and the corresponding value from a mutable map ## Module Data.StrMap.ST.Unsafe @@ -484,6 +590,9 @@ delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) ``` +Unsafely get the value for a key in a map. + +This function does not check whether the key exists in the map. ## Module Data.StrMap.Unsafe @@ -492,4 +601,8 @@ unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) ``` purescript unsafeIndex :: forall a. StrMap a -> String -> a -``` \ No newline at end of file +``` + +Unsafely get the value for a key in a map. + +This function does not check whether the key exists in the map. \ No newline at end of file diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 73bc8489..f98438d5 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -1,8 +1,5 @@ --- --- Maps as balanced 2-3 trees --- --- Based on http://www.cs.princeton.edu/~dpw/courses/cos326-12/ass/2-3-trees.pdf --- +-- | This module defines a type of maps as balanced 2-3 trees, based on +-- | module Data.Map ( Map(), @@ -29,8 +26,6 @@ module Data.Map size ) where -import qualified Prelude as P - import qualified Data.Array as A import Data.Maybe import Data.Tuple @@ -38,84 +33,94 @@ import Data.Monoid (Monoid) import Data.Foldable (foldl, foldMap, foldr, Foldable) import Data.Traversable (traverse, Traversable) +-- | `Map k v` represents maps from keys of type `k` to values of type `v`. data Map k v = Leaf | Two (Map k v) k v (Map k v) | Three (Map k v) k v (Map k v) k v (Map k v) -instance eqMap :: (P.Eq k, P.Eq v) => P.Eq (Map k v) where - (==) m1 m2 = toList m1 P.== toList m2 - (/=) m1 m2 = P.not (m1 P.== m2) +instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where + (==) m1 m2 = toList m1 == toList m2 + (/=) m1 m2 = not (m1 == m2) -instance showMap :: (P.Show k, P.Show v) => P.Show (Map k v) where - show m = "fromList " P.++ P.show (toList m) +instance showMap :: (Show k, Show v) => Show (Map k v) where + show m = "fromList " ++ show (toList m) -instance semigroupMap :: (P.Ord k) => P.Semigroup (Map k v) where +instance semigroupMap :: (Ord k) => Semigroup (Map k v) where (<>) = union -instance monoidMap :: (P.Ord k) => Monoid (Map k v) where +instance monoidMap :: (Ord k) => Monoid (Map k v) where mempty = empty -instance functorMap :: P.Functor (Map k) where +instance functorMap :: Functor (Map k) where (<$>) _ Leaf = Leaf - (<$>) f (Two left k v right) = Two (f P.<$> left) k (f v) (f P.<$> right) - (<$>) f (Three left k1 v1 mid k2 v2 right) = Three (f P.<$> left) k1 (f v1) (f P.<$> mid) k2 (f v2) (f P.<$> right) + (<$>) f (Two left k v right) = Two (f <$> left) k (f v) (f <$> right) + (<$>) f (Three left k1 v1 mid k2 v2 right) = Three (f <$> left) k1 (f v1) (f <$> mid) k2 (f v2) (f <$> right) instance foldableMap :: Foldable (Map k) where foldl f z m = foldl f z (values m) foldr f z m = foldr f z (values m) foldMap f m = foldMap f (values m) -instance traversableMap :: (P.Ord k) => Traversable (Map k) where - traverse f ms = foldr (\x acc -> union P.<$> x P.<*> acc) (P.pure empty) ((P.(<$>) (uncurry singleton)) P.<$> (traverse f P.<$> toList ms)) - sequence = traverse P.id +instance traversableMap :: (Ord k) => Traversable (Map k) where + traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) (((<$>) (uncurry singleton)) <$> (traverse f <$> toList ms)) + sequence = traverse id -showTree :: forall k v. (P.Show k, P.Show v) => Map k v -> String +-- | Render a `Map` as a `String` +showTree :: forall k v. (Show k, Show v) => Map k v -> String showTree Leaf = "Leaf" showTree (Two left k v right) = - "Two (" P.++ showTree left P.++ - ") (" P.++ P.show k P.++ - ") (" P.++ P.show v P.++ - ") (" P.++ showTree right P.++ ")" + "Two (" ++ showTree left ++ + ") (" ++ show k ++ + ") (" ++ show v ++ + ") (" ++ showTree right ++ ")" showTree (Three left k1 v1 mid k2 v2 right) = - "Three (" P.++ showTree left P.++ - ") (" P.++ P.show k1 P.++ - ") (" P.++ P.show v1 P.++ - ") (" P.++ showTree mid P.++ - ") (" P.++ P.show k2 P.++ - ") (" P.++ P.show v2 P.++ - ") (" P.++ showTree right P.++ ")" - + "Three (" ++ showTree left ++ + ") (" ++ show k1 ++ + ") (" ++ show v1 ++ + ") (" ++ showTree mid ++ + ") (" ++ show k2 ++ + ") (" ++ show v2 ++ + ") (" ++ showTree right ++ ")" + +-- | An empty map empty :: forall k v. Map k v empty = Leaf +-- | Test if a map is empty isEmpty :: forall k v. Map k v -> Boolean isEmpty Leaf = true isEmpty _ = false +-- | Create a map with one key/value pair singleton :: forall k v. k -> v -> Map k v singleton k v = Two Leaf k v Leaf +-- | Check whether the underlying tree satisfies the 2-3 invariant +-- | +-- | This function is provided for internal use. checkValid :: forall k v. Map k v -> Boolean -checkValid tree = A.length (A.nub (allHeights tree)) P.== 1 +checkValid tree = A.length (A.nub (allHeights tree)) == 1 where allHeights :: forall k v. Map k v -> [Number] allHeights Leaf = [0] - allHeights (Two left _ _ right) = A.map (\n -> n P.+ 1) (allHeights left P.++ allHeights right) - allHeights (Three left _ _ mid _ _ right) = A.map (\n -> n P.+ 1) (allHeights left P.++ allHeights mid P.++ allHeights right) + allHeights (Two left _ _ right) = A.map (\n -> n + 1) (allHeights left ++ allHeights right) + allHeights (Three left _ _ mid _ _ right) = A.map (\n -> n + 1) (allHeights left ++ allHeights mid ++ allHeights right) -lookup :: forall k v. (P.Ord k) => k -> Map k v -> Maybe v +-- | Lookup a value for the specified key +lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v lookup _ Leaf = Nothing -lookup k (Two _ k1 v _) | k P.== k1 = Just v -lookup k (Two left k1 _ _) | k P.< k1 = lookup k left +lookup k (Two _ k1 v _) | k == k1 = Just v +lookup k (Two left k1 _ _) | k < k1 = lookup k left lookup k (Two _ _ _ right) = lookup k right -lookup k (Three _ k1 v1 _ _ _ _) | k P.== k1 = Just v1 -lookup k (Three _ _ _ _ k2 v2 _) | k P.== k2 = Just v2 -lookup k (Three left k1 _ _ _ _ _) | k P.< k1 = lookup k left -lookup k (Three _ k1 _ mid k2 _ _) | k1 P.< k P.&& k P.<= k2 = lookup k mid +lookup k (Three _ k1 v1 _ _ _ _) | k == k1 = Just v1 +lookup k (Three _ _ _ _ k2 v2 _) | k == k2 = Just v2 +lookup k (Three left k1 _ _ _ _ _) | k < k1 = lookup k left +lookup k (Three _ k1 _ mid k2 _ _) | k1 < k && k <= k2 = lookup k mid lookup k (Three _ _ _ _ _ _ right) = lookup k right -member :: forall k v. (P.Ord k) => k -> Map k v -> Boolean +-- | Test if a key is a member of a map +member :: forall k v. (Ord k) => k -> Map k v -> Boolean member k m = isJust (k `lookup` m) data TreeContext k v @@ -125,7 +130,7 @@ data TreeContext k v | ThreeMiddle (Map k v) k v k v (Map k v) | ThreeRight (Map k v) k v (Map k v) k v -fromZipper :: forall k v. (P.Ord k) => [TreeContext k v] -> Map k v -> Map k v +fromZipper :: forall k v. (Ord k) => [TreeContext k v] -> Map k v -> Map k v fromZipper [] tree = tree fromZipper (TwoLeft k1 v1 right : ctx) left = fromZipper ctx (Two left k1 v1 right) fromZipper (TwoRight left k1 v1 : ctx) right = fromZipper ctx (Two left k1 v1 right) @@ -135,21 +140,22 @@ fromZipper (ThreeRight left k1 v1 mid k2 v2 : ctx) right = fromZipper ctx (Three data KickUp k v = KickUp (Map k v) k v (Map k v) -insert :: forall k v. (P.Ord k) => k -> v -> Map k v -> Map k v +-- | Insert a key/value pair into a map +insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v insert = down [] where - down :: forall k v. (P.Ord k) => [TreeContext k v] -> k -> v -> Map k v -> Map k v + down :: forall k v. (Ord k) => [TreeContext k v] -> k -> v -> Map k v -> Map k v down ctx k v Leaf = up ctx (KickUp Leaf k v Leaf) - down ctx k v (Two left k1 _ right) | k P.== k1 = fromZipper ctx (Two left k v right) - down ctx k v (Two left k1 v1 right) | k P.< k1 = down (TwoLeft k1 v1 right P.: ctx) k v left - down ctx k v (Two left k1 v1 right) = down (TwoRight left k1 v1 P.: ctx) k v right - down ctx k v (Three left k1 _ mid k2 v2 right) | k P.== k1 = fromZipper ctx (Three left k v mid k2 v2 right) - down ctx k v (Three left k1 v1 mid k2 _ right) | k P.== k2 = fromZipper ctx (Three left k1 v1 mid k v right) - down ctx k v (Three left k1 v1 mid k2 v2 right) | k P.< k1 = down (ThreeLeft k1 v1 mid k2 v2 right P.: ctx) k v left - down ctx k v (Three left k1 v1 mid k2 v2 right) | k1 P.< k P.&& k P.<= k2 = down (ThreeMiddle left k1 v1 k2 v2 right P.: ctx) k v mid - down ctx k v (Three left k1 v1 mid k2 v2 right) = down (ThreeRight left k1 v1 mid k2 v2 P.: ctx) k v right - - up :: forall k v. (P.Ord k) => [TreeContext k v] -> KickUp k v -> Map k v + down ctx k v (Two left k1 _ right) | k == k1 = fromZipper ctx (Two left k v right) + down ctx k v (Two left k1 v1 right) | k < k1 = down (TwoLeft k1 v1 right : ctx) k v left + down ctx k v (Two left k1 v1 right) = down (TwoRight left k1 v1 : ctx) k v right + down ctx k v (Three left k1 _ mid k2 v2 right) | k == k1 = fromZipper ctx (Three left k v mid k2 v2 right) + down ctx k v (Three left k1 v1 mid k2 _ right) | k == k2 = fromZipper ctx (Three left k1 v1 mid k v right) + down ctx k v (Three left k1 v1 mid k2 v2 right) | k < k1 = down (ThreeLeft k1 v1 mid k2 v2 right : ctx) k v left + down ctx k v (Three left k1 v1 mid k2 v2 right) | k1 < k && k <= k2 = down (ThreeMiddle left k1 v1 k2 v2 right : ctx) k v mid + down ctx k v (Three left k1 v1 mid k2 v2 right) = down (ThreeRight left k1 v1 mid k2 v2 : ctx) k v right + + up :: forall k v. (Ord k) => [TreeContext k v] -> KickUp k v -> Map k v up [] (KickUp left k v right) = Two left k v right up (TwoLeft k1 v1 right : ctx) (KickUp left k v mid) = fromZipper ctx (Three left k v mid k1 v1 right) up (TwoRight left k1 v1 : ctx) (KickUp mid k v right) = fromZipper ctx (Three left k1 v1 mid k v right) @@ -157,31 +163,32 @@ insert = down [] up (ThreeMiddle a k1 v1 k2 v2 d : ctx) (KickUp b k v c) = up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) up (ThreeRight a k1 v1 b k2 v2 : ctx) (KickUp c k v d) = up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) -delete :: forall k v. (P.Ord k) => k -> Map k v -> Map k v +-- | Delete a key and its corresponding value from a map +delete :: forall k v. (Ord k) => k -> Map k v -> Map k v delete = down [] where - down :: forall k v. (P.Ord k) => [TreeContext k v] -> k -> Map k v -> Map k v + down :: forall k v. (Ord k) => [TreeContext k v] -> k -> Map k v -> Map k v down ctx _ Leaf = fromZipper ctx Leaf down ctx k (Two Leaf k1 _ Leaf) - | k P.== k1 = up ctx Leaf + | k == k1 = up ctx Leaf down ctx k (Two left k1 v1 right) - | k P.== k1 = let max = maxNode left - in removeMaxNode (TwoLeft max.key max.value right P.: ctx) left - | k P.< k1 = down (TwoLeft k1 v1 right P.: ctx) k left - | P.otherwise = down (TwoRight left k1 v1 P.: ctx) k right + | k == k1 = let max = maxNode left + in removeMaxNode (TwoLeft max.key max.value right : ctx) left + | k < k1 = down (TwoLeft k1 v1 right : ctx) k left + | otherwise = down (TwoRight left k1 v1 : ctx) k right down ctx k (Three Leaf k1 v1 Leaf k2 v2 Leaf) - | k P.== k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) - | k P.== k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) + | k == k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) + | k == k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) down ctx k (Three left k1 v1 mid k2 v2 right) - | k P.== k1 = let max = maxNode left - in removeMaxNode (ThreeLeft max.key max.value mid k2 v2 right P.: ctx) left - | k P.== k2 = let max = maxNode mid - in removeMaxNode (ThreeMiddle left k1 v1 max.key max.value right P.: ctx) mid - | k P.< k1 = down (ThreeLeft k1 v1 mid k2 v2 right P.: ctx) k left - | k1 P.< k P.&& k P.< k2 = down (ThreeMiddle left k1 v1 k2 v2 right P.: ctx) k mid - | P.otherwise = down (ThreeRight left k1 v1 mid k2 v2 P.: ctx) k right - - up :: forall k v. (P.Ord k) => [TreeContext k v] -> Map k v -> Map k v + | k == k1 = let max = maxNode left + in removeMaxNode (ThreeLeft max.key max.value mid k2 v2 right : ctx) left + | k == k2 = let max = maxNode mid + in removeMaxNode (ThreeMiddle left k1 v1 max.key max.value right : ctx) mid + | k < k1 = down (ThreeLeft k1 v1 mid k2 v2 right : ctx) k left + | k1 < k && k < k2 = down (ThreeMiddle left k1 v1 k2 v2 right : ctx) k mid + | otherwise = down (ThreeRight left k1 v1 mid k2 v2 : ctx) k right + + up :: forall k v. (Ord k) => [TreeContext k v] -> Map k v -> Map k v up [] tree = tree up (TwoLeft k1 v1 Leaf : ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) up (TwoRight Leaf k1 v1 : ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) @@ -201,64 +208,77 @@ delete = down [] up (ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e) : ctx) b = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) up (ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 : ctx) e = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - maxNode :: forall k v. (P.Ord k) => Map k v -> { key :: k, value :: v } + maxNode :: forall k v. (Ord k) => Map k v -> { key :: k, value :: v } maxNode (Two _ k v Leaf) = { key: k, value: v } maxNode (Two _ _ _ right) = maxNode right maxNode (Three _ _ _ _ k v Leaf) = { key: k, value: v } maxNode (Three _ _ _ _ _ _ right) = maxNode right - removeMaxNode :: forall k v. (P.Ord k) => [TreeContext k v] -> Map k v -> Map k v + removeMaxNode :: forall k v. (Ord k) => [TreeContext k v] -> Map k v -> Map k v removeMaxNode ctx (Two Leaf _ _ Leaf) = up ctx Leaf - removeMaxNode ctx (Two left k v right) = removeMaxNode (TwoRight left k v P.: ctx) right - removeMaxNode ctx (Three Leaf k1 v1 Leaf _ _ Leaf) = up (TwoRight Leaf k1 v1 P.: ctx) Leaf - removeMaxNode ctx (Three left k1 v1 mid k2 v2 right) = removeMaxNode (ThreeRight left k1 v1 mid k2 v2 P.: ctx) right + removeMaxNode ctx (Two left k v right) = removeMaxNode (TwoRight left k v : ctx) right + removeMaxNode ctx (Three Leaf k1 v1 Leaf _ _ Leaf) = up (TwoRight Leaf k1 v1 : ctx) Leaf + removeMaxNode ctx (Three left k1 v1 mid k2 v2 right) = removeMaxNode (ThreeRight left k1 v1 mid k2 v2 : ctx) right -alter :: forall k v. (P.Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v +-- | Insert the value, delete a value, or update a value for a key in a map +alter :: forall k v. (Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v alter f k m = case f (k `lookup` m) of Nothing -> delete k m Just v -> insert k v m -update :: forall k v. (P.Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v +-- | Update or delete the value for a key in a map +update :: forall k v. (Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v update f k m = alter (maybe Nothing f) k m +-- | Convert a map to an array of key/value pairs toList :: forall k v. Map k v -> [Tuple k v] toList Leaf = [] -toList (Two left k v right) = toList left P.++ [Tuple k v] P.++ toList right -toList (Three left k1 v1 mid k2 v2 right) = toList left P.++ [Tuple k1 v1] P.++ toList mid P.++ [Tuple k2 v2] P.++ toList right +toList (Two left k v right) = toList left ++ [Tuple k v] ++ toList right +toList (Three left k1 v1 mid k2 v2 right) = toList left ++ [Tuple k1 v1] ++ toList mid ++ [Tuple k2 v2] ++ toList right -fromList :: forall k v. (P.Ord k) => [Tuple k v] -> Map k v +-- | Create a map from an array of key/value pairs +fromList :: forall k v. (Ord k) => [Tuple k v] -> Map k v fromList = foldl (\m (Tuple k v) -> insert k v m) empty -fromListWith :: forall k v. (P.Ord k) => (v -> v -> v) -> [Tuple k v] -> Map k v +-- | Create a map from an array of key/value pairs, using the specified function +-- | to combine values for duplicate keys. +fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> [Tuple k v] -> Map k v fromListWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where - combine v (Just v') = Just P.$ f v v' + combine v (Just v') = Just $ f v v' combine v Nothing = Just v +-- | Get an array of the keys contained in a map keys :: forall k v. Map k v -> [k] keys Leaf = [] -keys (Two left k _ right) = keys left P.++ [k] P.++ keys right -keys (Three left k1 _ mid k2 _ right) = keys left P.++ [k1] P.++ keys mid P.++ [k2] P.++ keys right +keys (Two left k _ right) = keys left ++ [k] ++ keys right +keys (Three left k1 _ mid k2 _ right) = keys left ++ [k1] ++ keys mid ++ [k2] ++ keys right +-- | Get an array of the values contained in a map values :: forall k v. Map k v -> [v] values Leaf = [] -values (Two left _ v right) = values left P.++ [v] P.++ values right -values (Three left _ v1 mid _ v2 right) = values left P.++ [v1] P.++ values mid P.++ [v2] P.++ values right +values (Two left _ v right) = values left ++ [v] ++ values right +values (Three left _ v1 mid _ v2 right) = values left ++ [v1] ++ values mid ++ [v2] ++ values right --- Computes the union of two maps, except that when a key exists in both maps, its value in the result --- is computed by combining them with the supplied function. -unionWith :: forall k v. (P.Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v +-- | Compute the union of two maps, using the specified function +-- | to combine values for duplicate keys. +unionWith :: forall k v. (Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v unionWith f m1 m2 = foldl go m2 (toList m1) where - go m (Tuple k v) = alter (Just P.<<< maybe v (f v)) k m + go m (Tuple k v) = alter (Just <<< maybe v (f v)) k m -union :: forall k v. (P.Ord k) => Map k v -> Map k v -> Map k v -union = unionWith P.const +-- | Compute the union of two maps, preferring values from the first map in the case +-- | of duplicate keys +union :: forall k v. (Ord k) => Map k v -> Map k v -> Map k v +union = unionWith const -unions :: forall k v. (P.Ord k) => [Map k v] -> Map k v +-- | Compute the union of a collection of maps +unions :: forall k v. (Ord k) => [Map k v] -> Map k v unions = foldl union empty +-- | Apply a function to the values in a map map :: forall k a b. (a -> b) -> Map k a -> Map k b -map = P.(<$>) +map = (<$>) +-- | Calculate the number of key/value pairs in a map size :: forall k v. Map k v -> Number -size = A.length P.<<< values +size = A.length <<< values diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 22e6e9fd..54ec0e0a 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -1,8 +1,8 @@ --- --- Native Javascript maps which require the keys to be strings. --- To maximize performance, Javascript objects are not wrapped, --- and some native code is used even when it's not necessary. --- +-- | This module defines a type of native Javascript maps which +-- | require the keys to be strings. +-- | +-- | To maximize performance, Javascript objects are not wrapped, +-- | and some native code is used even when it's not necessary. module Data.StrMap ( StrMap(), @@ -36,8 +36,6 @@ module Data.StrMap runST ) where -import qualified Prelude as P - import Control.Monad.Eff (Eff(), runPure) import Data.Foldable (Foldable, foldl, foldr, for_) import Data.Function @@ -50,6 +48,7 @@ import qualified Control.Monad.ST as ST import qualified Data.Array as A import qualified Data.StrMap.ST as SM +-- | `StrMap a` represents a map from `String`s to values of type `a`. foreign import data StrMap :: * -> * foreign import _copy @@ -76,12 +75,18 @@ foreign import _copyEff } """ :: forall a b h r. a -> Eff (st :: ST.ST h | r) b +-- | Convert an immutable map into a mutable map thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a) thawST = _copyEff +-- | Convert a mutable map into an immutable map freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a) freezeST = _copyEff +-- | Freeze a mutable map, creating an immutable map. Use this function as you would use +-- | `Prelude.runST` to freeze a mutable reference. +-- | +-- | The rank-2 type prevents the map from escaping the scope of `runST`. foreign import runST """ function runST(f) { @@ -96,7 +101,7 @@ mutate :: forall a b. (forall h e. SM.STStrMap h a -> Eff (st :: ST.ST h | e) b) mutate f m = pureST (do s <- thawST m f s - P.return s) + return s) foreign import _fmapStrMap """ @@ -109,7 +114,7 @@ foreign import _fmapStrMap } """ :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b) -instance functorStrMap :: P.Functor StrMap where +instance functorStrMap :: Functor StrMap where (<$>) f m = runFn2 _fmapStrMap m f foreign import _foldM @@ -133,23 +138,28 @@ foreign import _foldM } """ :: forall a m z. (m -> (z -> m) -> m) -> (z -> String -> a -> m) -> m -> StrMap a -> m +-- | Fold the keys and values of a map fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z -fold = _foldM (P.(#)) +fold = _foldM ((#)) +-- | Fold the keys and values of a map, accumulating values using +-- | some `Monoid`. foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m -foldMap f = fold (\acc k v -> acc P.<> f k v) mempty +foldMap f = fold (\acc k v -> acc <> 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) +-- | Fold the keys and values of a map, accumulating values and effects in +-- | some `Monad`. +foldM :: forall a m z. (Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z +foldM f z = _foldM (>>=) f (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) + foldMap f = foldMap (const f) instance traversableStrMap :: Traversable StrMap where - traverse f ms = foldr (\x acc -> union P.<$> x P.<*> acc) (P.pure empty) ((P.(<$>) (uncurry singleton)) P.<$> (traverse f P.<$> toList ms)) - sequence = traverse P.id + traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) (((<$>) (uncurry singleton)) <$> (traverse f <$> toList ms)) + sequence = traverse id -- Unfortunately the above are not short-circuitable (consider using purescript-machines) -- so we need special cases: @@ -167,9 +177,14 @@ foreign import _foldSCStrMap } """ :: forall a z. Fn4 (StrMap a) z (z -> String -> a -> Maybe z) (forall a. a -> Maybe a -> a) z +-- | Fold the keys and values of a map. +-- | +-- | This function allows the folding function to terminate the fold early, +-- | using `Maybe`. foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z foldMaybe f z m = runFn4 _foldSCStrMap m z f fromMaybe +-- | Test whether all key/value pairs in a `StrMap` satisfy a predicate. foreign import all """ function all(f) { @@ -182,22 +197,26 @@ foreign import all } """ :: 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) +instance eqStrMap :: (Eq a) => Eq (StrMap a) where + (==) m1 m2 = (isSubmap m1 m2) && (isSubmap m2 m1) + (/=) m1 m2 = not (m1 == m2) -instance showStrMap :: (P.Show a) => P.Show (StrMap a) where - show m = "fromList " P.++ P.show (toList m) +instance showStrMap :: (Show a) => Show (StrMap a) where + show m = "fromList " ++ show (toList m) +-- | An empty map foreign import empty "var empty = {};" :: forall a. StrMap a -isSubmap :: forall a. (P.Eq a) => StrMap a -> StrMap a -> Boolean +-- | Test whether one map contains all of the keys and values contained in another map +isSubmap :: forall a. (Eq a) => StrMap a -> StrMap a -> Boolean isSubmap m1 m2 = all f m1 where - f k v = runFn4 _lookup false (P.(==) v) k m2 + f k v = runFn4 _lookup false ((==) v) k m2 +-- | Test whether a map is empty isEmpty :: forall a. StrMap a -> Boolean isEmpty = all (\_ _ -> false) +-- | Calculate the number of key/value pairs in a map foreign import size """ function size(m) { @@ -209,11 +228,12 @@ foreign import size } """ :: forall a. StrMap a -> Number +-- | Create a map with one key/value pair singleton :: forall a. String -> a -> StrMap a singleton k v = pureST (do s <- SM.new SM.poke s k v - P.return s) + return s) foreign import _lookup """ @@ -222,12 +242,15 @@ foreign import _lookup } """ :: forall a z. Fn4 z (a -> z) String (StrMap a) z +-- | Lookup the value for a key in a map lookup :: forall a. String -> StrMap a -> Maybe a lookup = runFn4 _lookup Nothing Just +-- | Test whether a `String` appears as a key in a map member :: forall a. String -> StrMap a -> Boolean -member = runFn4 _lookup false (P.const true) +member = runFn4 _lookup false (const true) +-- | Insert a key and value into a map insert :: forall a. String -> a -> StrMap a -> StrMap a insert k v = mutate (\s -> SM.poke s k v) @@ -239,22 +262,26 @@ foreign import _unsafeDeleteStrMap } """ :: forall a. Fn2 (StrMap a) String (StrMap a) +-- | Delete a key and value from a map delete :: forall a. String -> StrMap a -> StrMap a delete k = mutate (\s -> SM.delete s k) +-- | Insert, remove or update a value for a key in a map alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a alter f k m = case f (k `lookup` m) of Nothing -> delete k m Just v -> insert k v m +-- | Remove or update a value for a key in a map update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a update f k m = alter (maybe Nothing f) k m +-- | Create a map from an array of key/value pairs fromList :: forall a. [Tuple String a] -> StrMap a fromList l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> SM.poke s k v) - P.return s) + return s) foreign import _lookupST """ @@ -265,11 +292,13 @@ foreign import _lookupST } """ :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z) +-- | Create a map from an array of key/value pairs, using the specified function +-- | to combine values for duplicate keys. fromListWith :: forall a. (a -> a -> a) -> [Tuple String a] -> StrMap a fromListWith f l = pureST (do s <- SM.new - for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s P.>>= SM.poke s k) - P.return s) + for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s >>= SM.poke s k) + return s) foreign import _collect """ @@ -284,9 +313,11 @@ foreign import _collect } """ :: forall a b . (String -> a -> b) -> StrMap a -> [b] +-- | Convert a map into an array of key/value pairs toList :: forall a. StrMap a -> [Tuple String a] toList = _collect Tuple +-- | Get an array of the keys in a map foreign import keys """ var keys = Object.keys || _collect(function(k) { @@ -294,21 +325,25 @@ foreign import keys }); """ :: forall a. StrMap a -> [String] +-- | Get an array of the values in a map values :: forall a. StrMap a -> [a] values = _collect (\_ v -> v) --- left-biased +-- | Compute the union of two maps, preferring the first map in the case of +-- | duplicate keys. union :: forall a. StrMap a -> StrMap a -> StrMap a union m = mutate (\s -> foldM SM.poke s m) +-- | Compute the union of a collection of maps unions :: forall a. [StrMap a] -> StrMap a unions = foldl union empty +-- | Map a function over the values in a map map :: forall a b. (a -> b) -> StrMap a -> StrMap b -map = P.(<$>) +map = (<$>) -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 +instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) where + (<>) m1 m2 = mutate (\s -> foldM (\s k v2 -> SM.poke s k (runFn4 _lookup v2 (\v1 -> v1 <> v2) k m2)) s m1) m2 -instance monoidStrMap :: (P.Semigroup a) => Monoid (StrMap a) where +instance monoidStrMap :: (Semigroup a) => Monoid (StrMap a) where mempty = empty diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs index 2041ab4e..86c9555f 100644 --- a/src/Data/StrMap/ST.purs +++ b/src/Data/StrMap/ST.purs @@ -1,3 +1,7 @@ +-- | Helper functions for working with mutable maps using the `ST` effect. +-- | +-- | This module can be used when performance is important and mutation is a local effect. + module Data.StrMap.ST ( STStrMap() , new @@ -10,6 +14,11 @@ import Control.Monad.Eff import Control.Monad.ST import Data.Maybe +-- | A reference to a mutable map +-- | +-- | The first type parameter represents the memory region which the map belongs to. The second type parameter defines the type of elements of the mutable array. +-- | +-- | The runtime representation of a value of type `STStrMap h a` is the same as that of `StrMap a`, except that mutation is allowed. foreign import data STStrMap :: * -> * -> * foreign import _new @@ -19,9 +28,11 @@ foreign import _new } """ :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) +-- | Create a new, empty mutable map new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) new = _new +-- | Get the value for a key in a mutable map foreign import peek """ function peek(m) { @@ -33,6 +44,7 @@ foreign import peek } """ :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a +-- | Update the value for a key in a mutable map foreign import poke """ function poke(m) { @@ -59,5 +71,6 @@ foreign import _delete } """ :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) +-- | Remove a key and the corresponding value from a mutable map delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) delete = _delete diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs index 45b48c17..de027208 100644 --- a/src/Data/StrMap/ST/Unsafe.purs +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -7,6 +7,9 @@ import Control.Monad.ST (ST()) import Data.StrMap (StrMap()) import Data.StrMap.ST (STStrMap()) +-- | Unsafely get the value for a key in a map. +-- | +-- | This function does not check whether the key exists in the map. foreign import unsafeGet """ function unsafeGet(m) { diff --git a/src/Data/StrMap/Unsafe.purs b/src/Data/StrMap/Unsafe.purs index 7b73736e..d6da9294 100644 --- a/src/Data/StrMap/Unsafe.purs +++ b/src/Data/StrMap/Unsafe.purs @@ -4,7 +4,9 @@ module Data.StrMap.Unsafe import Data.StrMap --- also known as (!) +-- | Unsafely get the value for a key in a map. +-- | +-- | This function does not check whether the key exists in the map. foreign import unsafeIndex """ function unsafeIndex(m) { From 92443d153bdcbd4556b966b25b56a92820fadd5a Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sat, 11 Apr 2015 22:12:37 +0100 Subject: [PATCH 028/125] Updates --- README.md | 8 ++--- bower.json | 3 +- src/Data/Map.purs | 73 ++++++++++++++++++++-------------------- src/Data/StrMap.purs | 76 ++++++++++++++++++++---------------------- tests/Data/Map.purs | 19 +++++------ tests/Data/StrMap.purs | 19 +++++------ 6 files changed, 98 insertions(+), 100 deletions(-) diff --git a/README.md b/README.md index a1766975..9a1da459 100644 --- a/README.md +++ b/README.md @@ -231,7 +231,7 @@ Apply a function to the values in a map #### `size` ``` purescript -size :: forall k v. Map k v -> Number +size :: forall k v. Map k v -> Int ``` Calculate the number of key/value pairs in a map @@ -240,7 +240,7 @@ Calculate the number of key/value pairs in a map ## Module Data.StrMap -This module defines a type of native Javascript maps which +This module defines a type of native Javascript maps which require the keys to be strings. To maximize performance, Javascript objects are not wrapped, @@ -276,7 +276,7 @@ Convert a mutable map into an immutable map runST :: forall a r. (forall h. Eff (st :: ST.ST h | r) (SM.STStrMap h a)) -> Eff r (StrMap a) ``` -Freeze a mutable map, creating an immutable map. Use this function as you would use +Freeze a mutable map, creating an immutable map. Use this function as you would use `Prelude.runST` to freeze a mutable reference. The rank-2 type prevents the map from escaping the scope of `runST`. @@ -496,7 +496,7 @@ Get an array of the values in a map union :: forall a. StrMap a -> StrMap a -> StrMap a ``` -Compute the union of two maps, preferring the first map in the case of +Compute the union of two maps, preferring the first map in the case of duplicate keys. #### `unions` diff --git a/bower.json b/bower.json index 12e1f15f..3f7163e7 100644 --- a/bower.json +++ b/bower.json @@ -30,6 +30,7 @@ "purescript-strings": "~0.4.2", "purescript-math": "~0.1.0", "purescript-maybe": "~0.2.1", - "purescript-tuples": "~0.3.0" + "purescript-tuples": "~0.3.0", + "purescript-integers": "~0.1.0" } } diff --git a/src/Data/Map.purs b/src/Data/Map.purs index f98438d5..0e8e7bf7 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -2,36 +2,37 @@ -- | module Data.Map - ( Map(), - showTree, - empty, - isEmpty, - singleton, - checkValid, - insert, - lookup, - toList, - fromList, - fromListWith, - delete, - member, - alter, - update, - keys, - values, - union, - unionWith, - unions, - map, - size + ( Map() + , showTree + , empty + , isEmpty + , singleton + , checkValid + , insert + , lookup + , toList + , fromList + , fromListWith + , delete + , member + , alter + , update + , keys + , values + , union + , unionWith + , unions + , map + , size ) where -import qualified Data.Array as A -import Data.Maybe -import Data.Tuple -import Data.Monoid (Monoid) import Data.Foldable (foldl, foldMap, foldr, Foldable) +import Data.Int (Int()) +import Data.Maybe (Maybe(..), maybe, isJust) +import Data.Monoid (Monoid) import Data.Traversable (traverse, Traversable) +import Data.Tuple (Tuple(..), uncurry) +import qualified Data.Array as A -- | `Map k v` represents maps from keys of type `k` to values of type `v`. data Map k v @@ -100,12 +101,12 @@ singleton k v = Two Leaf k v Leaf -- | -- | This function is provided for internal use. checkValid :: forall k v. Map k v -> Boolean -checkValid tree = A.length (A.nub (allHeights tree)) == 1 +checkValid tree = A.length (A.nub (allHeights tree)) == one where - allHeights :: forall k v. Map k v -> [Number] - allHeights Leaf = [0] - allHeights (Two left _ _ right) = A.map (\n -> n + 1) (allHeights left ++ allHeights right) - allHeights (Three left _ _ mid _ _ right) = A.map (\n -> n + 1) (allHeights left ++ allHeights mid ++ allHeights right) + allHeights :: forall k v. Map k v -> [Int] + allHeights Leaf = [zero] + allHeights (Two left _ _ right) = A.map (\n -> n + one) (allHeights left ++ allHeights right) + allHeights (Three left _ _ mid _ _ right) = A.map (\n -> n + one) (allHeights left ++ allHeights mid ++ allHeights right) -- | Lookup a value for the specified key lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v @@ -169,17 +170,17 @@ delete = down [] where down :: forall k v. (Ord k) => [TreeContext k v] -> k -> Map k v -> Map k v down ctx _ Leaf = fromZipper ctx Leaf - down ctx k (Two Leaf k1 _ Leaf) + down ctx k (Two Leaf k1 _ Leaf) | k == k1 = up ctx Leaf - down ctx k (Two left k1 v1 right) + down ctx k (Two left k1 v1 right) | k == k1 = let max = maxNode left in removeMaxNode (TwoLeft max.key max.value right : ctx) left | k < k1 = down (TwoLeft k1 v1 right : ctx) k left | otherwise = down (TwoRight left k1 v1 : ctx) k right - down ctx k (Three Leaf k1 v1 Leaf k2 v2 Leaf) + down ctx k (Three Leaf k1 v1 Leaf k2 v2 Leaf) | k == k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) | k == k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) - down ctx k (Three left k1 v1 mid k2 v2 right) + down ctx k (Three left k1 v1 mid k2 v2 right) | k == k1 = let max = maxNode left in removeMaxNode (ThreeLeft max.key max.value mid k2 v2 right : ctx) left | k == k2 = let max = maxNode mid @@ -280,5 +281,5 @@ map :: forall k a b. (a -> b) -> Map k a -> Map k b map = (<$>) -- | Calculate the number of key/value pairs in a map -size :: forall k v. Map k v -> Number +size :: forall k v. Map k v -> Int size = A.length <<< values diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 54ec0e0a..e5130e6a 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -1,49 +1,47 @@ --- | This module defines a type of native Javascript maps which +-- | This module defines a type of native Javascript maps which -- | require the keys to be strings. --- | +-- | -- | To maximize performance, Javascript objects are not wrapped, -- | and some native code is used even when it's not necessary. module Data.StrMap - ( StrMap(), - empty, - isEmpty, - size, - singleton, - insert, - lookup, - toList, - fromList, - fromListWith, - delete, - member, - alter, - update, - keys, - values, - union, - unions, - map, - isSubmap, - fold, - foldMap, - foldM, - foldMaybe, - all, - - thawST, - freezeST, - runST + ( StrMap() + , empty + , isEmpty + , size + , singleton + , insert + , lookup + , toList + , fromList + , fromListWith + , delete + , member + , alter + , update + , keys + , values + , union + , unions + , map + , isSubmap + , fold + , foldMap + , foldM + , foldMaybe + , all + , thawST + , freezeST + , runST ) where import Control.Monad.Eff (Eff(), runPure) import Data.Foldable (Foldable, foldl, foldr, for_) -import Data.Function -import Data.Maybe -import Data.Monoid -import Data.Monoid.All -import Data.Tuple +import Data.Function (Fn2(), runFn2, Fn4(), runFn4) +import Data.Maybe (Maybe(..), maybe, fromMaybe) +import Data.Monoid (Monoid, mempty) import Data.Traversable (Traversable, traverse) +import Data.Tuple (Tuple(..), uncurry) import qualified Control.Monad.ST as ST import qualified Data.Array as A import qualified Data.StrMap.ST as SM @@ -83,9 +81,9 @@ thawST = _copyEff freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a) freezeST = _copyEff --- | Freeze a mutable map, creating an immutable map. Use this function as you would use +-- | Freeze a mutable map, creating an immutable map. Use this function as you would use -- | `Prelude.runST` to freeze a mutable reference. --- | +-- | -- | The rank-2 type prevents the map from escaping the scope of `runST`. foreign import runST """ @@ -329,7 +327,7 @@ foreign import keys values :: forall a. StrMap a -> [a] values = _collect (\_ v -> v) --- | Compute the union of two maps, preferring the first map in the case of +-- | Compute the union of two maps, preferring the first map in the case of -- | duplicate keys. union :: forall a. StrMap a -> StrMap a -> StrMap a union m = mutate (\s -> foldM SM.poke s m) diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index f6e912a0..250c7d77 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -1,16 +1,15 @@ module Tests.Data.Map where -import Debug.Trace - import Control.Alt ((<|>)) -import Data.Maybe -import Data.Tuple import Data.Array (groupBy, map, length, nubBy, sortBy) -import Data.Function (on) import Data.Foldable (foldl, for_) - -import Test.QuickCheck - +import Data.Function (on) +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Int (fromNumber) +import Data.Tuple (Tuple(..), fst) +import Debug.Trace +import Test.QuickCheck ((), quickCheck, quickCheck') +import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import qualified Data.Map as M instance arbMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (M.Map k v) where @@ -129,7 +128,7 @@ mapTests = do ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) trace "Check balance property" - quickCheck' 5000 $ \instrs -> + quickCheck' (fromNumber 5000) $ \instrs -> let tree :: M.Map SmallKey Number tree = runInstructions instrs M.empty @@ -142,7 +141,7 @@ mapTests = do quickCheck $ \k v -> M.lookup (k :: SmallKey) (M.singleton k (v :: Number)) == Just v trace "Random lookup" - quickCheck' 5000 $ \instrs k v -> + quickCheck' (fromNumber 5000) $ \instrs k v -> let tree :: M.Map SmallKey Number tree = M.insert k v (runInstructions instrs M.empty) diff --git a/tests/Data/StrMap.purs b/tests/Data/StrMap.purs index 63a37fd5..c31a9788 100644 --- a/tests/Data/StrMap.purs +++ b/tests/Data/StrMap.purs @@ -1,16 +1,15 @@ module Tests.Data.StrMap where -import Debug.Trace - -import Data.Maybe -import Data.Tuple -import qualified Data.String as S import Data.Array (groupBy, map, sortBy) -import Data.Function (on) import Data.Foldable (foldl) - -import Test.QuickCheck - +import Data.Function (on) +import Data.Maybe (Maybe(..)) +import Data.Int (fromNumber) +import Data.Tuple (Tuple(..), fst, zip) +import Debug.Trace +import Test.QuickCheck ((), quickCheck, quickCheck') +import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import qualified Data.String as S import qualified Data.StrMap as M instance arbStrMap :: (Arbitrary v) => Arbitrary (M.StrMap v) where @@ -70,7 +69,7 @@ strMapTests = do quickCheck $ \k v -> M.lookup k (M.singleton k (v :: Number)) == Just v trace "Random lookup" - quickCheck' 5000 $ \instrs k v -> + quickCheck' (fromNumber 5000) $ \instrs k v -> let tree :: M.StrMap Number tree = M.insert k v (runInstructions instrs M.empty) From 9621548a95174cacd9f07aed7b0f1a17ac4f8307 Mon Sep 17 00:00:00 2001 From: Angus Thomsen Date: Sat, 18 Apr 2015 10:18:46 +1000 Subject: [PATCH 029/125] provide ord instance for map --- src/Data/Map.purs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index f98438d5..91dc3b36 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -46,6 +46,9 @@ instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where instance showMap :: (Show k, Show v) => Show (Map k v) where show m = "fromList " ++ show (toList m) +instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where + compare m1 m2 = compare (toList m1) (toList m2) + instance semigroupMap :: (Ord k) => Semigroup (Map k v) where (<>) = union From e0ddf77f9bde7a5dbdc7d01f0d727f65d436c953 Mon Sep 17 00:00:00 2001 From: Angus Thomsen Date: Sat, 18 Apr 2015 10:20:41 +1000 Subject: [PATCH 030/125] Add ord instance to docs --- README.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/README.md b/README.md index a1766975..22274625 100644 --- a/README.md +++ b/README.md @@ -28,6 +28,13 @@ instance showMap :: (Show k, Show v) => Show (Map k v) ``` +#### `ordMap` + +``` purescript +instance ordMap :: (Ord k, Ord v) => Ord (Map k v) +``` + + #### `semigroupMap` ``` purescript From 366a5c754a76b808fe3a630de5036f0f583565ea Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Mon, 20 Apr 2015 10:49:02 -0700 Subject: [PATCH 031/125] Bump dependencies --- bower.json | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/bower.json b/bower.json index 3f7163e7..6886d4ff 100644 --- a/bower.json +++ b/bower.json @@ -22,15 +22,18 @@ "package.json" ], "devDependencies": { - "purescript-quickcheck": "~0.5.0" + "purescript-quickcheck": "~0.6.0" }, "dependencies": { - "purescript-arrays": "~0.3.0", - "purescript-foldable-traversable": "~0.3.0", - "purescript-strings": "~0.4.2", - "purescript-math": "~0.1.0", - "purescript-maybe": "~0.2.1", - "purescript-tuples": "~0.3.0", - "purescript-integers": "~0.1.0" + "purescript-arrays": "~0.4.0", + "purescript-foldable-traversable": "~0.4.0", + "purescript-strings": "~0.5.0", + "purescript-math": "~0.1.1", + "purescript-maybe": "~0.3.0", + "purescript-tuples": "~0.4.0", + "purescript-integers": "~0.2.0", + "purescript-prelude": "~0.1.0", + "purescript-eff": "~0.1.0", + "purescript-st": "~0.1.0" } } From cd2297bf9f6222a954d65ec70dd18257a7e000a8 Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Fri, 5 Jun 2015 18:44:20 -0700 Subject: [PATCH 032/125] Updates for 0.7 --- src/Data/Map.purs | 177 ++++++++++++++++---------------- src/Data/StrMap.js | 112 ++++++++++++++++++++ src/Data/StrMap.purs | 181 ++++++--------------------------- src/Data/StrMap/ST.js | 36 +++++++ src/Data/StrMap/ST.purs | 46 ++------- src/Data/StrMap/ST/Unsafe.js | 10 ++ src/Data/StrMap/ST/Unsafe.purs | 11 +- src/Data/StrMap/Unsafe.js | 10 ++ src/Data/StrMap/Unsafe.purs | 11 +- tests/Data/Map.purs | 2 + tests/Data/StrMap.purs | 4 +- tests/Tests.purs | 2 + 12 files changed, 304 insertions(+), 298 deletions(-) create mode 100644 src/Data/StrMap.js create mode 100644 src/Data/StrMap/ST.js create mode 100644 src/Data/StrMap/ST/Unsafe.js create mode 100644 src/Data/StrMap/Unsafe.js diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 995ab174..fe9aaff1 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -22,17 +22,19 @@ module Data.Map , union , unionWith , unions - , map , size ) where +import Prelude + import Data.Foldable (foldl, foldMap, foldr, Foldable) -import Data.Int (Int()) +import Data.Int () import Data.Maybe (Maybe(..), maybe, isJust) import Data.Monoid (Monoid) import Data.Traversable (traverse, Traversable) import Data.Tuple (Tuple(..), uncurry) -import qualified Data.Array as A + +import Data.List (List(..), length, nub) -- | `Map k v` represents maps from keys of type `k` to values of type `v`. data Map k v @@ -41,8 +43,7 @@ data Map k v | Three (Map k v) k v (Map k v) k v (Map k v) instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where - (==) m1 m2 = toList m1 == toList m2 - (/=) m1 m2 = not (m1 == m2) + eq m1 m2 = toList m1 == toList m2 instance showMap :: (Show k, Show v) => Show (Map k v) where show m = "fromList " ++ show (toList m) @@ -51,15 +52,15 @@ instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where compare m1 m2 = compare (toList m1) (toList m2) instance semigroupMap :: (Ord k) => Semigroup (Map k v) where - (<>) = union + append = union instance monoidMap :: (Ord k) => Monoid (Map k v) where mempty = empty instance functorMap :: Functor (Map k) where - (<$>) _ Leaf = Leaf - (<$>) f (Two left k v right) = Two (f <$> left) k (f v) (f <$> right) - (<$>) f (Three left k1 v1 mid k2 v2 right) = Three (f <$> left) k1 (f v1) (f <$> mid) k2 (f v2) (f <$> right) + map _ Leaf = Leaf + map f (Two left k v right) = Two (map f left) k (f v) (map f right) + map f (Three left k1 v1 mid k2 v2 right) = Three (map f left) k1 (f v1) (map f mid) k2 (f v2) (map f right) instance foldableMap :: Foldable (Map k) where foldl f z m = foldl f z (values m) @@ -104,12 +105,12 @@ singleton k v = Two Leaf k v Leaf -- | -- | This function is provided for internal use. checkValid :: forall k v. Map k v -> Boolean -checkValid tree = A.length (A.nub (allHeights tree)) == one +checkValid tree = length (nub (allHeights tree)) == one where - allHeights :: forall k v. Map k v -> [Int] - allHeights Leaf = [zero] - allHeights (Two left _ _ right) = A.map (\n -> n + one) (allHeights left ++ allHeights right) - allHeights (Three left _ _ mid _ _ right) = A.map (\n -> n + one) (allHeights left ++ allHeights mid ++ allHeights right) + allHeights :: forall k v. Map k v -> List Int + allHeights Leaf = pure zero + allHeights (Two left _ _ right) = map (\n -> n + one) (allHeights left ++ allHeights right) + allHeights (Three left _ _ mid _ _ right) = map (\n -> n + one) (allHeights left ++ allHeights mid ++ allHeights right) -- | Lookup a value for the specified key lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v @@ -134,83 +135,83 @@ data TreeContext k v | ThreeMiddle (Map k v) k v k v (Map k v) | ThreeRight (Map k v) k v (Map k v) k v -fromZipper :: forall k v. (Ord k) => [TreeContext k v] -> Map k v -> Map k v -fromZipper [] tree = tree -fromZipper (TwoLeft k1 v1 right : ctx) left = fromZipper ctx (Two left k1 v1 right) -fromZipper (TwoRight left k1 v1 : ctx) right = fromZipper ctx (Two left k1 v1 right) -fromZipper (ThreeLeft k1 v1 mid k2 v2 right : ctx) left = fromZipper ctx (Three left k1 v1 mid k2 v2 right) -fromZipper (ThreeMiddle left k1 v1 k2 v2 right : ctx) mid = fromZipper ctx (Three left k1 v1 mid k2 v2 right) -fromZipper (ThreeRight left k1 v1 mid k2 v2 : ctx) right = fromZipper ctx (Three left k1 v1 mid k2 v2 right) +fromZipper :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v +fromZipper Nil tree = tree +fromZipper (Cons (TwoLeft k1 v1 right) ctx) left = fromZipper ctx (Two left k1 v1 right) +fromZipper (Cons (TwoRight left k1 v1) ctx) right = fromZipper ctx (Two left k1 v1 right) +fromZipper (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) left = fromZipper ctx (Three left k1 v1 mid k2 v2 right) +fromZipper (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) mid = fromZipper ctx (Three left k1 v1 mid k2 v2 right) +fromZipper (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right = fromZipper ctx (Three left k1 v1 mid k2 v2 right) data KickUp k v = KickUp (Map k v) k v (Map k v) -- | Insert a key/value pair into a map insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v -insert = down [] +insert = down Nil where - down :: forall k v. (Ord k) => [TreeContext k v] -> k -> v -> Map k v -> Map k v + down :: forall k v. (Ord k) => List (TreeContext k v) -> k -> v -> Map k v -> Map k v down ctx k v Leaf = up ctx (KickUp Leaf k v Leaf) down ctx k v (Two left k1 _ right) | k == k1 = fromZipper ctx (Two left k v right) - down ctx k v (Two left k1 v1 right) | k < k1 = down (TwoLeft k1 v1 right : ctx) k v left - down ctx k v (Two left k1 v1 right) = down (TwoRight left k1 v1 : ctx) k v right + down ctx k v (Two left k1 v1 right) | k < k1 = down (Cons (TwoLeft k1 v1 right) ctx) k v left + down ctx k v (Two left k1 v1 right) = down (Cons (TwoRight left k1 v1) ctx) k v right down ctx k v (Three left k1 _ mid k2 v2 right) | k == k1 = fromZipper ctx (Three left k v mid k2 v2 right) down ctx k v (Three left k1 v1 mid k2 _ right) | k == k2 = fromZipper ctx (Three left k1 v1 mid k v right) - down ctx k v (Three left k1 v1 mid k2 v2 right) | k < k1 = down (ThreeLeft k1 v1 mid k2 v2 right : ctx) k v left - down ctx k v (Three left k1 v1 mid k2 v2 right) | k1 < k && k <= k2 = down (ThreeMiddle left k1 v1 k2 v2 right : ctx) k v mid - down ctx k v (Three left k1 v1 mid k2 v2 right) = down (ThreeRight left k1 v1 mid k2 v2 : ctx) k v right - - up :: forall k v. (Ord k) => [TreeContext k v] -> KickUp k v -> Map k v - up [] (KickUp left k v right) = Two left k v right - up (TwoLeft k1 v1 right : ctx) (KickUp left k v mid) = fromZipper ctx (Three left k v mid k1 v1 right) - up (TwoRight left k1 v1 : ctx) (KickUp mid k v right) = fromZipper ctx (Three left k1 v1 mid k v right) - up (ThreeLeft k1 v1 c k2 v2 d : ctx) (KickUp a k v b) = up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) - up (ThreeMiddle a k1 v1 k2 v2 d : ctx) (KickUp b k v c) = up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) - up (ThreeRight a k1 v1 b k2 v2 : ctx) (KickUp c k v d) = up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) + down ctx k v (Three left k1 v1 mid k2 v2 right) | k < k1 = down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left + down ctx k v (Three left k1 v1 mid k2 v2 right) | k1 < k && k <= k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid + down ctx k v (Three left k1 v1 mid k2 v2 right) = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right + + up :: forall k v. (Ord k) => List (TreeContext k v) -> KickUp k v -> Map k v + up Nil (KickUp left k v right) = Two left k v right + up (Cons (TwoLeft k1 v1 right) ctx) (KickUp left k v mid) = fromZipper ctx (Three left k v mid k1 v1 right) + up (Cons (TwoRight left k1 v1) ctx) (KickUp mid k v right) = fromZipper ctx (Three left k1 v1 mid k v right) + up (Cons (ThreeLeft k1 v1 c k2 v2 d) ctx) (KickUp a k v b) = up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) + up (Cons (ThreeMiddle a k1 v1 k2 v2 d) ctx) (KickUp b k v c) = up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) + up (Cons (ThreeRight a k1 v1 b k2 v2) ctx) (KickUp c k v d) = up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) -- | Delete a key and its corresponding value from a map delete :: forall k v. (Ord k) => k -> Map k v -> Map k v -delete = down [] +delete = down Nil where - down :: forall k v. (Ord k) => [TreeContext k v] -> k -> Map k v -> Map k v + down :: forall k v. (Ord k) => List (TreeContext k v) -> k -> Map k v -> Map k v down ctx _ Leaf = fromZipper ctx Leaf down ctx k (Two Leaf k1 _ Leaf) | k == k1 = up ctx Leaf down ctx k (Two left k1 v1 right) | k == k1 = let max = maxNode left - in removeMaxNode (TwoLeft max.key max.value right : ctx) left - | k < k1 = down (TwoLeft k1 v1 right : ctx) k left - | otherwise = down (TwoRight left k1 v1 : ctx) k right + in removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left + | k < k1 = down (Cons (TwoLeft k1 v1 right) ctx) k left + | otherwise = down (Cons (TwoRight left k1 v1) ctx) k right down ctx k (Three Leaf k1 v1 Leaf k2 v2 Leaf) | k == k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) | k == k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) down ctx k (Three left k1 v1 mid k2 v2 right) | k == k1 = let max = maxNode left - in removeMaxNode (ThreeLeft max.key max.value mid k2 v2 right : ctx) left + in removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left | k == k2 = let max = maxNode mid - in removeMaxNode (ThreeMiddle left k1 v1 max.key max.value right : ctx) mid - | k < k1 = down (ThreeLeft k1 v1 mid k2 v2 right : ctx) k left - | k1 < k && k < k2 = down (ThreeMiddle left k1 v1 k2 v2 right : ctx) k mid - | otherwise = down (ThreeRight left k1 v1 mid k2 v2 : ctx) k right - - up :: forall k v. (Ord k) => [TreeContext k v] -> Map k v -> Map k v - up [] tree = tree - up (TwoLeft k1 v1 Leaf : ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) - up (TwoRight Leaf k1 v1 : ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) - up (TwoLeft k1 v1 (Two m k2 v2 r) : ctx) l = up ctx (Three l k1 v1 m k2 v2 r) - up (TwoRight (Two l k1 v1 m) k2 v2 : ctx) r = up ctx (Three l k1 v1 m k2 v2 r) - up (TwoLeft k1 v1 (Three b k2 v2 c k3 v3 d) : ctx) a = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - up (TwoRight (Three a k1 v1 b k2 v2 c) k3 v3 : ctx) d = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - up (ThreeLeft k1 v1 Leaf k2 v2 Leaf : ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - up (ThreeMiddle Leaf k1 v1 k2 v2 Leaf : ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - up (ThreeRight Leaf k1 v1 Leaf k2 v2 : ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - up (ThreeLeft k1 v1 (Two b k2 v2 c) k3 v3 d : ctx) a = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - up (ThreeMiddle (Two a k1 v1 b) k2 v2 k3 v3 d : ctx) c = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - up (ThreeMiddle a k1 v1 k2 v2 (Two c k3 v3 d) : ctx) b = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - up (ThreeRight a k1 v1 (Two b k2 v2 c) k3 v3 : ctx) d = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - up (ThreeLeft k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 e : ctx) a = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - up (ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e : ctx) d = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - up (ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e) : ctx) b = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - up (ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 : ctx) e = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) + in removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid + | k < k1 = down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k left + | k1 < k && k < k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid + | otherwise = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right + + up :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v + up Nil tree = tree + up (Cons (TwoLeft k1 v1 Leaf) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) + up (Cons (TwoRight Leaf k1 v1) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) + up (Cons (TwoLeft k1 v1 (Two m k2 v2 r)) ctx) l = up ctx (Three l k1 v1 m k2 v2 r) + up (Cons (TwoRight (Two l k1 v1 m) k2 v2) ctx) r = up ctx (Three l k1 v1 m k2 v2 r) + up (Cons (TwoLeft k1 v1 (Three b k2 v2 c k3 v3 d)) ctx) a = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) + up (Cons (TwoRight (Three a k1 v1 b k2 v2 c) k3 v3) ctx) d = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) + up (Cons (ThreeLeft k1 v1 Leaf k2 v2 Leaf) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + up (Cons (ThreeMiddle Leaf k1 v1 k2 v2 Leaf) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + up (Cons (ThreeRight Leaf k1 v1 Leaf k2 v2) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + up (Cons (ThreeLeft k1 v1 (Two b k2 v2 c) k3 v3 d) ctx) a = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) + up (Cons (ThreeMiddle (Two a k1 v1 b) k2 v2 k3 v3 d) ctx) c = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) + up (Cons (ThreeMiddle a k1 v1 k2 v2 (Two c k3 v3 d)) ctx) b = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) + up (Cons (ThreeRight a k1 v1 (Two b k2 v2 c) k3 v3) ctx) d = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) + up (Cons (ThreeLeft k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 e) ctx) a = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) + up (Cons (ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e) ctx) d = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) + up (Cons (ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e)) ctx) b = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) + up (Cons (ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4) ctx) e = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) maxNode :: forall k v. (Ord k) => Map k v -> { key :: k, value :: v } maxNode (Two _ k v Leaf) = { key: k, value: v } @@ -218,11 +219,11 @@ delete = down [] maxNode (Three _ _ _ _ k v Leaf) = { key: k, value: v } maxNode (Three _ _ _ _ _ _ right) = maxNode right - removeMaxNode :: forall k v. (Ord k) => [TreeContext k v] -> Map k v -> Map k v + removeMaxNode :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v removeMaxNode ctx (Two Leaf _ _ Leaf) = up ctx Leaf - removeMaxNode ctx (Two left k v right) = removeMaxNode (TwoRight left k v : ctx) right - removeMaxNode ctx (Three Leaf k1 v1 Leaf _ _ Leaf) = up (TwoRight Leaf k1 v1 : ctx) Leaf - removeMaxNode ctx (Three left k1 v1 mid k2 v2 right) = removeMaxNode (ThreeRight left k1 v1 mid k2 v2 : ctx) right + removeMaxNode ctx (Two left k v right) = removeMaxNode (Cons (TwoRight left k v) ctx) right + removeMaxNode ctx (Three Leaf k1 v1 Leaf _ _ Leaf) = up (Cons (TwoRight Leaf k1 v1) ctx) Leaf + removeMaxNode ctx (Three left k1 v1 mid k2 v2 right) = removeMaxNode (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right -- | Insert the value, delete a value, or update a value for a key in a map alter :: forall k v. (Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v @@ -235,33 +236,33 @@ update :: forall k v. (Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v update f k m = alter (maybe Nothing f) k m -- | Convert a map to an array of key/value pairs -toList :: forall k v. Map k v -> [Tuple k v] -toList Leaf = [] -toList (Two left k v right) = toList left ++ [Tuple k v] ++ toList right -toList (Three left k1 v1 mid k2 v2 right) = toList left ++ [Tuple k1 v1] ++ toList mid ++ [Tuple k2 v2] ++ toList right +toList :: forall k v. Map k v -> List (Tuple k v) +toList Leaf = Nil +toList (Two left k v right) = toList left ++ pure (Tuple k v) ++ toList right +toList (Three left k1 v1 mid k2 v2 right) = toList left ++ pure (Tuple k1 v1) ++ toList mid ++ pure (Tuple k2 v2) ++ toList right -- | Create a map from an array of key/value pairs -fromList :: forall k v. (Ord k) => [Tuple k v] -> Map k v +fromList :: forall k v. (Ord k) => List (Tuple k v) -> Map k v fromList = foldl (\m (Tuple k v) -> insert k v m) empty -- | Create a map from an array of key/value pairs, using the specified function -- | to combine values for duplicate keys. -fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> [Tuple k v] -> Map k v +fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> List (Tuple k v) -> Map k v fromListWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where combine v (Just v') = Just $ f v v' combine v Nothing = Just v -- | Get an array of the keys contained in a map -keys :: forall k v. Map k v -> [k] -keys Leaf = [] -keys (Two left k _ right) = keys left ++ [k] ++ keys right -keys (Three left k1 _ mid k2 _ right) = keys left ++ [k1] ++ keys mid ++ [k2] ++ keys right +keys :: forall k v. Map k v -> List k +keys Leaf = Nil +keys (Two left k _ right) = keys left ++ pure k ++ keys right +keys (Three left k1 _ mid k2 _ right) = keys left ++ pure k1 ++ keys mid ++ pure k2 ++ keys right -- | Get an array of the values contained in a map -values :: forall k v. Map k v -> [v] -values Leaf = [] -values (Two left _ v right) = values left ++ [v] ++ values right -values (Three left _ v1 mid _ v2 right) = values left ++ [v1] ++ values mid ++ [v2] ++ values right +values :: forall k v. Map k v -> List v +values Leaf = Nil +values (Two left _ v right) = values left ++ pure v ++ values right +values (Three left _ v1 mid _ v2 right) = values left ++ pure v1 ++ values mid ++ pure v2 ++ values right -- | Compute the union of two maps, using the specified function -- | to combine values for duplicate keys. @@ -276,13 +277,9 @@ union :: forall k v. (Ord k) => Map k v -> Map k v -> Map k v union = unionWith const -- | Compute the union of a collection of maps -unions :: forall k v. (Ord k) => [Map k v] -> Map k v +unions :: forall k v. (Ord k) => List (Map k v) -> Map k v unions = foldl union empty --- | Apply a function to the values in a map -map :: forall k a b. (a -> b) -> Map k a -> Map k b -map = (<$>) - -- | Calculate the number of key/value pairs in a map size :: forall k v. Map k v -> Int -size = A.length <<< values +size = length <<< values diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js new file mode 100644 index 00000000..02d4661d --- /dev/null +++ b/src/Data/StrMap.js @@ -0,0 +1,112 @@ +/* global exports */ +"use strict"; + +// module Data.StrMap + +exports._copy = (m) { + var r = {}; + for (var k in m) { + r[k] = m[k]; + } + return r; +}; + +exports._copyEff = function(m) { + return function() { + var r = {}; + for (var k in m) { + r[k] = m[k]; + } + return r; + }; +}; + +exports.empty = {}; + +exports.runST = function(f) { + return f; +}; + +exports._fmapStrMap = function(m0, f) { + var m = {}; + for (var k in m0) { + m[k] = f(m0[k]); + } + return m; +}; + +exports._foldM = function(bind) { + return function(f) { + return function(mz) { + return function(m) { + function g(k) { + return function (z) { + return f(z)(k)(m[k]); + }; + } + for (var k in m) { + mz = bind(mz)(g(k)); + } + return mz; + }; + }; + }; +}; + +exports._foldSCStrMap = function(m, z, f, fromMaybe) { + for (var k in m) { + var maybeR = f(z)(k)(m[k]); + var r = fromMaybe(null)(maybeR); + if (r === null) return z; + else z = r; + } + return z; +}; + +exports.all = function(f) { + return function(m) { + for (var k in m) { + if (!f(k)(m[k])) return false; + } + return true; + }; +}; + +exports.size = function(m) { + var s = 0; + for (var k in m) { + ++s; + } + return s; +}; + +exports._lookup = function(no, yes, k, m) { + return k in m ? yes(m[k]) : no; +}; + +exports._unsafeDeleteStrMap = function(m, k) { + delete m[k]; + return m; +}; + +exports._lookupST = function(no, yes, k, m) { + return function() { + return k in m ? yes(m[k]) : no; + } +}; + +function _collect(f) { + return function(m) { + var r = []; + for (var k in m) { + r.push(f(k)(m[k])); + } + return r; + }; +}; + +exports._collect = _collect; + +exports.keys = Object.keys || _collect(function(k) { + return function() { return k; }; +}); \ No newline at end of file diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index e5130e6a..3b75e2fd 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -23,7 +23,6 @@ module Data.StrMap , values , union , unions - , map , isSubmap , fold , foldMap @@ -35,6 +34,8 @@ module Data.StrMap , runST ) where +import Prelude + import Control.Monad.Eff (Eff(), runPure) import Data.Foldable (Foldable, foldl, foldr, for_) import Data.Function (Fn2(), runFn2, Fn4(), runFn4) @@ -42,36 +43,16 @@ import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Monoid (Monoid, mempty) import Data.Traversable (Traversable, traverse) import Data.Tuple (Tuple(..), uncurry) +import qualified Data.List as L import qualified Control.Monad.ST as ST -import qualified Data.Array as A import qualified Data.StrMap.ST as SM -- | `StrMap a` represents a map from `String`s to values of type `a`. foreign import data StrMap :: * -> * -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() { - var r = {}; - for (var k in m) { - r[k] = m[k]; - } - return r; - }; - } - """ :: forall a b h r. a -> Eff (st :: ST.ST h | r) b +foreign import _copy :: forall a. StrMap a -> StrMap a + +foreign import _copyEff :: forall a b h r. a -> Eff (st :: ST.ST h | r) b -- | Convert an immutable map into a mutable map thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a) @@ -85,12 +66,7 @@ freezeST = _copyEff -- | `Prelude.runST` to freeze a mutable reference. -- | -- | The rank-2 type prevents the map from escaping the scope of `runST`. -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) +foreign import runST :: 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) @@ -101,40 +77,12 @@ mutate f m = pureST (do f s return s) -foreign import _fmapStrMap - """ - function _fmapStrMap(m0, f) { - var m = {}; - for (var k in m0) { - m[k] = f(m0[k]); - } - return m; - } - """ :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b) +foreign import _fmapStrMap :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b) instance functorStrMap :: Functor StrMap where - (<$>) f m = runFn2 _fmapStrMap m f - -foreign import _foldM - """ - function _foldM(bind) { - return function(f) { - return function(mz) { - return function(m) { - function g(k) { - return function (z) { - return f(z)(k)(m[k]); - }; - } - for (var k in m) { - mz = bind(mz)(g(k)); - } - return mz; - }; - }; - }; - } - """ :: forall a m z. (m -> (z -> m) -> m) -> (z -> String -> a -> m) -> m -> StrMap a -> m + map f m = runFn2 _fmapStrMap m f + +foreign import _foldM :: forall a m z. (m -> (z -> m) -> m) -> (z -> String -> a -> m) -> m -> StrMap a -> m -- | Fold the keys and values of a map fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z @@ -156,24 +104,13 @@ instance foldableStrMap :: Foldable StrMap where foldMap f = foldMap (const f) instance traversableStrMap :: Traversable StrMap where - traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) (((<$>) (uncurry singleton)) <$> (traverse f <$> toList ms)) + traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toList ms)) sequence = traverse id -- Unfortunately the above are not short-circuitable (consider using purescript-machines) -- so we need special cases: -foreign import _foldSCStrMap - """ - function _foldSCStrMap(m, z, f, fromMaybe) { - for (var k in m) { - 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 +foreign import _foldSCStrMap :: forall a z. Fn4 (StrMap a) z (z -> String -> a -> Maybe z) (forall a. a -> Maybe a -> a) z -- | Fold the keys and values of a map. -- | @@ -183,27 +120,16 @@ foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z foldMaybe f z m = runFn4 _foldSCStrMap m z f fromMaybe -- | Test whether all key/value pairs in a `StrMap` satisfy a predicate. -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 +foreign import all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean instance eqStrMap :: (Eq a) => Eq (StrMap a) where - (==) m1 m2 = (isSubmap m1 m2) && (isSubmap m2 m1) - (/=) m1 m2 = not (m1 == m2) + eq m1 m2 = (isSubmap m1 m2) && (isSubmap m2 m1) instance showStrMap :: (Show a) => Show (StrMap a) where show m = "fromList " ++ show (toList m) -- | An empty map -foreign import empty "var empty = {};" :: forall a. StrMap a +foreign import empty :: forall a. StrMap a -- | Test whether one map contains all of the keys and values contained in another map isSubmap :: forall a. (Eq a) => StrMap a -> StrMap a -> Boolean @@ -215,16 +141,7 @@ isEmpty :: forall a. StrMap a -> Boolean isEmpty = all (\_ _ -> false) -- | Calculate the number of key/value pairs in a map -foreign import size - """ - function size(m) { - var s = 0; - for (var k in m) { - ++s; - } - return s; - } - """ :: forall a. StrMap a -> Number +foreign import size :: forall a. StrMap a -> Number -- | Create a map with one key/value pair singleton :: forall a. String -> a -> StrMap a @@ -233,12 +150,7 @@ singleton k v = pureST (do SM.poke s k v return s) -foreign import _lookup - """ - 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 +foreign import _lookup :: forall a z. Fn4 z (a -> z) String (StrMap a) z -- | Lookup the value for a key in a map lookup :: forall a. String -> StrMap a -> Maybe a @@ -252,13 +164,7 @@ member = runFn4 _lookup false (const true) insert :: forall a. String -> a -> StrMap a -> StrMap a insert k v = mutate (\s -> SM.poke s k v) -foreign import _unsafeDeleteStrMap - """ - function _unsafeDeleteStrMap(m, k) { - delete m[k]; - return m; - } - """ :: forall a. Fn2 (StrMap a) String (StrMap a) +foreign import _unsafeDeleteStrMap :: forall a. Fn2 (StrMap a) String (StrMap a) -- | Delete a key and value from a map delete :: forall a. String -> StrMap a -> StrMap a @@ -275,57 +181,34 @@ update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a update f k m = alter (maybe Nothing f) k m -- | Create a map from an array of key/value pairs -fromList :: forall a. [Tuple String a] -> StrMap a +fromList :: forall a. L.List (Tuple String a) -> StrMap a fromList l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> SM.poke s k v) return s) -foreign import _lookupST - """ - function _lookupST(no, yes, k, m) { - return function() { - return k in m ? yes(m[k]) : no; - } - } - """ :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z) +foreign import _lookupST :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z) -- | Create a map from an array of key/value pairs, using the specified function -- | to combine values for duplicate keys. -fromListWith :: forall a. (a -> a -> a) -> [Tuple String a] -> StrMap a +fromListWith :: forall a. (a -> a -> a) -> L.List (Tuple String a) -> StrMap a fromListWith f l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s >>= SM.poke s k) 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] +foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array b -- | Convert a map into an array of key/value pairs -toList :: forall a. StrMap a -> [Tuple String a] -toList = _collect Tuple +toList :: forall a. StrMap a -> L.List (Tuple String a) +toList = L.toList <<< _collect Tuple -- | Get an array of the keys in a map -foreign import keys - """ - var keys = Object.keys || _collect(function(k) { - return function() { return k; }; - }); - """ :: forall a. StrMap a -> [String] +foreign import keys :: forall a. StrMap a -> Array String -- | Get an array of the values in a map -values :: forall a. StrMap a -> [a] -values = _collect (\_ v -> v) +values :: forall a. StrMap a -> L.List a +values = L.toList <<< _collect (\_ v -> v) -- | Compute the union of two maps, preferring the first map in the case of -- | duplicate keys. @@ -333,15 +216,11 @@ union :: forall a. StrMap a -> StrMap a -> StrMap a union m = mutate (\s -> foldM SM.poke s m) -- | Compute the union of a collection of maps -unions :: forall a. [StrMap a] -> StrMap a +unions :: forall a. L.List (StrMap a) -> StrMap a unions = foldl union empty --- | Map a function over the values in a map -map :: forall a b. (a -> b) -> StrMap a -> StrMap b -map = (<$>) - instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) where - (<>) m1 m2 = mutate (\s -> foldM (\s k v2 -> SM.poke s k (runFn4 _lookup v2 (\v1 -> v1 <> v2) k m2)) s m1) m2 + append m1 m2 = mutate (\s1 -> foldM (\s2 k v2 -> SM.poke s2 k (runFn4 _lookup v2 (\v1 -> v1 <> v2) k m2)) s1 m1) m2 instance monoidStrMap :: (Semigroup a) => Monoid (StrMap a) where mempty = empty diff --git a/src/Data/StrMap/ST.js b/src/Data/StrMap/ST.js new file mode 100644 index 00000000..43a27bb8 --- /dev/null +++ b/src/Data/StrMap/ST.js @@ -0,0 +1,36 @@ +/* global exports */ +"use strict"; + +// module Data.StrMap.ST + +exports._new = function() { + return {}; +}; + +exports.peek = function(m) { + return function(k) { + return function() { + return m[k]; + } + } +}; + +exports.poke = function(m) { + return function(k) { + return function(v) { + return function() { + m[k] = v; + return m; + }; + }; + }; +}; + +exports._delete = function(m) { + return function(k) { + return function() { + delete m[k]; + return m; + }; + }; +}; \ No newline at end of file diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs index 86c9555f..dd435e08 100644 --- a/src/Data/StrMap/ST.purs +++ b/src/Data/StrMap/ST.purs @@ -10,6 +10,8 @@ module Data.StrMap.ST , delete ) where +import Prelude + import Control.Monad.Eff import Control.Monad.ST import Data.Maybe @@ -21,55 +23,19 @@ import Data.Maybe -- | The runtime representation of a value of type `STStrMap h a` is the same as that of `StrMap a`, except that mutation is allowed. foreign import data STStrMap :: * -> * -> * -foreign import _new - """ - function _new() { - return {}; - } - """ :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) +foreign import _new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) -- | Create a new, empty mutable map new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) new = _new -- | Get the value for a key in a mutable map -foreign import peek - """ - function peek(m) { - return function(k) { - return function() { - return m[k]; - } - } - } - """ :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a +foreign import peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a -- | Update the value for a key in a mutable map -foreign import poke - """ - function poke(m) { - return function(k) { - return function(v) { - return function() { - m[k] = v; - return m; - }; - }; - }; - } - """ :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) +foreign import poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) -foreign import _delete - """ - function _delete(m) { - return function(k) { - return function() { - delete m[k]; - return m; - }; - }; - } - """ :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) +foreign import _delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) -- | Remove a key and the corresponding value from a mutable map delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) diff --git a/src/Data/StrMap/ST/Unsafe.js b/src/Data/StrMap/ST/Unsafe.js new file mode 100644 index 00000000..46df269e --- /dev/null +++ b/src/Data/StrMap/ST/Unsafe.js @@ -0,0 +1,10 @@ +/* global exports */ +"use strict"; + +// module Data.StrMap.ST.Unsafe + +exports.unsafeGet = function(m) { + return function() { + return m; + } +}; \ No newline at end of file diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs index de027208..eeb1aa1f 100644 --- a/src/Data/StrMap/ST/Unsafe.purs +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -2,6 +2,8 @@ module Data.StrMap.ST.Unsafe ( unsafeGet ) where +import Prelude + import Control.Monad.Eff (Eff()) import Control.Monad.ST (ST()) import Data.StrMap (StrMap()) @@ -10,11 +12,4 @@ import Data.StrMap.ST (STStrMap()) -- | Unsafely get the value for a key in a map. -- | -- | This function does not check whether the key exists in the map. -foreign import unsafeGet - """ - function unsafeGet(m) { - return function() { - return m; - } - } - """ :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) +foreign import unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) diff --git a/src/Data/StrMap/Unsafe.js b/src/Data/StrMap/Unsafe.js new file mode 100644 index 00000000..d781b72e --- /dev/null +++ b/src/Data/StrMap/Unsafe.js @@ -0,0 +1,10 @@ +/* global exports */ +"use strict"; + +// module Data.StrMap.Unsafe + +exports.unsafeIndex = function(m) { + return function(k) { + return m[k]; + }; +}; \ No newline at end of file diff --git a/src/Data/StrMap/Unsafe.purs b/src/Data/StrMap/Unsafe.purs index d6da9294..167b5ac7 100644 --- a/src/Data/StrMap/Unsafe.purs +++ b/src/Data/StrMap/Unsafe.purs @@ -2,16 +2,11 @@ module Data.StrMap.Unsafe ( unsafeIndex ) where +import Prelude + import Data.StrMap -- | Unsafely get the value for a key in a map. -- | -- | This function does not check whether the key exists in the map. -foreign import unsafeIndex - """ - function unsafeIndex(m) { - return function(k) { - return m[k]; - }; - } - """ :: forall a . StrMap a -> String -> a +foreign import unsafeIndex :: forall a. StrMap a -> String -> a diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index 250c7d77..78aacc3c 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -1,5 +1,7 @@ module Tests.Data.Map where +import Prelude + import Control.Alt ((<|>)) import Data.Array (groupBy, map, length, nubBy, sortBy) import Data.Foldable (foldl, for_) diff --git a/tests/Data/StrMap.purs b/tests/Data/StrMap.purs index c31a9788..cb68a624 100644 --- a/tests/Data/StrMap.purs +++ b/tests/Data/StrMap.purs @@ -1,5 +1,7 @@ module Tests.Data.StrMap where +import Prelude + import Data.Array (groupBy, map, sortBy) import Data.Foldable (foldl) import Data.Function (on) @@ -107,4 +109,4 @@ strMapTests = do quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Number)) (show (M.size (m1 `M.union` m2)) ++ " != " ++ show (M.size ((m1 `M.union` m2) `M.union` m2))) trace "toList = zip keys values" - quickCheck $ \m -> M.toList m == zip (M.keys m) (M.values m :: [Number]) + quickCheck $ \m -> M.toList m == zip (M.keys m) (M.values m :: Array Number) diff --git a/tests/Tests.purs b/tests/Tests.purs index 701e2286..960d2cb8 100644 --- a/tests/Tests.purs +++ b/tests/Tests.purs @@ -1,5 +1,7 @@ module Tests where +import Prelude + import Debug.Trace import Test.QuickCheck From 8e272ba0410be42b864f26b6b0259a284d3f86c0 Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Tue, 9 Jun 2015 19:56:51 -0700 Subject: [PATCH 033/125] Changes for RC --- Gruntfile.js | 52 --- README.md | 618 +--------------------------------- bower.json | 28 +- docs/Data/Map.md | 191 +++++++++++ docs/Data/StrMap.md | 246 ++++++++++++++ docs/Data/StrMap/ST.md | 51 +++ docs/Data/StrMap/ST/Unsafe.md | 13 + docs/Data/StrMap/Unsafe.md | 13 + gulpfile.js | 55 +++ package.json | 10 +- 10 files changed, 601 insertions(+), 676 deletions(-) delete mode 100644 Gruntfile.js create mode 100644 docs/Data/Map.md create mode 100644 docs/Data/StrMap.md create mode 100644 docs/Data/StrMap/ST.md create mode 100644 docs/Data/StrMap/ST/Unsafe.md create mode 100644 docs/Data/StrMap/Unsafe.md create mode 100644 gulpfile.js diff --git a/Gruntfile.js b/Gruntfile.js deleted file mode 100644 index ef6d6795..00000000 --- a/Gruntfile.js +++ /dev/null @@ -1,52 +0,0 @@ -module.exports = function(grunt) { - - "use strict"; - - grunt.initConfig({ - - libFiles: [ - "src/**/*.purs", - "bower_components/purescript-*/src/**/*.purs", - ], - - clean: { - lib: ["output"], - tests: ["tmp"] - }, - - pscMake: ["<%=libFiles%>"], - dotPsci: ["<%=libFiles%>"], - pscDocs: { - readme: { - src: "src/**/*.purs", - dest: "README.md" - } - }, - - psc: { - tests: { - options: { - module: "Tests", - main: "Tests" - }, - src: ["tests/**/*.purs", "<%=libFiles%>"], - dest: "tmp/tests.js" - } - }, - - execute: { - tests: { - src: "tmp/tests.js" - } - } - - }); - - grunt.loadNpmTasks("grunt-contrib-clean"); - grunt.loadNpmTasks("grunt-purescript"); - grunt.loadNpmTasks("grunt-execute"); - - grunt.registerTask("test", ["clean:tests", "psc", "execute"]); - grunt.registerTask("make", ["pscMake", "dotPsci", "pscDocs"]); - grunt.registerTask("default", ["make", "test"]); -}; diff --git a/README.md b/README.md index c793e500..8f65fe34 100644 --- a/README.md +++ b/README.md @@ -1,615 +1,17 @@ -# Module Documentation +# purescript-maps -## Module Data.Map +A purely-functional map data structure +## Installation -This module defines a type of maps as balanced 2-3 trees, based on - - -#### `Map` - -``` purescript -data Map k v -``` - -`Map k v` represents maps from keys of type `k` to values of type `v`. - -#### `eqMap` - -``` purescript -instance eqMap :: (Eq k, Eq v) => Eq (Map k v) -``` - - -#### `showMap` - -``` purescript -instance showMap :: (Show k, Show v) => Show (Map k v) -``` - - -#### `ordMap` - -``` purescript -instance ordMap :: (Ord k, Ord v) => Ord (Map k v) -``` - - -#### `semigroupMap` - -``` purescript -instance semigroupMap :: (Ord k) => Semigroup (Map k v) -``` - - -#### `monoidMap` - -``` purescript -instance monoidMap :: (Ord k) => Monoid (Map k v) -``` - - -#### `functorMap` - -``` purescript -instance functorMap :: Functor (Map k) -``` - - -#### `foldableMap` - -``` purescript -instance foldableMap :: Foldable (Map k) -``` - - -#### `traversableMap` - -``` purescript -instance traversableMap :: (Ord k) => Traversable (Map k) -``` - - -#### `showTree` - -``` purescript -showTree :: forall k v. (Show k, Show v) => Map k v -> String -``` - -Render a `Map` as a `String` - -#### `empty` - -``` purescript -empty :: forall k v. Map k v -``` - -An empty map - -#### `isEmpty` - -``` purescript -isEmpty :: forall k v. Map k v -> Boolean -``` - -Test if a map is empty - -#### `singleton` - -``` purescript -singleton :: forall k v. k -> v -> Map k v -``` - -Create a map with one key/value pair - -#### `checkValid` - -``` purescript -checkValid :: forall k v. Map k v -> Boolean -``` - -Check whether the underlying tree satisfies the 2-3 invariant - -This function is provided for internal use. - -#### `lookup` - -``` purescript -lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v -``` - -Lookup a value for the specified key - -#### `member` - -``` purescript -member :: forall k v. (Ord k) => k -> Map k v -> Boolean -``` - -Test if a key is a member of a map - -#### `insert` - -``` purescript -insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v -``` - -Insert a key/value pair into a map - -#### `delete` - -``` purescript -delete :: forall k v. (Ord k) => k -> Map k v -> Map k v -``` - -Delete a key and its corresponding value from a map - -#### `alter` - -``` purescript -alter :: forall k v. (Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v -``` - -Insert the value, delete a value, or update a value for a key in a map - -#### `update` - -``` purescript -update :: forall k v. (Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v -``` - -Update or delete the value for a key in a map - -#### `toList` - -``` purescript -toList :: forall k v. Map k v -> [Tuple k v] -``` - -Convert a map to an array of key/value pairs - -#### `fromList` - -``` purescript -fromList :: forall k v. (Ord k) => [Tuple k v] -> Map k v -``` - -Create a map from an array of key/value pairs - -#### `fromListWith` - -``` purescript -fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> [Tuple k v] -> Map k v -``` - -Create a map from an array of key/value pairs, using the specified function -to combine values for duplicate keys. - -#### `keys` - -``` purescript -keys :: forall k v. Map k v -> [k] -``` - -Get an array of the keys contained in a map - -#### `values` - -``` purescript -values :: forall k v. Map k v -> [v] -``` - -Get an array of the values contained in a map - -#### `unionWith` - -``` purescript -unionWith :: forall k v. (Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v -``` - -Compute the union of two maps, using the specified function -to combine values for duplicate keys. - -#### `union` - -``` purescript -union :: forall k v. (Ord k) => Map k v -> Map k v -> Map k v -``` - -Compute the union of two maps, preferring values from the first map in the case -of duplicate keys - -#### `unions` - -``` purescript -unions :: forall k v. (Ord k) => [Map k v] -> Map k v -``` - -Compute the union of a collection of maps - -#### `map` - -``` purescript -map :: forall k a b. (a -> b) -> Map k a -> Map k b -``` - -Apply a function to the values in a map - -#### `size` - -``` purescript -size :: forall k v. Map k v -> Int -``` - -Calculate the number of key/value pairs in a map - - -## Module Data.StrMap - - -This module defines a type of native Javascript maps which -require the keys to be strings. - -To maximize performance, Javascript objects are not wrapped, -and some native code is used even when it's not necessary. - -#### `StrMap` - -``` purescript -data StrMap :: * -> * -``` - -`StrMap a` represents a map from `String`s to values of type `a`. - -#### `thawST` - -``` purescript -thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a) -``` - -Convert an immutable map into a mutable map - -#### `freezeST` - -``` purescript -freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a) -``` - -Convert a mutable map into an immutable map - -#### `runST` - -``` purescript -runST :: forall a r. (forall h. Eff (st :: ST.ST h | r) (SM.STStrMap h a)) -> Eff r (StrMap a) -``` - -Freeze a mutable map, creating an immutable map. Use this function as you would use -`Prelude.runST` to freeze a mutable reference. - -The rank-2 type prevents the map from escaping the scope of `runST`. - -#### `functorStrMap` - -``` purescript -instance functorStrMap :: Functor StrMap -``` - - -#### `fold` - -``` purescript -fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z -``` - -Fold the keys and values of a map - -#### `foldMap` - -``` purescript -foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m ``` - -Fold the keys and values of a map, accumulating values using -some `Monoid`. - -#### `foldM` - -``` purescript -foldM :: forall a m z. (Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z -``` - -Fold the keys and values of a map, accumulating values and effects in -some `Monad`. - -#### `foldableStrMap` - -``` purescript -instance foldableStrMap :: Foldable StrMap -``` - - -#### `traversableStrMap` - -``` purescript -instance traversableStrMap :: Traversable StrMap -``` - - -#### `foldMaybe` - -``` purescript -foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z -``` - -Fold the keys and values of a map. - -This function allows the folding function to terminate the fold early, -using `Maybe`. - -#### `all` - -``` purescript -all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean -``` - -Test whether all key/value pairs in a `StrMap` satisfy a predicate. - -#### `eqStrMap` - -``` purescript -instance eqStrMap :: (Eq a) => Eq (StrMap a) -``` - - -#### `showStrMap` - -``` purescript -instance showStrMap :: (Show a) => Show (StrMap a) -``` - - -#### `empty` - -``` purescript -empty :: forall a. StrMap a -``` - -An empty map - -#### `isSubmap` - -``` purescript -isSubmap :: forall a. (Eq a) => StrMap a -> StrMap a -> Boolean -``` - -Test whether one map contains all of the keys and values contained in another map - -#### `isEmpty` - -``` purescript -isEmpty :: forall a. StrMap a -> Boolean -``` - -Test whether a map is empty - -#### `size` - -``` purescript -size :: forall a. StrMap a -> Number -``` - -Calculate the number of key/value pairs in a map - -#### `singleton` - -``` purescript -singleton :: forall a. String -> a -> StrMap a -``` - -Create a map with one key/value pair - -#### `lookup` - -``` purescript -lookup :: forall a. String -> StrMap a -> Maybe a -``` - -Lookup the value for a key in a map - -#### `member` - -``` purescript -member :: forall a. String -> StrMap a -> Boolean -``` - -Test whether a `String` appears as a key in a map - -#### `insert` - -``` purescript -insert :: forall a. String -> a -> StrMap a -> StrMap a -``` - -Insert a key and value into a map - -#### `delete` - -``` purescript -delete :: forall a. String -> StrMap a -> StrMap a -``` - -Delete a key and value from a map - -#### `alter` - -``` purescript -alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a -``` - -Insert, remove or update a value for a key in a map - -#### `update` - -``` purescript -update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a -``` - -Remove or update a value for a key in a map - -#### `fromList` - -``` purescript -fromList :: forall a. [Tuple String a] -> StrMap a -``` - -Create a map from an array of key/value pairs - -#### `fromListWith` - -``` purescript -fromListWith :: forall a. (a -> a -> a) -> [Tuple String a] -> StrMap a -``` - -Create a map from an array of key/value pairs, using the specified function -to combine values for duplicate keys. - -#### `toList` - -``` purescript -toList :: forall a. StrMap a -> [Tuple String a] -``` - -Convert a map into an array of key/value pairs - -#### `keys` - -``` purescript -keys :: forall a. StrMap a -> [String] -``` - -Get an array of the keys in a map - -#### `values` - -``` purescript -values :: forall a. StrMap a -> [a] -``` - -Get an array of the values in a map - -#### `union` - -``` purescript -union :: forall a. StrMap a -> StrMap a -> StrMap a -``` - -Compute the union of two maps, preferring the first map in the case of -duplicate keys. - -#### `unions` - -``` purescript -unions :: forall a. [StrMap a] -> StrMap a -``` - -Compute the union of a collection of maps - -#### `map` - -``` purescript -map :: forall a b. (a -> b) -> StrMap a -> StrMap b -``` - -Map a function over the values in a map - -#### `semigroupStrMap` - -``` purescript -instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) -``` - - -#### `monoidStrMap` - -``` purescript -instance monoidStrMap :: (Semigroup a) => Monoid (StrMap a) -``` - - - -## Module Data.StrMap.ST - - -Helper functions for working with mutable maps using the `ST` effect. - -This module can be used when performance is important and mutation is a local effect. - -#### `STStrMap` - -``` purescript -data STStrMap :: * -> * -> * -``` - -A reference to a mutable map - -The first type parameter represents the memory region which the map belongs to. The second type parameter defines the type of elements of the mutable array. - -The runtime representation of a value of type `STStrMap h a` is the same as that of `StrMap a`, except that mutation is allowed. - -#### `new` - -``` purescript -new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) -``` - -Create a new, empty mutable map - -#### `peek` - -``` purescript -peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a -``` - -Get the value for a key in a mutable map - -#### `poke` - -``` purescript -poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) -``` - -Update the value for a key in a mutable map - -#### `delete` - -``` purescript -delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) -``` - -Remove a key and the corresponding value from a mutable map - - -## Module Data.StrMap.ST.Unsafe - -#### `unsafeGet` - -``` purescript -unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) -``` - -Unsafely get the value for a key in a map. - -This function does not check whether the key exists in the map. - - -## Module Data.StrMap.Unsafe - -#### `unsafeIndex` - -``` purescript -unsafeIndex :: forall a. StrMap a -> String -> a +bower install purescript-maps ``` -Unsafely get the value for a key in a map. +## Module documentation -This function does not check whether the key exists in the map. \ No newline at end of file +- [Data.Map](docs/Data/Map.md) +- [Data.StrMap](docs/Data/StrMap.md) +- [Data.StrMap.ST](docs/Data/StrMap/ST.md) +- [Data.StrMap.ST.Unsafe](docs/Data/StrMap/ST/Unsafe.md) +- [Data.StrMap.Unsafe](docs/Data/StrMap/Unsafe.md) diff --git a/bower.json b/bower.json index 6886d4ff..d996db2d 100644 --- a/bower.json +++ b/bower.json @@ -9,6 +9,10 @@ "keywords": [ "purescript" ], + "repository": { + "type": "git", + "url": "git://github.com/purescript/purescript-maps.git" + }, "license": "MIT", "ignore": [ "**/.*", @@ -22,18 +26,20 @@ "package.json" ], "devDependencies": { - "purescript-quickcheck": "~0.6.0" + "purescript-quickcheck": "^0.6.0" }, "dependencies": { - "purescript-arrays": "~0.4.0", - "purescript-foldable-traversable": "~0.4.0", - "purescript-strings": "~0.5.0", - "purescript-math": "~0.1.1", - "purescript-maybe": "~0.3.0", - "purescript-tuples": "~0.4.0", - "purescript-integers": "~0.2.0", - "purescript-prelude": "~0.1.0", - "purescript-eff": "~0.1.0", - "purescript-st": "~0.1.0" + "purescript-arrays": "^0.4.0", + "purescript-foldable-traversable": "^0.4.0", + "purescript-strings": "^0.5.0", + "purescript-lists": "^0.7.0", + "purescript-math": "^0.2.0", + "purescript-maybe": "^0.3.0", + "purescript-tuples": "^0.4.0", + "purescript-integers": "^0.2.0", + "purescript-prelude": "^0.1.0", + "purescript-functions": "^0.1.0", + "purescript-eff": "^0.1.0", + "purescript-st": "^0.1.0" } } diff --git a/docs/Data/Map.md b/docs/Data/Map.md new file mode 100644 index 00000000..1b97f947 --- /dev/null +++ b/docs/Data/Map.md @@ -0,0 +1,191 @@ +## Module Data.Map + +This module defines a type of maps as balanced 2-3 trees, based on + + +#### `Map` + +``` purescript +data Map k v +``` + +`Map k v` represents maps from keys of type `k` to values of type `v`. + +##### Instances +``` purescript +instance eqMap :: (Eq k, Eq v) => Eq (Map k v) +instance showMap :: (Show k, Show v) => Show (Map k v) +instance ordMap :: (Ord k, Ord v) => Ord (Map k v) +instance semigroupMap :: (Ord k) => Semigroup (Map k v) +instance monoidMap :: (Ord k) => Monoid (Map k v) +instance functorMap :: Functor (Map k) +instance foldableMap :: Foldable (Map k) +instance traversableMap :: (Ord k) => Traversable (Map k) +``` + +#### `showTree` + +``` purescript +showTree :: forall k v. (Show k, Show v) => Map k v -> String +``` + +Render a `Map` as a `String` + +#### `empty` + +``` purescript +empty :: forall k v. Map k v +``` + +An empty map + +#### `isEmpty` + +``` purescript +isEmpty :: forall k v. Map k v -> Boolean +``` + +Test if a map is empty + +#### `singleton` + +``` purescript +singleton :: forall k v. k -> v -> Map k v +``` + +Create a map with one key/value pair + +#### `checkValid` + +``` purescript +checkValid :: forall k v. Map k v -> Boolean +``` + +Check whether the underlying tree satisfies the 2-3 invariant + +This function is provided for internal use. + +#### `lookup` + +``` purescript +lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v +``` + +Lookup a value for the specified key + +#### `member` + +``` purescript +member :: forall k v. (Ord k) => k -> Map k v -> Boolean +``` + +Test if a key is a member of a map + +#### `insert` + +``` purescript +insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v +``` + +Insert a key/value pair into a map + +#### `delete` + +``` purescript +delete :: forall k v. (Ord k) => k -> Map k v -> Map k v +``` + +Delete a key and its corresponding value from a map + +#### `alter` + +``` purescript +alter :: forall k v. (Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v +``` + +Insert the value, delete a value, or update a value for a key in a map + +#### `update` + +``` purescript +update :: forall k v. (Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v +``` + +Update or delete the value for a key in a map + +#### `toList` + +``` purescript +toList :: forall k v. Map k v -> List (Tuple k v) +``` + +Convert a map to an array of key/value pairs + +#### `fromList` + +``` purescript +fromList :: forall k v. (Ord k) => List (Tuple k v) -> Map k v +``` + +Create a map from an array of key/value pairs + +#### `fromListWith` + +``` purescript +fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> List (Tuple k v) -> Map k v +``` + +Create a map from an array of key/value pairs, using the specified function +to combine values for duplicate keys. + +#### `keys` + +``` purescript +keys :: forall k v. Map k v -> List k +``` + +Get an array of the keys contained in a map + +#### `values` + +``` purescript +values :: forall k v. Map k v -> List v +``` + +Get an array of the values contained in a map + +#### `unionWith` + +``` purescript +unionWith :: forall k v. (Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v +``` + +Compute the union of two maps, using the specified function +to combine values for duplicate keys. + +#### `union` + +``` purescript +union :: forall k v. (Ord k) => Map k v -> Map k v -> Map k v +``` + +Compute the union of two maps, preferring values from the first map in the case +of duplicate keys + +#### `unions` + +``` purescript +unions :: forall k v. (Ord k) => List (Map k v) -> Map k v +``` + +Compute the union of a collection of maps + +#### `size` + +``` purescript +size :: forall k v. Map k v -> Int +``` + +Calculate the number of key/value pairs in a map + + diff --git a/docs/Data/StrMap.md b/docs/Data/StrMap.md new file mode 100644 index 00000000..57a5ad69 --- /dev/null +++ b/docs/Data/StrMap.md @@ -0,0 +1,246 @@ +## Module Data.StrMap + +This module defines a type of native Javascript maps which +require the keys to be strings. + +To maximize performance, Javascript objects are not wrapped, +and some native code is used even when it's not necessary. + +#### `StrMap` + +``` purescript +data StrMap :: * -> * +``` + +`StrMap a` represents a map from `String`s to values of type `a`. + +##### Instances +``` purescript +instance functorStrMap :: Functor StrMap +instance foldableStrMap :: Foldable StrMap +instance traversableStrMap :: Traversable StrMap +instance eqStrMap :: (Eq a) => Eq (StrMap a) +instance showStrMap :: (Show a) => Show (StrMap a) +instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) +instance monoidStrMap :: (Semigroup a) => Monoid (StrMap a) +``` + +#### `thawST` + +``` purescript +thawST :: forall a h r. StrMap a -> Eff (st :: ST h | r) (STStrMap h a) +``` + +Convert an immutable map into a mutable map + +#### `freezeST` + +``` purescript +freezeST :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) +``` + +Convert a mutable map into an immutable map + +#### `runST` + +``` purescript +runST :: forall a r. (forall h. Eff (st :: ST h | r) (STStrMap h a)) -> Eff r (StrMap a) +``` + +Freeze a mutable map, creating an immutable map. Use this function as you would use +`Prelude.runST` to freeze a mutable reference. + +The rank-2 type prevents the map from escaping the scope of `runST`. + +#### `fold` + +``` purescript +fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z +``` + +Fold the keys and values of a map + +#### `foldMap` + +``` purescript +foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m +``` + +Fold the keys and values of a map, accumulating values using +some `Monoid`. + +#### `foldM` + +``` purescript +foldM :: forall a m z. (Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z +``` + +Fold the keys and values of a map, accumulating values and effects in +some `Monad`. + +#### `foldMaybe` + +``` purescript +foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z +``` + +Fold the keys and values of a map. + +This function allows the folding function to terminate the fold early, +using `Maybe`. + +#### `all` + +``` purescript +all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean +``` + +Test whether all key/value pairs in a `StrMap` satisfy a predicate. + +#### `empty` + +``` purescript +empty :: forall a. StrMap a +``` + +An empty map + +#### `isSubmap` + +``` purescript +isSubmap :: forall a. (Eq a) => StrMap a -> StrMap a -> Boolean +``` + +Test whether one map contains all of the keys and values contained in another map + +#### `isEmpty` + +``` purescript +isEmpty :: forall a. StrMap a -> Boolean +``` + +Test whether a map is empty + +#### `size` + +``` purescript +size :: forall a. StrMap a -> Number +``` + +Calculate the number of key/value pairs in a map + +#### `singleton` + +``` purescript +singleton :: forall a. String -> a -> StrMap a +``` + +Create a map with one key/value pair + +#### `lookup` + +``` purescript +lookup :: forall a. String -> StrMap a -> Maybe a +``` + +Lookup the value for a key in a map + +#### `member` + +``` purescript +member :: forall a. String -> StrMap a -> Boolean +``` + +Test whether a `String` appears as a key in a map + +#### `insert` + +``` purescript +insert :: forall a. String -> a -> StrMap a -> StrMap a +``` + +Insert a key and value into a map + +#### `delete` + +``` purescript +delete :: forall a. String -> StrMap a -> StrMap a +``` + +Delete a key and value from a map + +#### `alter` + +``` purescript +alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a +``` + +Insert, remove or update a value for a key in a map + +#### `update` + +``` purescript +update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a +``` + +Remove or update a value for a key in a map + +#### `fromList` + +``` purescript +fromList :: forall a. List (Tuple String a) -> StrMap a +``` + +Create a map from an array of key/value pairs + +#### `fromListWith` + +``` purescript +fromListWith :: forall a. (a -> a -> a) -> List (Tuple String a) -> StrMap a +``` + +Create a map from an array of key/value pairs, using the specified function +to combine values for duplicate keys. + +#### `toList` + +``` purescript +toList :: forall a. StrMap a -> List (Tuple String a) +``` + +Convert a map into an array of key/value pairs + +#### `keys` + +``` purescript +keys :: forall a. StrMap a -> Array String +``` + +Get an array of the keys in a map + +#### `values` + +``` purescript +values :: forall a. StrMap a -> List a +``` + +Get an array of the values in a map + +#### `union` + +``` purescript +union :: forall a. StrMap a -> StrMap a -> StrMap a +``` + +Compute the union of two maps, preferring the first map in the case of +duplicate keys. + +#### `unions` + +``` purescript +unions :: forall a. List (StrMap a) -> StrMap a +``` + +Compute the union of a collection of maps + + diff --git a/docs/Data/StrMap/ST.md b/docs/Data/StrMap/ST.md new file mode 100644 index 00000000..9913c780 --- /dev/null +++ b/docs/Data/StrMap/ST.md @@ -0,0 +1,51 @@ +## Module Data.StrMap.ST + +Helper functions for working with mutable maps using the `ST` effect. + +This module can be used when performance is important and mutation is a local effect. + +#### `STStrMap` + +``` purescript +data STStrMap :: * -> * -> * +``` + +A reference to a mutable map + +The first type parameter represents the memory region which the map belongs to. The second type parameter defines the type of elements of the mutable array. + +The runtime representation of a value of type `STStrMap h a` is the same as that of `StrMap a`, except that mutation is allowed. + +#### `new` + +``` purescript +new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) +``` + +Create a new, empty mutable map + +#### `peek` + +``` purescript +peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a +``` + +Get the value for a key in a mutable map + +#### `poke` + +``` purescript +poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) +``` + +Update the value for a key in a mutable map + +#### `delete` + +``` purescript +delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) +``` + +Remove a key and the corresponding value from a mutable map + + diff --git a/docs/Data/StrMap/ST/Unsafe.md b/docs/Data/StrMap/ST/Unsafe.md new file mode 100644 index 00000000..02524467 --- /dev/null +++ b/docs/Data/StrMap/ST/Unsafe.md @@ -0,0 +1,13 @@ +## Module Data.StrMap.ST.Unsafe + +#### `unsafeGet` + +``` purescript +unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) +``` + +Unsafely get the value for a key in a map. + +This function does not check whether the key exists in the map. + + diff --git a/docs/Data/StrMap/Unsafe.md b/docs/Data/StrMap/Unsafe.md new file mode 100644 index 00000000..fa884986 --- /dev/null +++ b/docs/Data/StrMap/Unsafe.md @@ -0,0 +1,13 @@ +## Module Data.StrMap.Unsafe + +#### `unsafeIndex` + +``` purescript +unsafeIndex :: forall a. StrMap a -> String -> a +``` + +Unsafely get the value for a key in a map. + +This function does not check whether the key exists in the map. + + diff --git a/gulpfile.js b/gulpfile.js new file mode 100644 index 00000000..3eb189b9 --- /dev/null +++ b/gulpfile.js @@ -0,0 +1,55 @@ +/* jshint node: true */ +"use strict"; + +var gulp = require("gulp"); +var plumber = require("gulp-plumber"); +var purescript = require("gulp-purescript"); +var rimraf = require("rimraf"); + +var sources = [ + "src/**/*.purs", + "bower_components/purescript-*/src/**/*.purs" +]; + +var foreigns = [ + "src/**/*.js", + "bower_components/purescript-*/src/**/*.js" +]; + +gulp.task("clean-docs", function (cb) { + rimraf("docs", cb); +}); + +gulp.task("clean-output", function (cb) { + rimraf("output", cb); +}); + +gulp.task("clean", ["clean-docs", "clean-output"]); + +gulp.task("make", function() { + return gulp.src(sources) + .pipe(plumber()) + .pipe(purescript.pscMake({ ffi: foreigns })); +}); + +gulp.task("docs", ["clean-docs"], function () { + return gulp.src(sources) + .pipe(plumber()) + .pipe(purescript.pscDocs({ + docgen: { + "Data.Map" : "docs/Data/Map.md", + "Data.StrMap" : "docs/Data/StrMap.md", + "Data.StrMap.ST" : "docs/Data/StrMap/ST.md", + "Data.StrMap.ST.Unsafe" : "docs/Data/StrMap/ST/Unsafe.md", + "Data.StrMap.Unsafe" : "docs/Data/StrMap/Unsafe.md" + } + })); +}); + +gulp.task("dotpsci", function () { + return gulp.src(sources) + .pipe(plumber()) + .pipe(purescript.dotPsci()); +}); + +gulp.task("default", ["make", "docs", "dotpsci"]); \ No newline at end of file diff --git a/package.json b/package.json index 0b545e4e..0c0f2c61 100644 --- a/package.json +++ b/package.json @@ -1,9 +1,9 @@ { "private": true, - "dependencies": { - "grunt": "~0.4.4", - "grunt-purescript": "~0.6.0", - "grunt-contrib-clean": "~0.5.0", - "grunt-execute": "~0.2.1" + "devDependencies": { + "gulp": "^3.8.11", + "gulp-plumber": "^1.0.0", + "gulp-purescript": "^0.5.0-rc.1", + "rimraf": "^2.3.3" } } From 7a570d3fee548d1c5c3862f6124018ac1e3f93e2 Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Tue, 9 Jun 2015 19:57:32 -0700 Subject: [PATCH 034/125] README --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 8f65fe34..f4e567da 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # purescript-maps -A purely-functional map data structure +Purely-functional map data structures ## Installation From e9d20732584380b43b9cae611a9a7f2b5f055fef Mon Sep 17 00:00:00 2001 From: sharkdp Date: Thu, 11 Jun 2015 12:04:00 +0200 Subject: [PATCH 035/125] Update tests for 0.7 --- tests/Data/Map.purs | 134 ++++++++++++++++++++--------------------- tests/Data/StrMap.purs | 69 ++++++++++----------- tests/Tests.purs | 6 +- 3 files changed, 105 insertions(+), 104 deletions(-) diff --git a/tests/Data/Map.purs b/tests/Data/Map.purs index 78aacc3c..9f92ee3a 100644 --- a/tests/Data/Map.purs +++ b/tests/Data/Map.purs @@ -3,15 +3,16 @@ module Tests.Data.Map where import Prelude import Control.Alt ((<|>)) -import Data.Array (groupBy, map, length, nubBy, sortBy) +import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton, toList) import Data.Foldable (foldl, for_) import Data.Function (on) import Data.Maybe (Maybe(..), fromMaybe) -import Data.Int (fromNumber) import Data.Tuple (Tuple(..), fst) -import Debug.Trace +import Control.Monad.Eff.Console (log) +import Test.Data.List import Test.QuickCheck ((), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import Test.QuickCheck.Gen (Gen(..)) import qualified Data.Map as M instance arbMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (M.Map k v) where @@ -32,33 +33,32 @@ instance showSmallKey :: Show SmallKey where show J = "J" instance eqSmallKey :: Eq SmallKey where - (==) A A = true - (==) B B = true - (==) C C = true - (==) D D = true - (==) E E = true - (==) F F = true - (==) G G = true - (==) H H = true - (==) I I = true - (==) J J = true - (==) _ _ = false - (/=) x y = not (x == y) - -smallKeyToNumber :: SmallKey -> Number -smallKeyToNumber A = 0 -smallKeyToNumber B = 1 -smallKeyToNumber C = 2 -smallKeyToNumber D = 3 -smallKeyToNumber E = 4 -smallKeyToNumber F = 5 -smallKeyToNumber G = 6 -smallKeyToNumber H = 7 -smallKeyToNumber I = 8 -smallKeyToNumber J = 9 + eq A A = true + eq B B = true + eq C C = true + eq D D = true + eq E E = true + eq F F = true + eq G G = true + eq H H = true + eq I I = true + eq J J = true + eq _ _ = false + +smallKeyToInt :: SmallKey -> Int +smallKeyToInt A = 0 +smallKeyToInt B = 1 +smallKeyToInt C = 2 +smallKeyToInt D = 3 +smallKeyToInt E = 4 +smallKeyToInt F = 5 +smallKeyToInt G = 6 +smallKeyToInt H = 7 +smallKeyToInt I = 8 +smallKeyToInt J = 9 instance ordSmallKey :: Ord SmallKey where - compare = compare `on` smallKeyToNumber + compare = compare `on` smallKeyToInt instance arbSmallKey :: Arbitrary SmallKey where arbitrary = do @@ -93,7 +93,7 @@ instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k <- arbitrary return (Delete k) -runInstructions :: forall k v. (Ord k) => [Instruction k v] -> M.Map k v -> M.Map k v +runInstructions :: forall k v. (Ord k) => List (Instruction k v) -> M.Map k v -> M.Map k v runInstructions instrs t0 = foldl step t0 instrs where step tree (Insert k v) = M.insert k v tree @@ -102,98 +102,98 @@ runInstructions instrs t0 = foldl step t0 instrs smallKey :: SmallKey -> SmallKey smallKey k = k -number :: Number -> Number +number :: Int -> Int number n = n mapTests = do -- Data.Map - trace "Test inserting into empty tree" + log "Test inserting into empty tree" quickCheck $ \k v -> M.lookup (smallKey k) (M.insert k v M.empty) == Just (number v) ("k: " ++ show k ++ ", v: " ++ show v) - trace "Test delete after inserting" + log "Test delete after inserting" quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) ("k: " ++ show k ++ ", v: " ++ show v) - trace "Insert two, lookup first" + log "Insert two, lookup first" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - trace "Insert two, lookup second" + log "Insert two, lookup second" quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - trace "Insert two, delete one" + log "Insert two, delete one" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty))) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - trace "Check balance property" - quickCheck' (fromNumber 5000) $ \instrs -> + log "Check balance property" + quickCheck' 5000 $ \instrs -> let - tree :: M.Map SmallKey Number + tree :: M.Map SmallKey Int tree = runInstructions instrs M.empty in M.checkValid tree ("Map not balanced:\n " ++ show tree ++ "\nGenerated by:\n " ++ show instrs) - trace "Lookup from empty" - quickCheck $ \k -> M.lookup k (M.empty :: M.Map SmallKey Number) == Nothing + log "Lookup from empty" + quickCheck $ \k -> M.lookup k (M.empty :: M.Map SmallKey Int) == Nothing - trace "Lookup from singleton" - quickCheck $ \k v -> M.lookup (k :: SmallKey) (M.singleton k (v :: Number)) == Just v + log "Lookup from singleton" + quickCheck $ \k v -> M.lookup (k :: SmallKey) (M.singleton k (v :: Int)) == Just v - trace "Random lookup" - quickCheck' (fromNumber 5000) $ \instrs k v -> + log "Random lookup" + quickCheck' 5000 $ \instrs k v -> let - tree :: M.Map SmallKey Number + tree :: M.Map SmallKey Int tree = M.insert k v (runInstructions instrs M.empty) in M.lookup k tree == Just v ("instrs:\n " ++ show instrs ++ "\nk:\n " ++ show k ++ "\nv:\n " ++ show v) - trace "Singleton to list" - quickCheck $ \k v -> M.toList (M.singleton k v :: M.Map SmallKey Number) == [Tuple k v] + log "Singleton to list" + quickCheck $ \k v -> M.toList (M.singleton k v :: M.Map SmallKey Int) == singleton (Tuple k v) - trace "toList . fromList = id" + log "toList . fromList = id" quickCheck $ \arr -> let f x = M.toList (M.fromList x) - in f (f arr) == f (arr :: [Tuple SmallKey Number]) show arr + in f (f arr) == f (arr :: List (Tuple SmallKey Int)) show arr - trace "fromList . toList = id" + log "fromList . toList = id" quickCheck $ \m -> let f m = M.fromList (M.toList m) in - M.toList (f m) == M.toList (m :: M.Map SmallKey Number) show m + M.toList (f m) == M.toList (m :: M.Map SmallKey Int) show m - trace "fromListWith const = fromList" + log "fromListWith const = fromList" quickCheck $ \arr -> M.fromListWith const arr == - M.fromList (arr :: [Tuple SmallKey Number]) show arr + M.fromList (arr :: List (Tuple SmallKey Int)) show arr - trace "fromListWith (<>) = fromList . collapse with (<>) . group on fst" + log "fromListWith (<>) = fromList . collapse with (<>) . group on fst" quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) - foldl1 g (x : xs) = foldl g x xs + foldl1 g (Cons x xs) = foldl g x xs f = M.fromList <<< (<$>) (foldl1 combine) <<< groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in - M.fromListWith (<>) arr == f (arr :: [Tuple String String]) show arr + M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr - trace "Lookup from union" + log "Lookup from union" quickCheck $ \m1 m2 k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of Nothing -> M.lookup k m2 Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) - trace "Union is idempotent" - quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Number)) + log "Union is idempotent" + quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Int)) - trace "Union prefers left" - quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 (m2 :: M.Map SmallKey Number)) == (M.lookup k m1 <|> M.lookup k m2) + log "Union prefers left" + quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 (m2 :: M.Map SmallKey Int)) == (M.lookup k m1 <|> M.lookup k m2) - trace "unionWith" + log "unionWith" for_ [Tuple (+) 0, Tuple (*) 1] $ \(Tuple op ident) -> quickCheck $ \m1 m2 k -> - let u = M.unionWith op m1 m2 :: M.Map SmallKey Number + let u = M.unionWith op m1 m2 :: M.Map SmallKey Int in case M.lookup k u of Nothing -> not (M.member k m1 || M.member k m2) Just v -> v == op (fromMaybe ident (M.lookup k m1)) (fromMaybe ident (M.lookup k m2)) - trace "unionWith argument order" + log "unionWith argument order" quickCheck $ \m1 m2 k -> - let u = M.unionWith (-) m1 m2 :: M.Map SmallKey Number + let u = M.unionWith (-) m1 m2 :: M.Map SmallKey Int in1 = M.member k m1 v1 = M.lookup k m1 in2 = M.member k m2 @@ -204,7 +204,7 @@ mapTests = do Just v -> Just v == v2 Nothing -> not (in1 || in2) - trace "size" + log "size" quickCheck $ \xs -> let xs' = nubBy ((==) `on` fst) xs - in M.size (M.fromList xs') == length (xs' :: [Tuple SmallKey Number]) + in M.size (M.fromList xs') == length (xs' :: List (Tuple SmallKey Int)) diff --git a/tests/Data/StrMap.purs b/tests/Data/StrMap.purs index cb68a624..ff24cff5 100644 --- a/tests/Data/StrMap.purs +++ b/tests/Data/StrMap.purs @@ -2,15 +2,16 @@ module Tests.Data.StrMap where import Prelude -import Data.Array (groupBy, map, sortBy) +import Data.List (List(..), groupBy, sortBy, singleton, toList, zipWith) import Data.Foldable (foldl) import Data.Function (on) import Data.Maybe (Maybe(..)) -import Data.Int (fromNumber) -import Data.Tuple (Tuple(..), fst, zip) -import Debug.Trace +import Data.Tuple (Tuple(..), fst) +import Control.Monad.Eff.Console (log) +import Test.Data.List import Test.QuickCheck ((), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import Test.QuickCheck.Gen (Gen(..)) import qualified Data.String as S import qualified Data.StrMap as M @@ -34,79 +35,79 @@ instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) whe false -> do return (Delete k) -runInstructions :: forall v. [Instruction String v] -> M.StrMap v -> M.StrMap v +runInstructions :: forall v. List (Instruction String v) -> M.StrMap v -> M.StrMap v runInstructions instrs t0 = foldl step t0 instrs where step tree (Insert k v) = M.insert k v tree step tree (Delete k) = M.delete k tree -number :: Number -> Number +number :: Int -> Int number n = n strMapTests = do - trace "Test inserting into empty tree" + log "Test inserting into empty tree" quickCheck $ \k v -> M.lookup k (M.insert k v M.empty) == Just (number v) ("k: " ++ show k ++ ", v: " ++ show v) - trace "Test delete after inserting" + log "Test delete after inserting" quickCheck $ \k v -> M.isEmpty (M.delete k (M.insert k (number v) M.empty)) ("k: " ++ show k ++ ", v: " ++ show v) - trace "Insert two, lookup first" + log "Insert two, lookup first" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v1 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - trace "Insert two, lookup second" + log "Insert two, lookup second" quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - trace "Insert two, delete one" + log "Insert two, delete one" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty))) == Just v2 ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) - trace "Lookup from empty" - quickCheck $ \k -> M.lookup k (M.empty :: M.StrMap Number) == Nothing + log "Lookup from empty" + quickCheck $ \k -> M.lookup k (M.empty :: M.StrMap Int) == Nothing - trace "Lookup from singleton" - quickCheck $ \k v -> M.lookup k (M.singleton k (v :: Number)) == Just v + log "Lookup from singleton" + quickCheck $ \k v -> M.lookup k (M.singleton k (v :: Int)) == Just v - trace "Random lookup" - quickCheck' (fromNumber 5000) $ \instrs k v -> + log "Random lookup" + quickCheck' 5000 $ \instrs k v -> let - tree :: M.StrMap Number + tree :: M.StrMap Int tree = M.insert k v (runInstructions instrs M.empty) in M.lookup k tree == Just v ("instrs:\n " ++ show instrs ++ "\nk:\n " ++ show k ++ "\nv:\n " ++ show v) - trace "Singleton to list" - quickCheck $ \k v -> M.toList (M.singleton k v :: M.StrMap Number) == [Tuple k v] + log "Singleton to list" + quickCheck $ \k v -> M.toList (M.singleton k v :: M.StrMap Int) == singleton (Tuple k v) - trace "toList . fromList = id" + log "toList . fromList = id" quickCheck $ \arr -> let f x = M.toList (M.fromList x) - in f (f arr) == f (arr :: [Tuple String Number]) show arr + in f (f arr) == f (arr :: List (Tuple String Int)) show arr - trace "fromList . toList = id" + log "fromList . toList = id" quickCheck $ \m -> let f m = M.fromList (M.toList m) in - M.toList (f m) == M.toList (m :: M.StrMap Number) show m + M.toList (f m) == M.toList (m :: M.StrMap Int) show m - trace "fromListWith const = fromList" + log "fromListWith const = fromList" quickCheck $ \arr -> M.fromListWith const arr == - M.fromList (arr :: [Tuple String Number]) show arr + M.fromList (arr :: List (Tuple String Int)) show arr - trace "fromListWith (<>) = fromList . collapse with (<>) . group on fst" + log "fromListWith (<>) = fromList . collapse with (<>) . group on fst" quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) - foldl1 g (x : xs) = foldl g x xs + foldl1 g (Cons x xs) = foldl g x xs f = M.fromList <<< (<$>) (foldl1 combine) <<< groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in - M.fromListWith (<>) arr == f (arr :: [Tuple String String]) show arr + M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr - trace "Lookup from union" + log "Lookup from union" quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 m2) == (case M.lookup k m1 of Nothing -> M.lookup k m2 Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) - trace "Union is idempotent" - quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Number)) (show (M.size (m1 `M.union` m2)) ++ " != " ++ show (M.size ((m1 `M.union` m2) `M.union` m2))) + log "Union is idempotent" + quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Int)) (show (M.size (m1 `M.union` m2)) ++ " != " ++ show (M.size ((m1 `M.union` m2) `M.union` m2))) - trace "toList = zip keys values" - quickCheck $ \m -> M.toList m == zip (M.keys m) (M.values m :: Array Number) + log "toList = zip keys values" + quickCheck $ \m -> M.toList m == zipWith Tuple (toList $ M.keys m) (M.values m :: List Int) diff --git a/tests/Tests.purs b/tests/Tests.purs index 960d2cb8..a0bbff08 100644 --- a/tests/Tests.purs +++ b/tests/Tests.purs @@ -2,15 +2,15 @@ module Tests where import Prelude -import Debug.Trace +import Control.Monad.Eff.Console (log) import Test.QuickCheck import Tests.Data.Map (mapTests) import Tests.Data.StrMap (strMapTests) main = do - trace "Running Map tests" + log "Running Map tests" mapTests - trace "Running StrMap tests" + log "Running StrMap tests" strMapTests From 8bbc39ef2b2a3b13094e3a3ad22903bd5e6b034b Mon Sep 17 00:00:00 2001 From: sharkdp Date: Thu, 11 Jun 2015 12:04:31 +0200 Subject: [PATCH 036/125] Enable tests in gulpfile --- gulpfile.js | 10 +++++++++- package.json | 1 + 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/gulpfile.js b/gulpfile.js index 3eb189b9..a87d1149 100644 --- a/gulpfile.js +++ b/gulpfile.js @@ -4,6 +4,7 @@ var gulp = require("gulp"); var plumber = require("gulp-plumber"); var purescript = require("gulp-purescript"); +var run = require("gulp-run"); var rimraf = require("rimraf"); var sources = [ @@ -52,4 +53,11 @@ gulp.task("dotpsci", function () { .pipe(purescript.dotPsci()); }); -gulp.task("default", ["make", "docs", "dotpsci"]); \ No newline at end of file +gulp.task("test", ["make"], function() { + return gulp.src(sources.concat(["tests/**/*.purs", "bower_components/purescript-lists/test-src/Data/List.purs"])) + .pipe(plumber()) + .pipe(purescript.psc({ main: "Tests", ffi: foreigns })) + .pipe(run("node")); +}); + +gulp.task("default", ["make", "docs", "dotpsci", "test"]); diff --git a/package.json b/package.json index 0c0f2c61..f3acdef7 100644 --- a/package.json +++ b/package.json @@ -4,6 +4,7 @@ "gulp": "^3.8.11", "gulp-plumber": "^1.0.0", "gulp-purescript": "^0.5.0-rc.1", + "gulp-run": "^1.6.8", "rimraf": "^2.3.3" } } From b29e24057558139a306f6392d70053a24010a3bf Mon Sep 17 00:00:00 2001 From: sharkdp Date: Thu, 11 Jun 2015 12:07:16 +0200 Subject: [PATCH 037/125] Add missing keyword in JS code --- src/Data/StrMap.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index 02d4661d..f07fc948 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -3,7 +3,7 @@ // module Data.StrMap -exports._copy = (m) { +exports._copy = function(m) { var r = {}; for (var k in m) { r[k] = m[k]; From cca72e0a6ca577bf75ccb4641a333032e5120cbe Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 2 Jul 2015 23:47:19 +0100 Subject: [PATCH 038/125] Update build, tidy up a few things, make tests work --- .gitignore | 5 +- .jscsrc | 12 +++ .jshintrc | 19 +++++ .travis.yml | 14 ++++ README.md | 6 +- bower.json | 25 ++----- gulpfile.js | 63 ---------------- package.json | 13 ++-- src/Data/Map.purs | 4 +- src/Data/StrMap.js | 97 +++++++++++++++---------- src/Data/StrMap.purs | 1 + src/Data/StrMap/ST.js | 28 +++---- src/Data/StrMap/ST.purs | 15 +--- src/Data/StrMap/ST/Unsafe.js | 8 +- src/Data/StrMap/Unsafe.js | 6 +- src/Data/StrMap/Unsafe.purs | 2 +- {tests => test/Test}/Data/Map.purs | 11 ++- {tests => test/Test}/Data/StrMap.purs | 6 +- tests/Tests.purs => test/Test/Main.purs | 7 +- 19 files changed, 170 insertions(+), 172 deletions(-) create mode 100644 .jscsrc create mode 100644 .jshintrc create mode 100644 .travis.yml delete mode 100644 gulpfile.js rename {tests => test/Test}/Data/Map.purs (97%) rename {tests => test/Test}/Data/StrMap.purs (96%) rename tests/Tests.purs => test/Test/Main.purs (56%) diff --git a/.gitignore b/.gitignore index 00cb8ace..e306283b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,8 @@ /.* +!/.gitignore +!/.jscsrc +!/.jshintrc +!/.travis.yml /bower_components/ /node_modules/ /output/ -/tmp/ diff --git a/.jscsrc b/.jscsrc new file mode 100644 index 00000000..342da669 --- /dev/null +++ b/.jscsrc @@ -0,0 +1,12 @@ +{ + "preset": "grunt", + "disallowSpacesInAnonymousFunctionExpression": null, + "requireSpacesInAnonymousFunctionExpression": { + "beforeOpeningRoundBrace": true, + "beforeOpeningCurlyBrace": true + }, + "disallowSpacesInsideObjectBrackets": null, + "requireSpacesInsideObjectBrackets": "all", + "validateQuoteMarks": "\"", + "requireCurlyBraces": null +} diff --git a/.jshintrc b/.jshintrc new file mode 100644 index 00000000..f3911591 --- /dev/null +++ b/.jshintrc @@ -0,0 +1,19 @@ +{ + "bitwise": true, + "eqeqeq": true, + "forin": true, + "freeze": true, + "funcscope": true, + "futurehostile": true, + "globalstrict": true, + "latedef": true, + "maxparams": 1, + "noarg": true, + "nocomma": true, + "nonew": true, + "notypeof": true, + "singleGroups": true, + "undef": true, + "unused": true, + "eqnull": true +} diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000..791313a3 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,14 @@ +language: node_js +sudo: false +node_js: + - 0.10 +env: + - PATH=$HOME/purescript:$PATH +install: + - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p') + - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz + - tar -xvf $HOME/purescript.tar.gz -C $HOME/ + - chmod a+x $HOME/purescript + - npm install +script: + - npm run build diff --git a/README.md b/README.md index f4e567da..8fdd5cdc 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,10 @@ # purescript-maps -Purely-functional map data structures +[![Latest release](http://img.shields.io/bower/v/purescript-maps.svg)](https://github.com/purescript/purescript-maps/releases) +[![Build Status](https://travis-ci.org/purescript/purescript-maps.svg?branch=master)](https://travis-ci.org/purescript/purescript-maps) +[![Dependency Status](https://www.versioneye.com/user/projects/55848c1b363861001d000315/badge.svg?style=flat)](https://www.versioneye.com/user/projects/55848c1b363861001d000315) + +Purely-functional map data structures. ## Installation diff --git a/bower.json b/bower.json index d996db2d..b7819e28 100644 --- a/bower.json +++ b/bower.json @@ -19,27 +19,16 @@ "bower_components", "node_modules", "output", - "tests", - "tmp", + "test", "bower.json", - "Gruntfile.js", "package.json" ], - "devDependencies": { - "purescript-quickcheck": "^0.6.0" - }, "dependencies": { - "purescript-arrays": "^0.4.0", - "purescript-foldable-traversable": "^0.4.0", - "purescript-strings": "^0.5.0", - "purescript-lists": "^0.7.0", - "purescript-math": "^0.2.0", - "purescript-maybe": "^0.3.0", - "purescript-tuples": "^0.4.0", - "purescript-integers": "^0.2.0", - "purescript-prelude": "^0.1.0", - "purescript-functions": "^0.1.0", - "purescript-eff": "^0.1.0", - "purescript-st": "^0.1.0" + "purescript-lists": "~0.7.0", + "purescript-st": "~0.1.0", + "purescript-functions": "~0.1.0" + }, + "devDependencies": { + "purescript-quickcheck": "~0.6.0" } } diff --git a/gulpfile.js b/gulpfile.js deleted file mode 100644 index a87d1149..00000000 --- a/gulpfile.js +++ /dev/null @@ -1,63 +0,0 @@ -/* jshint node: true */ -"use strict"; - -var gulp = require("gulp"); -var plumber = require("gulp-plumber"); -var purescript = require("gulp-purescript"); -var run = require("gulp-run"); -var rimraf = require("rimraf"); - -var sources = [ - "src/**/*.purs", - "bower_components/purescript-*/src/**/*.purs" -]; - -var foreigns = [ - "src/**/*.js", - "bower_components/purescript-*/src/**/*.js" -]; - -gulp.task("clean-docs", function (cb) { - rimraf("docs", cb); -}); - -gulp.task("clean-output", function (cb) { - rimraf("output", cb); -}); - -gulp.task("clean", ["clean-docs", "clean-output"]); - -gulp.task("make", function() { - return gulp.src(sources) - .pipe(plumber()) - .pipe(purescript.pscMake({ ffi: foreigns })); -}); - -gulp.task("docs", ["clean-docs"], function () { - return gulp.src(sources) - .pipe(plumber()) - .pipe(purescript.pscDocs({ - docgen: { - "Data.Map" : "docs/Data/Map.md", - "Data.StrMap" : "docs/Data/StrMap.md", - "Data.StrMap.ST" : "docs/Data/StrMap/ST.md", - "Data.StrMap.ST.Unsafe" : "docs/Data/StrMap/ST/Unsafe.md", - "Data.StrMap.Unsafe" : "docs/Data/StrMap/Unsafe.md" - } - })); -}); - -gulp.task("dotpsci", function () { - return gulp.src(sources) - .pipe(plumber()) - .pipe(purescript.dotPsci()); -}); - -gulp.task("test", ["make"], function() { - return gulp.src(sources.concat(["tests/**/*.purs", "bower_components/purescript-lists/test-src/Data/List.purs"])) - .pipe(plumber()) - .pipe(purescript.psc({ main: "Tests", ffi: foreigns })) - .pipe(run("node")); -}); - -gulp.task("default", ["make", "docs", "dotpsci", "test"]); diff --git a/package.json b/package.json index f3acdef7..7b325064 100644 --- a/package.json +++ b/package.json @@ -1,10 +1,13 @@ { "private": true, + "scripts": { + "postinstall": "pulp dep install", + "build": "jshint src && jscs src && pulp test && rimraf docs && pulp docs" + }, "devDependencies": { - "gulp": "^3.8.11", - "gulp-plumber": "^1.0.0", - "gulp-purescript": "^0.5.0-rc.1", - "gulp-run": "^1.6.8", - "rimraf": "^2.3.3" + "jscs": "^1.13.1", + "jshint": "^2.8.0", + "pulp": "^4.0.2", + "rimraf": "^2.4.1" } } diff --git a/src/Data/Map.purs b/src/Data/Map.purs index fe9aaff1..de9a7386 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -28,14 +28,12 @@ module Data.Map import Prelude import Data.Foldable (foldl, foldMap, foldr, Foldable) -import Data.Int () +import Data.List (List(..), length, nub) import Data.Maybe (Maybe(..), maybe, isJust) import Data.Monoid (Monoid) import Data.Traversable (traverse, Traversable) import Data.Tuple (Tuple(..), uncurry) -import Data.List (List(..), length, nub) - -- | `Map k v` represents maps from keys of type `k` to values of type `v`. data Map k v = Leaf diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index f07fc948..ecfa29ad 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -3,19 +3,23 @@ // module Data.StrMap -exports._copy = function(m) { +exports._copy = function (m) { var r = {}; for (var k in m) { - r[k] = m[k]; + if (m.hasOwnProperty(k)) { + r[k] = m[k]; + } } return r; }; -exports._copyEff = function(m) { - return function() { +exports._copyEff = function (m) { + return function () { var r = {}; for (var k in m) { - r[k] = m[k]; + if (m.hasOwnProperty(k)) { + r[k] = m[k]; + } } return r; }; @@ -23,29 +27,35 @@ exports._copyEff = function(m) { exports.empty = {}; -exports.runST = function(f) { +exports.runST = function (f) { return f; }; -exports._fmapStrMap = function(m0, f) { +// jshint maxparams: 2 +exports._fmapStrMap = function (m0, f) { var m = {}; for (var k in m0) { - m[k] = f(m0[k]); + if (m.hasOwnProperty(k)) { + m[k] = f(m0[k]); + } } return m; }; -exports._foldM = function(bind) { - return function(f) { - return function(mz) { - return function(m) { - function g(k) { +// jshint maxparams: 1 +exports._foldM = function (bind) { + return function (f) { + return function (mz) { + return function (m) { + function g (k) { return function (z) { return f(z)(k)(m[k]); }; } for (var k in m) { - mz = bind(mz)(g(k)); + if (m.hasOwnProperty(k)) { + mz = bind(mz)(g(k)); + } } return mz; }; @@ -53,60 +63,71 @@ exports._foldM = function(bind) { }; }; -exports._foldSCStrMap = function(m, z, f, fromMaybe) { +// jshint maxparams: 4 +exports._foldSCStrMap = function (m, z, f, fromMaybe) { for (var k in m) { - var maybeR = f(z)(k)(m[k]); - var r = fromMaybe(null)(maybeR); - if (r === null) return z; - else z = r; + if (m.hasOwnProperty(k)) { + var maybeR = f(z)(k)(m[k]); + var r = fromMaybe(null)(maybeR); + if (r === null) return z; + else z = r; + } } return z; }; -exports.all = function(f) { - return function(m) { +// jshint maxparams: 1 +exports.all = function (f) { + return function (m) { for (var k in m) { - if (!f(k)(m[k])) return false; + if (m.hasOwnProperty(k) && !f(k)(m[k])) return false; } return true; }; }; -exports.size = function(m) { +exports.size = function (m) { var s = 0; for (var k in m) { - ++s; + if (m.hasOwnProperty(k)) { + ++s; + } } return s; }; -exports._lookup = function(no, yes, k, m) { +// jshint maxparams: 4 +exports._lookup = function (no, yes, k, m) { return k in m ? yes(m[k]) : no; }; -exports._unsafeDeleteStrMap = function(m, k) { - delete m[k]; - return m; +// jshint maxparams: 2 +exports._unsafeDeleteStrMap = function (m, k) { + delete m[k]; + return m; }; -exports._lookupST = function(no, yes, k, m) { - return function() { +// jshint maxparams: 4 +exports._lookupST = function (no, yes, k, m) { + return function () { return k in m ? yes(m[k]) : no; - } + }; }; -function _collect(f) { - return function(m) { +function _collect (f) { + return function (m) { var r = []; for (var k in m) { - r.push(f(k)(m[k])); + if (m.hasOwnProperty(k)) { + r.push(f(k)(m[k])); + } } return r; }; -}; +} exports._collect = _collect; -exports.keys = Object.keys || _collect(function(k) { - return function() { return k; }; -}); \ No newline at end of file +exports.keys = Object.keys || _collect(function (k) { + return function () { return k; }; +}); diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 3b75e2fd..901fb883 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -43,6 +43,7 @@ import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Monoid (Monoid, mempty) import Data.Traversable (Traversable, traverse) import Data.Tuple (Tuple(..), uncurry) + import qualified Data.List as L import qualified Control.Monad.ST as ST import qualified Data.StrMap.ST as SM diff --git a/src/Data/StrMap/ST.js b/src/Data/StrMap/ST.js index 43a27bb8..347bd110 100644 --- a/src/Data/StrMap/ST.js +++ b/src/Data/StrMap/ST.js @@ -3,22 +3,22 @@ // module Data.StrMap.ST -exports._new = function() { +exports["new"] = function () { return {}; }; -exports.peek = function(m) { - return function(k) { - return function() { +exports.peek = function (m) { + return function (k) { + return function () { return m[k]; - } - } + }; + }; }; -exports.poke = function(m) { - return function(k) { - return function(v) { - return function() { +exports.poke = function (m) { + return function (k) { + return function (v) { + return function () { m[k] = v; return m; }; @@ -26,11 +26,11 @@ exports.poke = function(m) { }; }; -exports._delete = function(m) { - return function(k) { - return function() { +exports["delete"] = function (m) { + return function (k) { + return function () { delete m[k]; return m; }; }; -}; \ No newline at end of file +}; diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs index dd435e08..faf45cf4 100644 --- a/src/Data/StrMap/ST.purs +++ b/src/Data/StrMap/ST.purs @@ -12,9 +12,8 @@ module Data.StrMap.ST import Prelude -import Control.Monad.Eff -import Control.Monad.ST -import Data.Maybe +import Control.Monad.Eff (Eff()) +import Control.Monad.ST (ST()) -- | A reference to a mutable map -- | @@ -23,11 +22,8 @@ import Data.Maybe -- | The runtime representation of a value of type `STStrMap h a` is the same as that of `StrMap a`, except that mutation is allowed. foreign import data STStrMap :: * -> * -> * -foreign import _new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) - -- | Create a new, empty mutable map -new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) -new = _new +foreign import new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) -- | Get the value for a key in a mutable map foreign import peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a @@ -35,8 +31,5 @@ foreign import peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | -- | Update the value for a key in a mutable map foreign import poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) -foreign import _delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) - -- | Remove a key and the corresponding value from a mutable map -delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) -delete = _delete +foreign import delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) diff --git a/src/Data/StrMap/ST/Unsafe.js b/src/Data/StrMap/ST/Unsafe.js index 46df269e..b18005f2 100644 --- a/src/Data/StrMap/ST/Unsafe.js +++ b/src/Data/StrMap/ST/Unsafe.js @@ -3,8 +3,8 @@ // module Data.StrMap.ST.Unsafe -exports.unsafeGet = function(m) { - return function() { +exports.unsafeGet = function (m) { + return function () { return m; - } -}; \ No newline at end of file + }; +}; diff --git a/src/Data/StrMap/Unsafe.js b/src/Data/StrMap/Unsafe.js index d781b72e..40c9e19c 100644 --- a/src/Data/StrMap/Unsafe.js +++ b/src/Data/StrMap/Unsafe.js @@ -3,8 +3,8 @@ // module Data.StrMap.Unsafe -exports.unsafeIndex = function(m) { - return function(k) { +exports.unsafeIndex = function (m) { + return function (k) { return m[k]; }; -}; \ No newline at end of file +}; diff --git a/src/Data/StrMap/Unsafe.purs b/src/Data/StrMap/Unsafe.purs index 167b5ac7..137e7226 100644 --- a/src/Data/StrMap/Unsafe.purs +++ b/src/Data/StrMap/Unsafe.purs @@ -4,7 +4,7 @@ module Data.StrMap.Unsafe import Prelude -import Data.StrMap +import Data.StrMap (StrMap()) -- | Unsafely get the value for a key in a map. -- | diff --git a/tests/Data/Map.purs b/test/Test/Data/Map.purs similarity index 97% rename from tests/Data/Map.purs rename to test/Test/Data/Map.purs index 9f92ee3a..becf5ab8 100644 --- a/tests/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -1,23 +1,26 @@ -module Tests.Data.Map where +module Test.Data.Map where import Prelude import Control.Alt ((<|>)) -import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton, toList) +import Control.Monad.Eff.Console (log) import Data.Foldable (foldl, for_) import Data.Function (on) +import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton, toList) import Data.Maybe (Maybe(..), fromMaybe) import Data.Tuple (Tuple(..), fst) -import Control.Monad.Eff.Console (log) -import Test.Data.List import Test.QuickCheck ((), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import Test.QuickCheck.Gen (Gen(..)) + import qualified Data.Map as M instance arbMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (M.Map k v) where arbitrary = M.fromList <$> arbitrary +instance arbitraryList :: (Arbitrary a) => Arbitrary (List a) where + arbitrary = toList <$> (arbitrary :: Gen (Array a)) + data SmallKey = A | B | C | D | E | F | G | H | I | J instance showSmallKey :: Show SmallKey where diff --git a/tests/Data/StrMap.purs b/test/Test/Data/StrMap.purs similarity index 96% rename from tests/Data/StrMap.purs rename to test/Test/Data/StrMap.purs index ff24cff5..31af46b9 100644 --- a/tests/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -1,4 +1,4 @@ -module Tests.Data.StrMap where +module Test.Data.StrMap where import Prelude @@ -8,7 +8,6 @@ import Data.Function (on) import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple(..), fst) import Control.Monad.Eff.Console (log) -import Test.Data.List import Test.QuickCheck ((), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import Test.QuickCheck.Gen (Gen(..)) @@ -18,6 +17,9 @@ import qualified Data.StrMap as M instance arbStrMap :: (Arbitrary v) => Arbitrary (M.StrMap v) where arbitrary = M.fromList <$> arbitrary +instance arbitraryList :: (Arbitrary a) => Arbitrary (List a) where + arbitrary = toList <$> (arbitrary :: Gen (Array a)) + data Instruction k v = Insert k v | Delete k instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where diff --git a/tests/Tests.purs b/test/Test/Main.purs similarity index 56% rename from tests/Tests.purs rename to test/Test/Main.purs index a0bbff08..814d8713 100644 --- a/tests/Tests.purs +++ b/test/Test/Main.purs @@ -1,12 +1,11 @@ -module Tests where +module Test.Main where import Prelude import Control.Monad.Eff.Console (log) -import Test.QuickCheck -import Tests.Data.Map (mapTests) -import Tests.Data.StrMap (strMapTests) +import Test.Data.Map (mapTests) +import Test.Data.StrMap (strMapTests) main = do log "Running Map tests" From 03e64fcd4a10df167ee6bbeba4245652beffa4e2 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 2 Jul 2015 23:48:21 +0100 Subject: [PATCH 039/125] Tweak dependency bounds --- bower.json | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/bower.json b/bower.json index b7819e28..6bdd9cc4 100644 --- a/bower.json +++ b/bower.json @@ -24,11 +24,11 @@ "package.json" ], "dependencies": { - "purescript-lists": "~0.7.0", - "purescript-st": "~0.1.0", - "purescript-functions": "~0.1.0" + "purescript-lists": "^0.7.0", + "purescript-st": "^0.1.0", + "purescript-functions": "^0.1.0" }, "devDependencies": { - "purescript-quickcheck": "~0.6.0" + "purescript-quickcheck": "^0.6.0" } } From 45fef63d9d35b0557a09eca2a37bed1a0a4195e6 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sun, 26 Jul 2015 22:44:22 +0100 Subject: [PATCH 040/125] Generalize `unions` --- src/Data/Map.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index de9a7386..c8e79f82 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -275,7 +275,7 @@ union :: forall k v. (Ord k) => Map k v -> Map k v -> Map k v union = unionWith const -- | Compute the union of a collection of maps -unions :: forall k v. (Ord k) => List (Map k v) -> Map k v +unions :: forall k v f. (Ord k, Foldable f) => f (Map k v) -> Map k v unions = foldl union empty -- | Calculate the number of key/value pairs in a map From 281c7fc02cc0b742e0b1e3f16b81be6e3413e9bd Mon Sep 17 00:00:00 2001 From: sharkdp Date: Tue, 28 Jul 2015 21:34:26 +0200 Subject: [PATCH 041/125] Fix broken StrMap Functor instance, closes #38 --- src/Data/StrMap.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index ecfa29ad..4b8567da 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -35,7 +35,7 @@ exports.runST = function (f) { exports._fmapStrMap = function (m0, f) { var m = {}; for (var k in m0) { - if (m.hasOwnProperty(k)) { + if (m0.hasOwnProperty(k)) { m[k] = f(m0[k]); } } From aab648f20df5bf2320d1a47175464632bf11823b Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 13 Aug 2015 15:15:15 +0100 Subject: [PATCH 042/125] Updated dependencies --- bower.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bower.json b/bower.json index 6bdd9cc4..727be5b6 100644 --- a/bower.json +++ b/bower.json @@ -29,6 +29,6 @@ "purescript-functions": "^0.1.0" }, "devDependencies": { - "purescript-quickcheck": "^0.6.0" + "purescript-quickcheck": "^0.7.0" } } From 7488b1d95e4e1e973815efb29be5841fa70931c1 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 18 Aug 2015 14:32:42 +0100 Subject: [PATCH 043/125] Update tests --- bower.json | 2 +- test/Test/Data/Map.purs | 24 ++++++++++++------------ test/Test/Data/StrMap.purs | 24 +++++++++++++----------- 3 files changed, 26 insertions(+), 24 deletions(-) diff --git a/bower.json b/bower.json index 727be5b6..594283b9 100644 --- a/bower.json +++ b/bower.json @@ -29,6 +29,6 @@ "purescript-functions": "^0.1.0" }, "devDependencies": { - "purescript-quickcheck": "^0.7.0" + "purescript-quickcheck": "^0.10.1" } } diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index becf5ab8..14e927a9 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -15,11 +15,10 @@ import Test.QuickCheck.Gen (Gen(..)) import qualified Data.Map as M -instance arbMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (M.Map k v) where - arbitrary = M.fromList <$> arbitrary +newtype TestMap k v = TestMap (M.Map k v) -instance arbitraryList :: (Arbitrary a) => Arbitrary (List a) where - arbitrary = toList <$> (arbitrary :: Gen (Array a)) +instance arbTestMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (TestMap k v) where + arbitrary = TestMap <<< M.fromList <$> arbitrary data SmallKey = A | B | C | D | E | F | G | H | I | J @@ -160,7 +159,7 @@ mapTests = do in f (f arr) == f (arr :: List (Tuple SmallKey Int)) show arr log "fromList . toList = id" - quickCheck $ \m -> let f m = M.fromList (M.toList m) in + quickCheck $ \(TestMap m) -> let f m = M.fromList (M.toList m) in M.toList (f m) == M.toList (m :: M.Map SmallKey Int) show m log "fromListWith const = fromList" @@ -176,26 +175,27 @@ mapTests = do M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr log "Lookup from union" - quickCheck $ \m1 m2 k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of - Nothing -> M.lookup k m2 - Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) + quickCheck $ \(TestMap m1) (TestMap m2) k -> + M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of + Nothing -> M.lookup k m2 + Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) log "Union is idempotent" - quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Int)) + quickCheck $ \(TestMap m1) (TestMap m2) -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Int)) log "Union prefers left" - quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 (m2 :: M.Map SmallKey Int)) == (M.lookup k m1 <|> M.lookup k m2) + quickCheck $ \(TestMap m1) (TestMap m2) k -> M.lookup k (M.union m1 (m2 :: M.Map SmallKey Int)) == (M.lookup k m1 <|> M.lookup k m2) log "unionWith" for_ [Tuple (+) 0, Tuple (*) 1] $ \(Tuple op ident) -> - quickCheck $ \m1 m2 k -> + quickCheck $ \(TestMap m1) (TestMap m2) k -> let u = M.unionWith op m1 m2 :: M.Map SmallKey Int in case M.lookup k u of Nothing -> not (M.member k m1 || M.member k m2) Just v -> v == op (fromMaybe ident (M.lookup k m1)) (fromMaybe ident (M.lookup k m2)) log "unionWith argument order" - quickCheck $ \m1 m2 k -> + quickCheck $ \(TestMap m1) (TestMap m2) k -> let u = M.unionWith (-) m1 m2 :: M.Map SmallKey Int in1 = M.member k m1 v1 = M.lookup k m1 diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 31af46b9..90de75f1 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -14,11 +14,10 @@ import Test.QuickCheck.Gen (Gen(..)) import qualified Data.String as S import qualified Data.StrMap as M -instance arbStrMap :: (Arbitrary v) => Arbitrary (M.StrMap v) where - arbitrary = M.fromList <$> arbitrary +newtype TestStrMap v = TestStrMap (M.StrMap v) -instance arbitraryList :: (Arbitrary a) => Arbitrary (List a) where - arbitrary = toList <$> (arbitrary :: Gen (Array a)) +instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where + arbitrary = TestStrMap <<< M.fromList <$> arbitrary data Instruction k v = Insert k v | Delete k @@ -88,8 +87,9 @@ strMapTests = do in f (f arr) == f (arr :: List (Tuple String Int)) show arr log "fromList . toList = id" - quickCheck $ \m -> let f m = M.fromList (M.toList m) in - M.toList (f m) == M.toList (m :: M.StrMap Int) show m + quickCheck $ \(TestStrMap m) -> + let f m = M.fromList (M.toList m) in + M.toList (f m) == M.toList (m :: M.StrMap Int) show m log "fromListWith const = fromList" quickCheck $ \arr -> M.fromListWith const arr == @@ -104,12 +104,14 @@ strMapTests = do M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr log "Lookup from union" - quickCheck $ \m1 m2 k -> M.lookup k (M.union m1 m2) == (case M.lookup k m1 of - Nothing -> M.lookup k m2 - Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) + quickCheck $ \(TestStrMap m1) (TestStrMap m2) k -> + M.lookup k (M.union m1 m2) == (case M.lookup k m1 of + Nothing -> M.lookup k m2 + Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) log "Union is idempotent" - quickCheck $ \m1 m2 -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Int)) (show (M.size (m1 `M.union` m2)) ++ " != " ++ show (M.size ((m1 `M.union` m2) `M.union` m2))) + quickCheck $ \(TestStrMap m1) (TestStrMap m2) -> + (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Int)) (show (M.size (m1 `M.union` m2)) ++ " != " ++ show (M.size ((m1 `M.union` m2) `M.union` m2))) log "toList = zip keys values" - quickCheck $ \m -> M.toList m == zipWith Tuple (toList $ M.keys m) (M.values m :: List Int) + quickCheck $ \(TestStrMap m) -> M.toList m == zipWith Tuple (toList $ M.keys m) (M.values m :: List Int) From 7baf7ae1d57ec0bf549b5e33aa6373ee03a515d7 Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Tue, 25 Aug 2015 16:52:23 -0700 Subject: [PATCH 044/125] QC-0.11 --- bower.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bower.json b/bower.json index 594283b9..9358b700 100644 --- a/bower.json +++ b/bower.json @@ -29,6 +29,6 @@ "purescript-functions": "^0.1.0" }, "devDependencies": { - "purescript-quickcheck": "^0.10.1" + "purescript-quickcheck": "^0.11.0" } } From 524046b13a0ee0da02f00f43b5bb24ce758049ee Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Tue, 25 Aug 2015 16:53:49 -0700 Subject: [PATCH 045/125] Fix tests --- test/Test/Data/Map.purs | 4 ++-- test/Test/Data/StrMap.purs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 14e927a9..266232de 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -132,7 +132,7 @@ mapTests = do ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) log "Check balance property" - quickCheck' 5000 $ \instrs -> + quickCheck' 1000 $ \instrs -> let tree :: M.Map SmallKey Int tree = runInstructions instrs M.empty @@ -145,7 +145,7 @@ mapTests = do quickCheck $ \k v -> M.lookup (k :: SmallKey) (M.singleton k (v :: Int)) == Just v log "Random lookup" - quickCheck' 5000 $ \instrs k v -> + quickCheck' 1000 $ \instrs k v -> let tree :: M.Map SmallKey Int tree = M.insert k v (runInstructions instrs M.empty) diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 90de75f1..1f3bd899 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -73,7 +73,7 @@ strMapTests = do quickCheck $ \k v -> M.lookup k (M.singleton k (v :: Int)) == Just v log "Random lookup" - quickCheck' 5000 $ \instrs k v -> + quickCheck' 1000 $ \instrs k v -> let tree :: M.StrMap Int tree = M.insert k v (runInstructions instrs M.empty) From f725df0f99d350f2e707a2e2bb5fe01f1db46e88 Mon Sep 17 00:00:00 2001 From: Jake Brownson Date: Fri, 18 Sep 2015 16:58:28 -0700 Subject: [PATCH 046/125] fix peek to return Maybe, update docs --- docs/Data/Map.md | 2 +- docs/Data/StrMap/ST.md | 2 +- src/Data/StrMap/ST.js | 13 +++++++++---- src/Data/StrMap/ST.purs | 6 +++++- 4 files changed, 16 insertions(+), 7 deletions(-) diff --git a/docs/Data/Map.md b/docs/Data/Map.md index 1b97f947..e20f9c29 100644 --- a/docs/Data/Map.md +++ b/docs/Data/Map.md @@ -175,7 +175,7 @@ of duplicate keys #### `unions` ``` purescript -unions :: forall k v. (Ord k) => List (Map k v) -> Map k v +unions :: forall k v f. (Ord k, Foldable f) => f (Map k v) -> Map k v ``` Compute the union of a collection of maps diff --git a/docs/Data/StrMap/ST.md b/docs/Data/StrMap/ST.md index 9913c780..135d883b 100644 --- a/docs/Data/StrMap/ST.md +++ b/docs/Data/StrMap/ST.md @@ -27,7 +27,7 @@ Create a new, empty mutable map #### `peek` ``` purescript -peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a +peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (Maybe a) ``` Get the value for a key in a mutable map diff --git a/src/Data/StrMap/ST.js b/src/Data/StrMap/ST.js index 347bd110..8bf2671f 100644 --- a/src/Data/StrMap/ST.js +++ b/src/Data/StrMap/ST.js @@ -7,10 +7,15 @@ exports["new"] = function () { return {}; }; -exports.peek = function (m) { - return function (k) { - return function () { - return m[k]; +exports.peekImpl = function (just) { + return function (nothing) { + return function (m) { + return function (k) { + return function () { + var x = m[k]; + return x === undefined ? nothing : just(x); + }; + }; }; }; }; diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs index faf45cf4..a13ed955 100644 --- a/src/Data/StrMap/ST.purs +++ b/src/Data/StrMap/ST.purs @@ -14,6 +14,7 @@ import Prelude import Control.Monad.Eff (Eff()) import Control.Monad.ST (ST()) +import Data.Maybe (Maybe(..)) -- | A reference to a mutable map -- | @@ -26,7 +27,10 @@ foreign import data STStrMap :: * -> * -> * foreign import new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) -- | Get the value for a key in a mutable map -foreign import peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) a +peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (Maybe a) +peek = peekImpl Just Nothing + +foreign import peekImpl :: forall a b h r. (a -> b) -> b -> STStrMap h a -> String -> Eff (st :: ST h | r) b -- | Update the value for a key in a mutable map foreign import poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) From 3addff5632b5377be2db6eddaa2e21ce541d7a78 Mon Sep 17 00:00:00 2001 From: Jake Brownson Date: Fri, 18 Sep 2015 17:16:20 -0700 Subject: [PATCH 047/125] use hasOwnProperty instead of === --- src/Data/StrMap/ST.js | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Data/StrMap/ST.js b/src/Data/StrMap/ST.js index 8bf2671f..abcc6399 100644 --- a/src/Data/StrMap/ST.js +++ b/src/Data/StrMap/ST.js @@ -12,8 +12,7 @@ exports.peekImpl = function (just) { return function (m) { return function (k) { return function () { - var x = m[k]; - return x === undefined ? nothing : just(x); + return m.hasOwnProperty(k) ? just(m[k]) : nothing; }; }; }; From e2f7974deb08646b9d5535c0f8bd1f04491a14e2 Mon Sep 17 00:00:00 2001 From: Jake Brownson Date: Fri, 18 Sep 2015 22:02:47 -0700 Subject: [PATCH 048/125] avoid problem if the map has a key called hasOwnProperty --- src/Data/StrMap/ST.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/StrMap/ST.js b/src/Data/StrMap/ST.js index abcc6399..bc0a0e47 100644 --- a/src/Data/StrMap/ST.js +++ b/src/Data/StrMap/ST.js @@ -12,7 +12,7 @@ exports.peekImpl = function (just) { return function (m) { return function (k) { return function () { - return m.hasOwnProperty(k) ? just(m[k]) : nothing; + return {}.hasOwnProperty.call(m, k) ? just(m[k]) : nothing; }; }; }; From 38029d55f7ddf56fc36b142d84d33596a454a494 Mon Sep 17 00:00:00 2001 From: Jake Brownson Date: Sun, 20 Sep 2015 20:40:25 -0700 Subject: [PATCH 049/125] Fix copy/paste doc error for Data.StrMap.ST.Unsave.unsafeGet --- docs/Data/StrMap/ST/Unsafe.md | 4 ++-- src/Data/StrMap/ST/Unsafe.purs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/docs/Data/StrMap/ST/Unsafe.md b/docs/Data/StrMap/ST/Unsafe.md index 02524467..a94aa46d 100644 --- a/docs/Data/StrMap/ST/Unsafe.md +++ b/docs/Data/StrMap/ST/Unsafe.md @@ -6,8 +6,8 @@ unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) ``` -Unsafely get the value for a key in a map. +Unsafely get the map out of ST without copying it -This function does not check whether the key exists in the map. +If you later change the ST version of the map the pure value will also change. diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs index eeb1aa1f..1ad27016 100644 --- a/src/Data/StrMap/ST/Unsafe.purs +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -9,7 +9,7 @@ import Control.Monad.ST (ST()) import Data.StrMap (StrMap()) import Data.StrMap.ST (STStrMap()) --- | Unsafely get the value for a key in a map. +-- | Unsafely get the map out of ST without copying it -- | --- | This function does not check whether the key exists in the map. +-- | If you later change the ST version of the map the pure value will also change. foreign import unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) From 6737ede24e14d087c4e36eb1ff9be8bf6edff625 Mon Sep 17 00:00:00 2001 From: Petr Vapenka Date: Fri, 16 Oct 2015 19:07:22 +0200 Subject: [PATCH 050/125] Get rid of compiler warnings - impossible pattern matches (throwUnsafe in place) - unused type variables - unused imports --- src/Data/Map.purs | 6 ++++++ src/Data/StrMap.purs | 2 +- test/Test/Data/Map.purs | 3 ++- test/Test/Data/StrMap.purs | 1 - 4 files changed, 9 insertions(+), 3 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index c8e79f82..e92ba9f1 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -30,6 +30,7 @@ import Prelude import Data.Foldable (foldl, foldMap, foldr, Foldable) import Data.List (List(..), length, nub) import Data.Maybe (Maybe(..), maybe, isJust) +import Data.Maybe.Unsafe (unsafeThrow) import Data.Monoid (Monoid) import Data.Traversable (traverse, Traversable) import Data.Tuple (Tuple(..), uncurry) @@ -210,18 +211,23 @@ delete = down Nil up (Cons (ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e) ctx) d = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) up (Cons (ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e)) ctx) b = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) up (Cons (ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4) ctx) e = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) + up _ _ = unsafeThrow "Impossible case in 'up'" maxNode :: forall k v. (Ord k) => Map k v -> { key :: k, value :: v } maxNode (Two _ k v Leaf) = { key: k, value: v } maxNode (Two _ _ _ right) = maxNode right maxNode (Three _ _ _ _ k v Leaf) = { key: k, value: v } maxNode (Three _ _ _ _ _ _ right) = maxNode right + maxNode Leaf = unsafeThrow "Impossible case in 'maxNode'" + removeMaxNode :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v removeMaxNode ctx (Two Leaf _ _ Leaf) = up ctx Leaf removeMaxNode ctx (Two left k v right) = removeMaxNode (Cons (TwoRight left k v) ctx) right removeMaxNode ctx (Three Leaf k1 v1 Leaf _ _ Leaf) = up (Cons (TwoRight Leaf k1 v1) ctx) Leaf removeMaxNode ctx (Three left k1 v1 mid k2 v2 right) = removeMaxNode (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right + removeMaxNode _ Leaf = unsafeThrow "Impossible case in 'removeMaxNode'" + -- | Insert the value, delete a value, or update a value for a key in a map alter :: forall k v. (Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 901fb883..d6bc24de 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -69,7 +69,7 @@ freezeST = _copyEff -- | The rank-2 type prevents the map from escaping the scope of `runST`. foreign import runST :: 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 :: forall a. (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 diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 266232de..6fcc8cfb 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -8,10 +8,10 @@ import Data.Foldable (foldl, for_) import Data.Function (on) import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton, toList) import Data.Maybe (Maybe(..), fromMaybe) +import Data.Maybe.Unsafe (unsafeThrow) import Data.Tuple (Tuple(..), fst) import Test.QuickCheck ((), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) -import Test.QuickCheck.Gen (Gen(..)) import qualified Data.Map as M @@ -170,6 +170,7 @@ mapTests = do quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) foldl1 g (Cons x xs) = foldl g x xs + foldl1 _ Nil = unsafeThrow "Impossible case in 'foldl1'" f = M.fromList <<< (<$>) (foldl1 combine) <<< groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 1f3bd899..7ffe76a0 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -10,7 +10,6 @@ import Data.Tuple (Tuple(..), fst) import Control.Monad.Eff.Console (log) import Test.QuickCheck ((), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) -import Test.QuickCheck.Gen (Gen(..)) import qualified Data.String as S import qualified Data.StrMap as M From a265965e5a75fa2b9cdaf0d19d7e8fd7c7291d69 Mon Sep 17 00:00:00 2001 From: Petr Vapenka Date: Fri, 16 Oct 2015 19:16:25 +0200 Subject: [PATCH 051/125] Resolve forgotten compiler warning --- test/Test/Data/StrMap.purs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 7ffe76a0..c580a477 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -6,6 +6,7 @@ import Data.List (List(..), groupBy, sortBy, singleton, toList, zipWith) import Data.Foldable (foldl) import Data.Function (on) import Data.Maybe (Maybe(..)) +import Data.Maybe.Unsafe (unsafeThrow) import Data.Tuple (Tuple(..), fst) import Control.Monad.Eff.Console (log) import Test.QuickCheck ((), quickCheck, quickCheck') @@ -98,6 +99,7 @@ strMapTests = do quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) foldl1 g (Cons x xs) = foldl g x xs + foldl1 _ Nil = unsafeThrow "Impossible case in 'foldl1'" f = M.fromList <<< (<$>) (foldl1 combine) <<< groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr From 3509d9384cf157c54c06cd26672306c977d3514c Mon Sep 17 00:00:00 2001 From: aspidites Date: Tue, 20 Oct 2015 14:50:50 -0400 Subject: [PATCH 052/125] Changed a type variable in an attempt to quelch shadow warnings. --- src/Data/StrMap.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index d6bc24de..fc211f14 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -111,7 +111,7 @@ instance traversableStrMap :: Traversable StrMap where -- Unfortunately the above are not short-circuitable (consider using purescript-machines) -- so we need special cases: -foreign import _foldSCStrMap :: forall a z. Fn4 (StrMap a) z (z -> String -> a -> Maybe z) (forall a. a -> Maybe a -> a) z +foreign import _foldSCStrMap :: forall a z. Fn4 (StrMap a) z (z -> String -> a -> Maybe z) (forall b. b -> Maybe b -> b) z -- | Fold the keys and values of a map. -- | From c816f452d62acfb916fb4f22960aefa087104d05 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 19 Nov 2015 12:27:27 +0000 Subject: [PATCH 053/125] Fix shadowed type variable warnings --- src/Data/Map.purs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index e92ba9f1..bae87bbb 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -106,7 +106,7 @@ singleton k v = Two Leaf k v Leaf checkValid :: forall k v. Map k v -> Boolean checkValid tree = length (nub (allHeights tree)) == one where - allHeights :: forall k v. Map k v -> List Int + allHeights :: Map k v -> List Int allHeights Leaf = pure zero allHeights (Two left _ _ right) = map (\n -> n + one) (allHeights left ++ allHeights right) allHeights (Three left _ _ mid _ _ right) = map (\n -> n + one) (allHeights left ++ allHeights mid ++ allHeights right) @@ -148,7 +148,7 @@ data KickUp k v = KickUp (Map k v) k v (Map k v) insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v insert = down Nil where - down :: forall k v. (Ord k) => List (TreeContext k v) -> k -> v -> Map k v -> Map k v + down :: List (TreeContext k v) -> k -> v -> Map k v -> Map k v down ctx k v Leaf = up ctx (KickUp Leaf k v Leaf) down ctx k v (Two left k1 _ right) | k == k1 = fromZipper ctx (Two left k v right) down ctx k v (Two left k1 v1 right) | k < k1 = down (Cons (TwoLeft k1 v1 right) ctx) k v left @@ -159,7 +159,7 @@ insert = down Nil down ctx k v (Three left k1 v1 mid k2 v2 right) | k1 < k && k <= k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid down ctx k v (Three left k1 v1 mid k2 v2 right) = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right - up :: forall k v. (Ord k) => List (TreeContext k v) -> KickUp k v -> Map k v + up :: List (TreeContext k v) -> KickUp k v -> Map k v up Nil (KickUp left k v right) = Two left k v right up (Cons (TwoLeft k1 v1 right) ctx) (KickUp left k v mid) = fromZipper ctx (Three left k v mid k1 v1 right) up (Cons (TwoRight left k1 v1) ctx) (KickUp mid k v right) = fromZipper ctx (Three left k1 v1 mid k v right) @@ -171,7 +171,7 @@ insert = down Nil delete :: forall k v. (Ord k) => k -> Map k v -> Map k v delete = down Nil where - down :: forall k v. (Ord k) => List (TreeContext k v) -> k -> Map k v -> Map k v + down :: List (TreeContext k v) -> k -> Map k v -> Map k v down ctx _ Leaf = fromZipper ctx Leaf down ctx k (Two Leaf k1 _ Leaf) | k == k1 = up ctx Leaf @@ -192,7 +192,7 @@ delete = down Nil | k1 < k && k < k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid | otherwise = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right - up :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v + up :: List (TreeContext k v) -> Map k v -> Map k v up Nil tree = tree up (Cons (TwoLeft k1 v1 Leaf) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) up (Cons (TwoRight Leaf k1 v1) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) @@ -213,7 +213,7 @@ delete = down Nil up (Cons (ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4) ctx) e = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) up _ _ = unsafeThrow "Impossible case in 'up'" - maxNode :: forall k v. (Ord k) => Map k v -> { key :: k, value :: v } + maxNode :: Map k v -> { key :: k, value :: v } maxNode (Two _ k v Leaf) = { key: k, value: v } maxNode (Two _ _ _ right) = maxNode right maxNode (Three _ _ _ _ k v Leaf) = { key: k, value: v } @@ -221,7 +221,7 @@ delete = down Nil maxNode Leaf = unsafeThrow "Impossible case in 'maxNode'" - removeMaxNode :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v + removeMaxNode :: List (TreeContext k v) -> Map k v -> Map k v removeMaxNode ctx (Two Leaf _ _ Leaf) = up ctx Leaf removeMaxNode ctx (Two left k v right) = removeMaxNode (Cons (TwoRight left k v) ctx) right removeMaxNode ctx (Three Leaf k1 v1 Leaf _ _ Leaf) = up (Cons (TwoRight Leaf k1 v1) ctx) Leaf From 6352e932f2b4a8bbedc3225ef40978af320c65a2 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 20 Nov 2015 01:17:14 +0000 Subject: [PATCH 054/125] Fix for new jshint --- .jshintrc | 2 +- package.json | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.jshintrc b/.jshintrc index f3911591..2240be2a 100644 --- a/.jshintrc +++ b/.jshintrc @@ -5,7 +5,7 @@ "freeze": true, "funcscope": true, "futurehostile": true, - "globalstrict": true, + "strict": "global", "latedef": true, "maxparams": 1, "noarg": true, diff --git a/package.json b/package.json index 7b325064..fcbd3a85 100644 --- a/package.json +++ b/package.json @@ -6,7 +6,7 @@ }, "devDependencies": { "jscs": "^1.13.1", - "jshint": "^2.8.0", + "jshint": "^2.9.1-rc.1", "pulp": "^4.0.2", "rimraf": "^2.4.1" } From fc6a29c6ab26c38f9e99a96035597fec842e4f4d Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sat, 5 Dec 2015 14:05:52 +0000 Subject: [PATCH 055/125] Update quickcheck dependency --- bower.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bower.json b/bower.json index 9358b700..c030c253 100644 --- a/bower.json +++ b/bower.json @@ -29,6 +29,6 @@ "purescript-functions": "^0.1.0" }, "devDependencies": { - "purescript-quickcheck": "^0.11.0" + "purescript-quickcheck": "^0.12.0" } } From 3c762445e118589bcbdaf10725ce4075312da50f Mon Sep 17 00:00:00 2001 From: Liam Goodacre Date: Sun, 13 Dec 2015 13:18:40 +0000 Subject: [PATCH 056/125] New functions to `Data.Map` and `Data.StrMap` * `Data.Map.fromFoldable` * `Data.Map.fromFoldableWith` * `Data.StrMap.fromFoldable` * `Data.StrMap.fromFoldableWith` Other things: * Added basic tests * Corrected doc comments on some functions mentioning array when they meant list * Modified Gen import in tests as there was a compiler warning about it * Docs regenerated --- docs/Data/Map.md | 44 +++++++++++++++++++++++++++----------- docs/Data/StrMap.md | 39 +++++++++++++++++++++++---------- src/Data/Map.purs | 30 ++++++++++++++++++-------- src/Data/StrMap.purs | 31 +++++++++++++++++++-------- test/Test/Data/Map.purs | 22 +++++++++++++++++++ test/Test/Data/StrMap.purs | 22 +++++++++++++++++++ 6 files changed, 146 insertions(+), 42 deletions(-) diff --git a/docs/Data/Map.md b/docs/Data/Map.md index e20f9c29..1c32d000 100644 --- a/docs/Data/Map.md +++ b/docs/Data/Map.md @@ -13,14 +13,14 @@ data Map k v ##### Instances ``` purescript -instance eqMap :: (Eq k, Eq v) => Eq (Map k v) -instance showMap :: (Show k, Show v) => Show (Map k v) -instance ordMap :: (Ord k, Ord v) => Ord (Map k v) -instance semigroupMap :: (Ord k) => Semigroup (Map k v) -instance monoidMap :: (Ord k) => Monoid (Map k v) -instance functorMap :: Functor (Map k) -instance foldableMap :: Foldable (Map k) -instance traversableMap :: (Ord k) => Traversable (Map k) +(Eq k, Eq v) => Eq (Map k v) +(Show k, Show v) => Show (Map k v) +(Ord k, Ord v) => Ord (Map k v) +(Ord k) => Semigroup (Map k v) +(Ord k) => Monoid (Map k v) +Functor (Map k) +Foldable (Map k) +(Ord k) => Traversable (Map k) ``` #### `showTree` @@ -113,13 +113,31 @@ update :: forall k v. (Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v Update or delete the value for a key in a map +#### `fromFoldable` + +``` purescript +fromFoldable :: forall f k v. (Ord k, Foldable f) => f (Tuple k v) -> Map k v +``` + +Convert any foldable collection of key/value pairs to a map. +On key collision, later values take precedence over earlier ones. + +#### `fromFoldableWith` + +``` purescript +fromFoldableWith :: forall f k v. (Ord k, Foldable f) => (v -> v -> v) -> f (Tuple k v) -> Map k v +``` + +Convert any foldable collection of key/value pairs to a map. +On key collision, the values are configurably combined. + #### `toList` ``` purescript toList :: forall k v. Map k v -> List (Tuple k v) ``` -Convert a map to an array of key/value pairs +Convert a map to a list of key/value pairs #### `fromList` @@ -127,7 +145,7 @@ Convert a map to an array of key/value pairs fromList :: forall k v. (Ord k) => List (Tuple k v) -> Map k v ``` -Create a map from an array of key/value pairs +Create a map from a list of key/value pairs #### `fromListWith` @@ -135,7 +153,7 @@ Create a map from an array of key/value pairs fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> List (Tuple k v) -> Map k v ``` -Create a map from an array of key/value pairs, using the specified function +Create a map from a list of key/value pairs, using the specified function to combine values for duplicate keys. #### `keys` @@ -144,7 +162,7 @@ to combine values for duplicate keys. keys :: forall k v. Map k v -> List k ``` -Get an array of the keys contained in a map +Get a list of the keys contained in a map #### `values` @@ -152,7 +170,7 @@ Get an array of the keys contained in a map values :: forall k v. Map k v -> List v ``` -Get an array of the values contained in a map +Get a list of the values contained in a map #### `unionWith` diff --git a/docs/Data/StrMap.md b/docs/Data/StrMap.md index 57a5ad69..ac92562c 100644 --- a/docs/Data/StrMap.md +++ b/docs/Data/StrMap.md @@ -16,13 +16,13 @@ data StrMap :: * -> * ##### Instances ``` purescript -instance functorStrMap :: Functor StrMap -instance foldableStrMap :: Foldable StrMap -instance traversableStrMap :: Traversable StrMap -instance eqStrMap :: (Eq a) => Eq (StrMap a) -instance showStrMap :: (Show a) => Show (StrMap a) -instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) -instance monoidStrMap :: (Semigroup a) => Monoid (StrMap a) +Functor StrMap +Foldable StrMap +Traversable StrMap +(Eq a) => Eq (StrMap a) +(Show a) => Show (StrMap a) +(Semigroup a) => Semigroup (StrMap a) +(Semigroup a) => Monoid (StrMap a) ``` #### `thawST` @@ -185,13 +185,30 @@ update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a Remove or update a value for a key in a map +#### `fromFoldable` + +``` purescript +fromFoldable :: forall f a. (Foldable f) => f (Tuple String a) -> StrMap a +``` + +Create a map from a foldable collection of key/value pairs + +#### `fromFoldableWith` + +``` purescript +fromFoldableWith :: forall f a. (Foldable f) => (a -> a -> a) -> f (Tuple String a) -> StrMap a +``` + +Create a map from a foldable collection of key/value pairs, using the +specified function to combine values for duplicate keys. + #### `fromList` ``` purescript fromList :: forall a. List (Tuple String a) -> StrMap a ``` -Create a map from an array of key/value pairs +Create a map from a list of key/value pairs #### `fromListWith` @@ -199,7 +216,7 @@ Create a map from an array of key/value pairs fromListWith :: forall a. (a -> a -> a) -> List (Tuple String a) -> StrMap a ``` -Create a map from an array of key/value pairs, using the specified function +Create a map from a list of key/value pairs, using the specified function to combine values for duplicate keys. #### `toList` @@ -208,7 +225,7 @@ to combine values for duplicate keys. toList :: forall a. StrMap a -> List (Tuple String a) ``` -Convert a map into an array of key/value pairs +Convert a map into a list of key/value pairs #### `keys` @@ -224,7 +241,7 @@ Get an array of the keys in a map values :: forall a. StrMap a -> List a ``` -Get an array of the values in a map +Get a list of the values in a map #### `union` diff --git a/src/Data/Map.purs b/src/Data/Map.purs index bae87bbb..c98be78d 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -10,6 +10,8 @@ module Data.Map , checkValid , insert , lookup + , fromFoldable + , fromFoldableWith , toList , fromList , fromListWith @@ -239,30 +241,40 @@ alter f k m = case f (k `lookup` m) of update :: forall k v. (Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v update f k m = alter (maybe Nothing f) k m --- | Convert a map to an array of key/value pairs +-- | Convert any foldable collection of key/value pairs to a map. +-- | On key collision, later values take precedence over earlier ones. +fromFoldable :: forall f k v. (Ord k, Foldable f) => f (Tuple k v) -> Map k v +fromFoldable = foldl (\m (Tuple k v) -> insert k v m) empty + +-- | Convert any foldable collection of key/value pairs to a map. +-- | On key collision, the values are configurably combined. +fromFoldableWith :: forall f k v. (Ord k, Foldable f) => (v -> v -> v) -> f (Tuple k v) -> Map k v +fromFoldableWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where + combine v (Just v') = Just $ f v v' + combine v Nothing = Just v + +-- | Convert a map to a list of key/value pairs toList :: forall k v. Map k v -> List (Tuple k v) toList Leaf = Nil toList (Two left k v right) = toList left ++ pure (Tuple k v) ++ toList right toList (Three left k1 v1 mid k2 v2 right) = toList left ++ pure (Tuple k1 v1) ++ toList mid ++ pure (Tuple k2 v2) ++ toList right --- | Create a map from an array of key/value pairs +-- | Create a map from a list of key/value pairs fromList :: forall k v. (Ord k) => List (Tuple k v) -> Map k v -fromList = foldl (\m (Tuple k v) -> insert k v m) empty +fromList = fromFoldable --- | Create a map from an array of key/value pairs, using the specified function +-- | Create a map from a list of key/value pairs, using the specified function -- | to combine values for duplicate keys. fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> List (Tuple k v) -> Map k v -fromListWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where - combine v (Just v') = Just $ f v v' - combine v Nothing = Just v +fromListWith = fromFoldableWith --- | Get an array of the keys contained in a map +-- | Get a list of the keys contained in a map keys :: forall k v. Map k v -> List k keys Leaf = Nil keys (Two left k _ right) = keys left ++ pure k ++ keys right keys (Three left k1 _ mid k2 _ right) = keys left ++ pure k1 ++ keys mid ++ pure k2 ++ keys right --- | Get an array of the values contained in a map +-- | Get a list of the values contained in a map values :: forall k v. Map k v -> List v values Leaf = Nil values (Two left _ v right) = values left ++ pure v ++ values right diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index fc211f14..fcffdf44 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -13,6 +13,8 @@ module Data.StrMap , insert , lookup , toList + , fromFoldable + , fromFoldableWith , fromList , fromListWith , delete @@ -181,33 +183,44 @@ 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 --- | Create a map from an array of key/value pairs -fromList :: forall a. L.List (Tuple String a) -> StrMap a -fromList l = pureST (do +-- | Create a map from a foldable collection of key/value pairs +fromFoldable :: forall f a. (Foldable f) => + f (Tuple String a) -> StrMap a +fromFoldable l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> SM.poke s k v) return s) foreign import _lookupST :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z) --- | Create a map from an array of key/value pairs, using the specified function --- | to combine values for duplicate keys. -fromListWith :: forall a. (a -> a -> a) -> L.List (Tuple String a) -> StrMap a -fromListWith f l = pureST (do +-- | Create a map from a foldable collection of key/value pairs, using the +-- | specified function to combine values for duplicate keys. +fromFoldableWith :: forall f a. (Foldable f) => + (a -> a -> a) -> f (Tuple String a) -> StrMap a +fromFoldableWith f l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s >>= SM.poke s k) return s) +-- | Create a map from a list of key/value pairs +fromList :: forall a. L.List (Tuple String a) -> StrMap a +fromList = fromFoldable + +-- | Create a map from a list of key/value pairs, using the specified function +-- | to combine values for duplicate keys. +fromListWith :: forall a. (a -> a -> a) -> L.List (Tuple String a) -> StrMap a +fromListWith = fromFoldableWith + foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array b --- | Convert a map into an array of key/value pairs +-- | Convert a map into a list of key/value pairs toList :: forall a. StrMap a -> L.List (Tuple String a) toList = L.toList <<< _collect Tuple -- | Get an array of the keys in a map foreign import keys :: forall a. StrMap a -> Array String --- | Get an array of the values in a map +-- | Get a list of the values in a map values :: forall a. StrMap a -> L.List a values = L.toList <<< _collect (\_ v -> v) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 6fcc8cfb..99e40342 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -154,6 +154,28 @@ mapTests = do log "Singleton to list" quickCheck $ \k v -> M.toList (M.singleton k v :: M.Map SmallKey Int) == singleton (Tuple k v) + log "fromFoldable [] = empty" + quickCheck (M.fromFoldable [] == (M.empty :: M.Map Unit Unit) + "was not empty") + + log "fromFoldable & key collision" + do + let nums = M.fromFoldable [Tuple 0 "zero", Tuple 1 "what", Tuple 1 "one"] + quickCheck (M.lookup 0 nums == Just "zero" "invalid lookup - 0") + quickCheck (M.lookup 1 nums == Just "one" "invalid lookup - 1") + quickCheck (M.lookup 2 nums == Nothing "invalid lookup - 2") + + log "fromFoldableWith const [] = empty" + quickCheck (M.fromFoldableWith const [] == (M.empty :: M.Map Unit Unit) + "was not empty") + + log "fromFoldableWith (+) & key collision" + do + let nums = M.fromFoldableWith (+) [Tuple 0 1, Tuple 1 1, Tuple 1 1] + quickCheck (M.lookup 0 nums == Just 1 "invalid lookup - 0") + quickCheck (M.lookup 1 nums == Just 2 "invalid lookup - 1") + quickCheck (M.lookup 2 nums == Nothing "invalid lookup - 2") + log "toList . fromList = id" quickCheck $ \arr -> let f x = M.toList (M.fromList x) in f (f arr) == f (arr :: List (Tuple SmallKey Int)) show arr diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index c580a477..021b578b 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -82,6 +82,28 @@ strMapTests = do log "Singleton to list" quickCheck $ \k v -> M.toList (M.singleton k v :: M.StrMap Int) == singleton (Tuple k v) + log "fromFoldable [] = empty" + quickCheck (M.fromFoldable [] == (M.empty :: M.StrMap Unit) + "was not empty") + + log "fromFoldable & key collision" + do + let nums = M.fromFoldable [Tuple "0" "zero", Tuple "1" "what", Tuple "1" "one"] + quickCheck (M.lookup "0" nums == Just "zero" "invalid lookup - 0") + quickCheck (M.lookup "1" nums == Just "one" "invalid lookup - 1") + quickCheck (M.lookup "2" nums == Nothing "invalid lookup - 2") + + log "fromFoldableWith const [] = empty" + quickCheck (M.fromFoldableWith const [] == (M.empty :: M.StrMap Unit) + "was not empty") + + log "fromFoldableWith (+) & key collision" + do + let nums = M.fromFoldableWith (+) [Tuple "0" 1, Tuple "1" 1, Tuple "1" 1] + quickCheck (M.lookup "0" nums == Just 1 "invalid lookup - 0") + quickCheck (M.lookup "1" nums == Just 2 "invalid lookup - 1") + quickCheck (M.lookup "2" nums == Nothing "invalid lookup - 2") + log "toList . fromList = id" quickCheck $ \arr -> let f x = M.toList (M.fromList x) in f (f arr) == f (arr :: List (Tuple String Int)) show arr From 0d338808bca3402d751a5178699e3b4a09a7f23a Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Sat, 9 Jan 2016 08:42:00 -0600 Subject: [PATCH 057/125] Export Data.StrMap.pureST --- docs/Data/StrMap.md | 6 ++++++ src/Data/StrMap.purs | 1 + 2 files changed, 7 insertions(+) diff --git a/docs/Data/StrMap.md b/docs/Data/StrMap.md index ac92562c..f03f3358 100644 --- a/docs/Data/StrMap.md +++ b/docs/Data/StrMap.md @@ -52,6 +52,12 @@ Freeze a mutable map, creating an immutable map. Use this function as you would The rank-2 type prevents the map from escaping the scope of `runST`. +#### `pureST` + +``` purescript +pureST :: forall a. (forall h e. Eff (st :: ST h | e) (STStrMap h a)) -> StrMap a +``` + #### `fold` ``` purescript diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index fcffdf44..18ae631d 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -34,6 +34,7 @@ module Data.StrMap , thawST , freezeST , runST + , pureST ) where import Prelude From ebf42f7b84cc0ccf2abed4e03cdd24ed88d828cc Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Tue, 15 Mar 2016 20:17:00 -0500 Subject: [PATCH 058/125] Better pattern sharing for perf. --- src/Data/Map.purs | 156 ++++++++++++++++++++++++++++------------------ 1 file changed, 94 insertions(+), 62 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index c98be78d..95f6277b 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -116,14 +116,24 @@ checkValid tree = length (nub (allHeights tree)) == one -- | Lookup a value for the specified key lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v lookup _ Leaf = Nothing -lookup k (Two _ k1 v _) | k == k1 = Just v -lookup k (Two left k1 _ _) | k < k1 = lookup k left -lookup k (Two _ _ _ right) = lookup k right -lookup k (Three _ k1 v1 _ _ _ _) | k == k1 = Just v1 -lookup k (Three _ _ _ _ k2 v2 _) | k == k2 = Just v2 -lookup k (Three left k1 _ _ _ _ _) | k < k1 = lookup k left -lookup k (Three _ k1 _ mid k2 _ _) | k1 < k && k <= k2 = lookup k mid -lookup k (Three _ _ _ _ _ _ right) = lookup k right +lookup k tree = + let comp :: k -> k -> Ordering + comp = compare + in case tree of + Two left k1 v right -> + case comp k k1 of + EQ -> Just v + LT -> lookup k left + _ -> lookup k right + Three left k1 v1 mid k2 v2 right -> + case comp k k1 of + EQ -> Just v1 + c1 -> + case c1, comp k k2 of + _ , EQ -> Just v2 + LT, _ -> lookup k left + _ , GT -> lookup k right + _ , _ -> lookup k mid -- | Test if a key is a member of a map member :: forall k v. (Ord k) => k -> Map k v -> Boolean @@ -138,11 +148,13 @@ data TreeContext k v fromZipper :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v fromZipper Nil tree = tree -fromZipper (Cons (TwoLeft k1 v1 right) ctx) left = fromZipper ctx (Two left k1 v1 right) -fromZipper (Cons (TwoRight left k1 v1) ctx) right = fromZipper ctx (Two left k1 v1 right) -fromZipper (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) left = fromZipper ctx (Three left k1 v1 mid k2 v2 right) -fromZipper (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) mid = fromZipper ctx (Three left k1 v1 mid k2 v2 right) -fromZipper (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right = fromZipper ctx (Three left k1 v1 mid k2 v2 right) +fromZipper (Cons x ctx) tree = + case x of + TwoLeft k1 v1 right -> fromZipper ctx (Two tree k1 v1 right) + TwoRight left k1 v1 -> fromZipper ctx (Two left k1 v1 tree) + ThreeLeft k1 v1 mid k2 v2 right -> fromZipper ctx (Three tree k1 v1 mid k2 v2 right) + ThreeMiddle left k1 v1 k2 v2 right -> fromZipper ctx (Three left k1 v1 tree k2 v2 right) + ThreeRight left k1 v1 mid k2 v2 -> fromZipper ctx (Three left k1 v1 mid k2 v2 tree) data KickUp k v = KickUp (Map k v) k v (Map k v) @@ -150,70 +162,90 @@ data KickUp k v = KickUp (Map k v) k v (Map k v) insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v insert = down Nil where + comp :: k -> k -> Ordering + comp = compare + down :: List (TreeContext k v) -> k -> v -> Map k v -> Map k v down ctx k v Leaf = up ctx (KickUp Leaf k v Leaf) - down ctx k v (Two left k1 _ right) | k == k1 = fromZipper ctx (Two left k v right) - down ctx k v (Two left k1 v1 right) | k < k1 = down (Cons (TwoLeft k1 v1 right) ctx) k v left - down ctx k v (Two left k1 v1 right) = down (Cons (TwoRight left k1 v1) ctx) k v right - down ctx k v (Three left k1 _ mid k2 v2 right) | k == k1 = fromZipper ctx (Three left k v mid k2 v2 right) - down ctx k v (Three left k1 v1 mid k2 _ right) | k == k2 = fromZipper ctx (Three left k1 v1 mid k v right) - down ctx k v (Three left k1 v1 mid k2 v2 right) | k < k1 = down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left - down ctx k v (Three left k1 v1 mid k2 v2 right) | k1 < k && k <= k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid - down ctx k v (Three left k1 v1 mid k2 v2 right) = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right + down ctx k v (Two left k1 v1 right) = + case comp k k1 of + EQ -> fromZipper ctx (Two left k v right) + LT -> down (Cons (TwoLeft k1 v1 right) ctx) k v left + _ -> down (Cons (TwoRight left k1 v1) ctx) k v right + down ctx k v (Three left k1 v1 mid k2 v2 right) = + case comp k k1 of + EQ -> fromZipper ctx (Three left k v mid k2 v2 right) + c1 -> + case c1, comp k k2 of + _ , EQ -> fromZipper ctx (Three left k1 v1 mid k v right) + LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left + GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid + _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right up :: List (TreeContext k v) -> KickUp k v -> Map k v up Nil (KickUp left k v right) = Two left k v right - up (Cons (TwoLeft k1 v1 right) ctx) (KickUp left k v mid) = fromZipper ctx (Three left k v mid k1 v1 right) - up (Cons (TwoRight left k1 v1) ctx) (KickUp mid k v right) = fromZipper ctx (Three left k1 v1 mid k v right) - up (Cons (ThreeLeft k1 v1 c k2 v2 d) ctx) (KickUp a k v b) = up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) - up (Cons (ThreeMiddle a k1 v1 k2 v2 d) ctx) (KickUp b k v c) = up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) - up (Cons (ThreeRight a k1 v1 b k2 v2) ctx) (KickUp c k v d) = up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) + up (Cons x ctx) kup = + case x, kup of + TwoLeft k1 v1 right, KickUp left k v mid -> fromZipper ctx (Three left k v mid k1 v1 right) + TwoRight left k1 v1, KickUp mid k v right -> fromZipper ctx (Three left k1 v1 mid k v right) + ThreeLeft k1 v1 c k2 v2 d, KickUp a k v b -> up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) + ThreeMiddle a k1 v1 k2 v2 d, KickUp b k v c -> up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) + ThreeRight a k1 v1 b k2 v2, KickUp c k v d -> up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) -- | Delete a key and its corresponding value from a map delete :: forall k v. (Ord k) => k -> Map k v -> Map k v delete = down Nil where + comp :: k -> k -> Ordering + comp = compare + down :: List (TreeContext k v) -> k -> Map k v -> Map k v down ctx _ Leaf = fromZipper ctx Leaf - down ctx k (Two Leaf k1 _ Leaf) - | k == k1 = up ctx Leaf - down ctx k (Two left k1 v1 right) - | k == k1 = let max = maxNode left - in removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left - | k < k1 = down (Cons (TwoLeft k1 v1 right) ctx) k left - | otherwise = down (Cons (TwoRight left k1 v1) ctx) k right - down ctx k (Three Leaf k1 v1 Leaf k2 v2 Leaf) - | k == k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) - | k == k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) - down ctx k (Three left k1 v1 mid k2 v2 right) - | k == k1 = let max = maxNode left - in removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left - | k == k2 = let max = maxNode mid - in removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid - | k < k1 = down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k left - | k1 < k && k < k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid - | otherwise = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right + down ctx k (Two left k1 v1 right) = + case right, comp k k1 of + Leaf, EQ -> up ctx Leaf + _ , EQ -> let max = maxNode left + in removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left + _ , LT -> down (Cons (TwoLeft k1 v1 right) ctx) k left + _ , _ -> down (Cons (TwoRight left k1 v1) ctx) k right + down ctx k (Three left k1 v1 mid k2 v2 right) = + let leaves = + case left, mid, right of + Leaf, Leaf, Leaf -> true + _ , _ , _ -> false + in case leaves, comp k k1, comp k k2 of + true, EQ, _ -> fromZipper ctx (Two Leaf k2 v2 Leaf) + true, _ , EQ -> fromZipper ctx (Two Leaf k1 v1 Leaf) + _ , EQ, _ -> let max = maxNode left + in removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left + _ , _ , EQ -> let max = maxNode mid + in removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid + _ , LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k left + _ , GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid + _ , _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right up :: List (TreeContext k v) -> Map k v -> Map k v up Nil tree = tree - up (Cons (TwoLeft k1 v1 Leaf) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) - up (Cons (TwoRight Leaf k1 v1) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) - up (Cons (TwoLeft k1 v1 (Two m k2 v2 r)) ctx) l = up ctx (Three l k1 v1 m k2 v2 r) - up (Cons (TwoRight (Two l k1 v1 m) k2 v2) ctx) r = up ctx (Three l k1 v1 m k2 v2 r) - up (Cons (TwoLeft k1 v1 (Three b k2 v2 c k3 v3 d)) ctx) a = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - up (Cons (TwoRight (Three a k1 v1 b k2 v2 c) k3 v3) ctx) d = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - up (Cons (ThreeLeft k1 v1 Leaf k2 v2 Leaf) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - up (Cons (ThreeMiddle Leaf k1 v1 k2 v2 Leaf) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - up (Cons (ThreeRight Leaf k1 v1 Leaf k2 v2) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - up (Cons (ThreeLeft k1 v1 (Two b k2 v2 c) k3 v3 d) ctx) a = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - up (Cons (ThreeMiddle (Two a k1 v1 b) k2 v2 k3 v3 d) ctx) c = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - up (Cons (ThreeMiddle a k1 v1 k2 v2 (Two c k3 v3 d)) ctx) b = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - up (Cons (ThreeRight a k1 v1 (Two b k2 v2 c) k3 v3) ctx) d = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - up (Cons (ThreeLeft k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 e) ctx) a = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - up (Cons (ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e) ctx) d = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - up (Cons (ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e)) ctx) b = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - up (Cons (ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4) ctx) e = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - up _ _ = unsafeThrow "Impossible case in 'up'" + up (Cons x ctx) tree = + case x, tree of + TwoLeft k1 v1 Leaf, Leaf -> fromZipper ctx (Two Leaf k1 v1 Leaf) + TwoRight Leaf k1 v1, Leaf -> fromZipper ctx (Two Leaf k1 v1 Leaf) + TwoLeft k1 v1 (Two m k2 v2 r), l -> up ctx (Three l k1 v1 m k2 v2 r) + TwoRight (Two l k1 v1 m) k2 v2, r -> up ctx (Three l k1 v1 m k2 v2 r) + TwoLeft k1 v1 (Three b k2 v2 c k3 v3 d), a -> fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) + TwoRight (Three a k1 v1 b k2 v2 c) k3 v3, d -> fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) + ThreeLeft k1 v1 Leaf k2 v2 Leaf, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + ThreeMiddle Leaf k1 v1 k2 v2 Leaf, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + ThreeRight Leaf k1 v1 Leaf k2 v2, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + ThreeLeft k1 v1 (Two b k2 v2 c) k3 v3 d, a -> fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) + ThreeMiddle (Two a k1 v1 b) k2 v2 k3 v3 d, c -> fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) + ThreeMiddle a k1 v1 k2 v2 (Two c k3 v3 d), b -> fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) + ThreeRight a k1 v1 (Two b k2 v2 c) k3 v3, d -> fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) + ThreeLeft k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 e, a -> fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) + ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e, d -> fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) + ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e), b -> fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) + ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4, e -> fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) + _, _ -> unsafeThrow "Impossible case in 'up'" maxNode :: Map k v -> { key :: k, value :: v } maxNode (Two _ k v Leaf) = { key: k, value: v } From e363edb5169dc8cd5aa57c6a93730fd9938e5d38 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 17 Mar 2016 11:46:00 +0000 Subject: [PATCH 059/125] Revert "Better pattern sharing for perf." This reverts commit ebf42f7b84cc0ccf2abed4e03cdd24ed88d828cc. --- src/Data/Map.purs | 156 ++++++++++++++++++---------------------------- 1 file changed, 62 insertions(+), 94 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 95f6277b..c98be78d 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -116,24 +116,14 @@ checkValid tree = length (nub (allHeights tree)) == one -- | Lookup a value for the specified key lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v lookup _ Leaf = Nothing -lookup k tree = - let comp :: k -> k -> Ordering - comp = compare - in case tree of - Two left k1 v right -> - case comp k k1 of - EQ -> Just v - LT -> lookup k left - _ -> lookup k right - Three left k1 v1 mid k2 v2 right -> - case comp k k1 of - EQ -> Just v1 - c1 -> - case c1, comp k k2 of - _ , EQ -> Just v2 - LT, _ -> lookup k left - _ , GT -> lookup k right - _ , _ -> lookup k mid +lookup k (Two _ k1 v _) | k == k1 = Just v +lookup k (Two left k1 _ _) | k < k1 = lookup k left +lookup k (Two _ _ _ right) = lookup k right +lookup k (Three _ k1 v1 _ _ _ _) | k == k1 = Just v1 +lookup k (Three _ _ _ _ k2 v2 _) | k == k2 = Just v2 +lookup k (Three left k1 _ _ _ _ _) | k < k1 = lookup k left +lookup k (Three _ k1 _ mid k2 _ _) | k1 < k && k <= k2 = lookup k mid +lookup k (Three _ _ _ _ _ _ right) = lookup k right -- | Test if a key is a member of a map member :: forall k v. (Ord k) => k -> Map k v -> Boolean @@ -148,13 +138,11 @@ data TreeContext k v fromZipper :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v fromZipper Nil tree = tree -fromZipper (Cons x ctx) tree = - case x of - TwoLeft k1 v1 right -> fromZipper ctx (Two tree k1 v1 right) - TwoRight left k1 v1 -> fromZipper ctx (Two left k1 v1 tree) - ThreeLeft k1 v1 mid k2 v2 right -> fromZipper ctx (Three tree k1 v1 mid k2 v2 right) - ThreeMiddle left k1 v1 k2 v2 right -> fromZipper ctx (Three left k1 v1 tree k2 v2 right) - ThreeRight left k1 v1 mid k2 v2 -> fromZipper ctx (Three left k1 v1 mid k2 v2 tree) +fromZipper (Cons (TwoLeft k1 v1 right) ctx) left = fromZipper ctx (Two left k1 v1 right) +fromZipper (Cons (TwoRight left k1 v1) ctx) right = fromZipper ctx (Two left k1 v1 right) +fromZipper (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) left = fromZipper ctx (Three left k1 v1 mid k2 v2 right) +fromZipper (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) mid = fromZipper ctx (Three left k1 v1 mid k2 v2 right) +fromZipper (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right = fromZipper ctx (Three left k1 v1 mid k2 v2 right) data KickUp k v = KickUp (Map k v) k v (Map k v) @@ -162,90 +150,70 @@ data KickUp k v = KickUp (Map k v) k v (Map k v) insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v insert = down Nil where - comp :: k -> k -> Ordering - comp = compare - down :: List (TreeContext k v) -> k -> v -> Map k v -> Map k v down ctx k v Leaf = up ctx (KickUp Leaf k v Leaf) - down ctx k v (Two left k1 v1 right) = - case comp k k1 of - EQ -> fromZipper ctx (Two left k v right) - LT -> down (Cons (TwoLeft k1 v1 right) ctx) k v left - _ -> down (Cons (TwoRight left k1 v1) ctx) k v right - down ctx k v (Three left k1 v1 mid k2 v2 right) = - case comp k k1 of - EQ -> fromZipper ctx (Three left k v mid k2 v2 right) - c1 -> - case c1, comp k k2 of - _ , EQ -> fromZipper ctx (Three left k1 v1 mid k v right) - LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left - GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid - _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right + down ctx k v (Two left k1 _ right) | k == k1 = fromZipper ctx (Two left k v right) + down ctx k v (Two left k1 v1 right) | k < k1 = down (Cons (TwoLeft k1 v1 right) ctx) k v left + down ctx k v (Two left k1 v1 right) = down (Cons (TwoRight left k1 v1) ctx) k v right + down ctx k v (Three left k1 _ mid k2 v2 right) | k == k1 = fromZipper ctx (Three left k v mid k2 v2 right) + down ctx k v (Three left k1 v1 mid k2 _ right) | k == k2 = fromZipper ctx (Three left k1 v1 mid k v right) + down ctx k v (Three left k1 v1 mid k2 v2 right) | k < k1 = down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left + down ctx k v (Three left k1 v1 mid k2 v2 right) | k1 < k && k <= k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid + down ctx k v (Three left k1 v1 mid k2 v2 right) = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right up :: List (TreeContext k v) -> KickUp k v -> Map k v up Nil (KickUp left k v right) = Two left k v right - up (Cons x ctx) kup = - case x, kup of - TwoLeft k1 v1 right, KickUp left k v mid -> fromZipper ctx (Three left k v mid k1 v1 right) - TwoRight left k1 v1, KickUp mid k v right -> fromZipper ctx (Three left k1 v1 mid k v right) - ThreeLeft k1 v1 c k2 v2 d, KickUp a k v b -> up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) - ThreeMiddle a k1 v1 k2 v2 d, KickUp b k v c -> up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) - ThreeRight a k1 v1 b k2 v2, KickUp c k v d -> up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) + up (Cons (TwoLeft k1 v1 right) ctx) (KickUp left k v mid) = fromZipper ctx (Three left k v mid k1 v1 right) + up (Cons (TwoRight left k1 v1) ctx) (KickUp mid k v right) = fromZipper ctx (Three left k1 v1 mid k v right) + up (Cons (ThreeLeft k1 v1 c k2 v2 d) ctx) (KickUp a k v b) = up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) + up (Cons (ThreeMiddle a k1 v1 k2 v2 d) ctx) (KickUp b k v c) = up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) + up (Cons (ThreeRight a k1 v1 b k2 v2) ctx) (KickUp c k v d) = up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) -- | Delete a key and its corresponding value from a map delete :: forall k v. (Ord k) => k -> Map k v -> Map k v delete = down Nil where - comp :: k -> k -> Ordering - comp = compare - down :: List (TreeContext k v) -> k -> Map k v -> Map k v down ctx _ Leaf = fromZipper ctx Leaf - down ctx k (Two left k1 v1 right) = - case right, comp k k1 of - Leaf, EQ -> up ctx Leaf - _ , EQ -> let max = maxNode left - in removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left - _ , LT -> down (Cons (TwoLeft k1 v1 right) ctx) k left - _ , _ -> down (Cons (TwoRight left k1 v1) ctx) k right - down ctx k (Three left k1 v1 mid k2 v2 right) = - let leaves = - case left, mid, right of - Leaf, Leaf, Leaf -> true - _ , _ , _ -> false - in case leaves, comp k k1, comp k k2 of - true, EQ, _ -> fromZipper ctx (Two Leaf k2 v2 Leaf) - true, _ , EQ -> fromZipper ctx (Two Leaf k1 v1 Leaf) - _ , EQ, _ -> let max = maxNode left - in removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left - _ , _ , EQ -> let max = maxNode mid - in removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid - _ , LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k left - _ , GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid - _ , _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right + down ctx k (Two Leaf k1 _ Leaf) + | k == k1 = up ctx Leaf + down ctx k (Two left k1 v1 right) + | k == k1 = let max = maxNode left + in removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left + | k < k1 = down (Cons (TwoLeft k1 v1 right) ctx) k left + | otherwise = down (Cons (TwoRight left k1 v1) ctx) k right + down ctx k (Three Leaf k1 v1 Leaf k2 v2 Leaf) + | k == k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) + | k == k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) + down ctx k (Three left k1 v1 mid k2 v2 right) + | k == k1 = let max = maxNode left + in removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left + | k == k2 = let max = maxNode mid + in removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid + | k < k1 = down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k left + | k1 < k && k < k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid + | otherwise = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right up :: List (TreeContext k v) -> Map k v -> Map k v up Nil tree = tree - up (Cons x ctx) tree = - case x, tree of - TwoLeft k1 v1 Leaf, Leaf -> fromZipper ctx (Two Leaf k1 v1 Leaf) - TwoRight Leaf k1 v1, Leaf -> fromZipper ctx (Two Leaf k1 v1 Leaf) - TwoLeft k1 v1 (Two m k2 v2 r), l -> up ctx (Three l k1 v1 m k2 v2 r) - TwoRight (Two l k1 v1 m) k2 v2, r -> up ctx (Three l k1 v1 m k2 v2 r) - TwoLeft k1 v1 (Three b k2 v2 c k3 v3 d), a -> fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - TwoRight (Three a k1 v1 b k2 v2 c) k3 v3, d -> fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - ThreeLeft k1 v1 Leaf k2 v2 Leaf, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - ThreeMiddle Leaf k1 v1 k2 v2 Leaf, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - ThreeRight Leaf k1 v1 Leaf k2 v2, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - ThreeLeft k1 v1 (Two b k2 v2 c) k3 v3 d, a -> fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - ThreeMiddle (Two a k1 v1 b) k2 v2 k3 v3 d, c -> fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - ThreeMiddle a k1 v1 k2 v2 (Two c k3 v3 d), b -> fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - ThreeRight a k1 v1 (Two b k2 v2 c) k3 v3, d -> fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - ThreeLeft k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 e, a -> fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e, d -> fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e), b -> fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4, e -> fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - _, _ -> unsafeThrow "Impossible case in 'up'" + up (Cons (TwoLeft k1 v1 Leaf) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) + up (Cons (TwoRight Leaf k1 v1) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) + up (Cons (TwoLeft k1 v1 (Two m k2 v2 r)) ctx) l = up ctx (Three l k1 v1 m k2 v2 r) + up (Cons (TwoRight (Two l k1 v1 m) k2 v2) ctx) r = up ctx (Three l k1 v1 m k2 v2 r) + up (Cons (TwoLeft k1 v1 (Three b k2 v2 c k3 v3 d)) ctx) a = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) + up (Cons (TwoRight (Three a k1 v1 b k2 v2 c) k3 v3) ctx) d = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) + up (Cons (ThreeLeft k1 v1 Leaf k2 v2 Leaf) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + up (Cons (ThreeMiddle Leaf k1 v1 k2 v2 Leaf) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + up (Cons (ThreeRight Leaf k1 v1 Leaf k2 v2) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + up (Cons (ThreeLeft k1 v1 (Two b k2 v2 c) k3 v3 d) ctx) a = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) + up (Cons (ThreeMiddle (Two a k1 v1 b) k2 v2 k3 v3 d) ctx) c = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) + up (Cons (ThreeMiddle a k1 v1 k2 v2 (Two c k3 v3 d)) ctx) b = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) + up (Cons (ThreeRight a k1 v1 (Two b k2 v2 c) k3 v3) ctx) d = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) + up (Cons (ThreeLeft k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 e) ctx) a = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) + up (Cons (ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e) ctx) d = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) + up (Cons (ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e)) ctx) b = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) + up (Cons (ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4) ctx) e = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) + up _ _ = unsafeThrow "Impossible case in 'up'" maxNode :: Map k v -> { key :: k, value :: v } maxNode (Two _ k v Leaf) = { key: k, value: v } From ce0df7b500001967cc7989ddc3b7f61c7d8b0246 Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Fri, 18 Mar 2016 10:51:28 -0500 Subject: [PATCH 060/125] Performance improvements for 0.7.6 --- src/Data/Map.purs | 86 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 59 insertions(+), 27 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index c98be78d..a092a47b 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -115,15 +115,29 @@ checkValid tree = length (nub (allHeights tree)) == one -- | Lookup a value for the specified key lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v -lookup _ Leaf = Nothing -lookup k (Two _ k1 v _) | k == k1 = Just v -lookup k (Two left k1 _ _) | k < k1 = lookup k left -lookup k (Two _ _ _ right) = lookup k right -lookup k (Three _ k1 v1 _ _ _ _) | k == k1 = Just v1 -lookup k (Three _ _ _ _ k2 v2 _) | k == k2 = Just v2 -lookup k (Three left k1 _ _ _ _ _) | k < k1 = lookup k left -lookup k (Three _ k1 _ mid k2 _ _) | k1 < k && k <= k2 = lookup k mid -lookup k (Three _ _ _ _ _ _ right) = lookup k right +lookup k tree = + let comp :: k -> k -> Ordering + comp = compare + in case tree of + Leaf -> Nothing + Two left k1 v right -> + case comp k k1 of + EQ -> Just v + LT -> lookup k left + _ -> lookup k right + Three left k1 v1 mid k2 v2 right -> + case comp k k1 of + EQ -> Just v1 + c1 -> + case comp k k2 of + EQ -> Just v2 + c2 -> + case c1 of + LT -> lookup k left + _ -> + case c2 of + GT -> lookup k right + _ -> lookup k mid -- | Test if a key is a member of a map member :: forall k v. (Ord k) => k -> Map k v -> Boolean @@ -138,11 +152,13 @@ data TreeContext k v fromZipper :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v fromZipper Nil tree = tree -fromZipper (Cons (TwoLeft k1 v1 right) ctx) left = fromZipper ctx (Two left k1 v1 right) -fromZipper (Cons (TwoRight left k1 v1) ctx) right = fromZipper ctx (Two left k1 v1 right) -fromZipper (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) left = fromZipper ctx (Three left k1 v1 mid k2 v2 right) -fromZipper (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) mid = fromZipper ctx (Three left k1 v1 mid k2 v2 right) -fromZipper (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right = fromZipper ctx (Three left k1 v1 mid k2 v2 right) +fromZipper (Cons x ctx) tree = + case x of + TwoLeft k1 v1 right -> fromZipper ctx (Two tree k1 v1 right) + TwoRight left k1 v1 -> fromZipper ctx (Two left k1 v1 tree) + ThreeLeft k1 v1 mid k2 v2 right -> fromZipper ctx (Three tree k1 v1 mid k2 v2 right) + ThreeMiddle left k1 v1 k2 v2 right -> fromZipper ctx (Three left k1 v1 tree k2 v2 right) + ThreeRight left k1 v1 mid k2 v2 -> fromZipper ctx (Three left k1 v1 mid k2 v2 tree) data KickUp k v = KickUp (Map k v) k v (Map k v) @@ -150,24 +166,40 @@ data KickUp k v = KickUp (Map k v) k v (Map k v) insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v insert = down Nil where + comp :: k -> k -> Ordering + comp = compare + down :: List (TreeContext k v) -> k -> v -> Map k v -> Map k v down ctx k v Leaf = up ctx (KickUp Leaf k v Leaf) - down ctx k v (Two left k1 _ right) | k == k1 = fromZipper ctx (Two left k v right) - down ctx k v (Two left k1 v1 right) | k < k1 = down (Cons (TwoLeft k1 v1 right) ctx) k v left - down ctx k v (Two left k1 v1 right) = down (Cons (TwoRight left k1 v1) ctx) k v right - down ctx k v (Three left k1 _ mid k2 v2 right) | k == k1 = fromZipper ctx (Three left k v mid k2 v2 right) - down ctx k v (Three left k1 v1 mid k2 _ right) | k == k2 = fromZipper ctx (Three left k1 v1 mid k v right) - down ctx k v (Three left k1 v1 mid k2 v2 right) | k < k1 = down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left - down ctx k v (Three left k1 v1 mid k2 v2 right) | k1 < k && k <= k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid - down ctx k v (Three left k1 v1 mid k2 v2 right) = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right + down ctx k v (Two left k1 v1 right) = + case comp k k1 of + EQ -> fromZipper ctx (Two left k v right) + LT -> down (Cons (TwoLeft k1 v1 right) ctx) k v left + _ -> down (Cons (TwoRight left k1 v1) ctx) k v right + down ctx k v (Three left k1 v1 mid k2 v2 right) = + case comp k k1 of + EQ -> fromZipper ctx (Three left k v mid k2 v2 right) + c1 -> + case comp k k2 of + EQ -> fromZipper ctx (Three left k1 v1 mid k v right) + c2 -> + case c1 of + LT -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left + GT -> + case c2 of + LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid + _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right + _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right up :: List (TreeContext k v) -> KickUp k v -> Map k v up Nil (KickUp left k v right) = Two left k v right - up (Cons (TwoLeft k1 v1 right) ctx) (KickUp left k v mid) = fromZipper ctx (Three left k v mid k1 v1 right) - up (Cons (TwoRight left k1 v1) ctx) (KickUp mid k v right) = fromZipper ctx (Three left k1 v1 mid k v right) - up (Cons (ThreeLeft k1 v1 c k2 v2 d) ctx) (KickUp a k v b) = up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) - up (Cons (ThreeMiddle a k1 v1 k2 v2 d) ctx) (KickUp b k v c) = up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) - up (Cons (ThreeRight a k1 v1 b k2 v2) ctx) (KickUp c k v d) = up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) + up (Cons x ctx) (KickUp m1 k v m2) = + case x of + TwoLeft k1 v1 right -> fromZipper ctx (Three m1 k v m2 k1 v1 right) + TwoRight left k1 v1 -> fromZipper ctx (Three left k1 v1 m1 k v m2) + ThreeLeft k1 v1 c k2 v2 d -> up ctx (KickUp (Two m1 k v m2) k1 v1 (Two c k2 v2 d)) + ThreeMiddle a k1 v1 k2 v2 d -> up ctx (KickUp (Two a k1 v1 m1) k v (Two m2 k2 v2 d)) + ThreeRight a k1 v1 b k2 v2 -> up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two m1 k v m2)) -- | Delete a key and its corresponding value from a map delete :: forall k v. (Ord k) => k -> Map k v -> Map k v From d7494e4a49b4a49c28812aa1936dd3f747c3bc20 Mon Sep 17 00:00:00 2001 From: telser Date: Sat, 13 Feb 2016 16:53:15 -0500 Subject: [PATCH 061/125] Fix warnings generated by purescript-0.8.0 --- src/Data/Map.purs | 8 ++++---- src/Data/StrMap.purs | 14 +++++++------- src/Data/StrMap/ST.purs | 2 -- src/Data/StrMap/ST/Unsafe.purs | 2 -- src/Data/StrMap/Unsafe.purs | 2 -- 5 files changed, 11 insertions(+), 17 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index a092a47b..e3db6e40 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -27,14 +27,14 @@ module Data.Map , size ) where -import Prelude +import Prelude (class Ord, class Show, class Functor, class Semigroup, class Eq, (<<<), const, pure, (++), ($), otherwise, (<), (&&), (==), (<=), one, (+), map, zero, show, id, (<$>), (<*>), compare) -import Data.Foldable (foldl, foldMap, foldr, Foldable) +import Data.Foldable (foldl, foldMap, foldr, class Foldable) import Data.List (List(..), length, nub) import Data.Maybe (Maybe(..), maybe, isJust) import Data.Maybe.Unsafe (unsafeThrow) -import Data.Monoid (Monoid) -import Data.Traversable (traverse, Traversable) +import Data.Monoid (class Monoid) +import Data.Traversable (traverse, class Traversable) import Data.Tuple (Tuple(..), uncurry) -- | `Map k v` represents maps from keys of type `k` to values of type `v`. diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index fcffdf44..24404ae0 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -36,19 +36,19 @@ module Data.StrMap , runST ) where -import Prelude +import Prelude (class Semigroup, class Eq, class Show, class Monad, class Functor, (<>), (<<<), return, (>>=), bind, const, (==), show, (++), (&&), id, (<$>), map, pure, (<*>), (#)) import Control.Monad.Eff (Eff(), runPure) -import Data.Foldable (Foldable, foldl, foldr, for_) +import Data.Foldable (class Foldable, foldl, foldr, for_) import Data.Function (Fn2(), runFn2, Fn4(), runFn4) import Data.Maybe (Maybe(..), maybe, fromMaybe) -import Data.Monoid (Monoid, mempty) -import Data.Traversable (Traversable, traverse) +import Data.Monoid (class Monoid, mempty) +import Data.Traversable (class Traversable, traverse) import Data.Tuple (Tuple(..), uncurry) -import qualified Data.List as L -import qualified Control.Monad.ST as ST -import qualified Data.StrMap.ST as SM +import Data.List as L +import Control.Monad.ST as ST +import Data.StrMap.ST as SM -- | `StrMap a` represents a map from `String`s to values of type `a`. foreign import data StrMap :: * -> * diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs index a13ed955..8da7fa0b 100644 --- a/src/Data/StrMap/ST.purs +++ b/src/Data/StrMap/ST.purs @@ -10,8 +10,6 @@ module Data.StrMap.ST , delete ) where -import Prelude - import Control.Monad.Eff (Eff()) import Control.Monad.ST (ST()) import Data.Maybe (Maybe(..)) diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs index 1ad27016..aca05192 100644 --- a/src/Data/StrMap/ST/Unsafe.purs +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -2,8 +2,6 @@ module Data.StrMap.ST.Unsafe ( unsafeGet ) where -import Prelude - import Control.Monad.Eff (Eff()) import Control.Monad.ST (ST()) import Data.StrMap (StrMap()) diff --git a/src/Data/StrMap/Unsafe.purs b/src/Data/StrMap/Unsafe.purs index 137e7226..9aaf8f7f 100644 --- a/src/Data/StrMap/Unsafe.purs +++ b/src/Data/StrMap/Unsafe.purs @@ -2,8 +2,6 @@ module Data.StrMap.Unsafe ( unsafeIndex ) where -import Prelude - import Data.StrMap (StrMap()) -- | Unsafely get the value for a key in a map. From 41632f2d46a80238510de3e67490aa7f56ab4523 Mon Sep 17 00:00:00 2001 From: telser Date: Mon, 21 Mar 2016 08:10:03 -0400 Subject: [PATCH 062/125] Need to import Ordering after master rebase. Prelude won't export ++ anymore as of 1.0.0-rc.1 --- src/Data/Map.purs | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index e3db6e40..8909669e 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -27,7 +27,7 @@ module Data.Map , size ) where -import Prelude (class Ord, class Show, class Functor, class Semigroup, class Eq, (<<<), const, pure, (++), ($), otherwise, (<), (&&), (==), (<=), one, (+), map, zero, show, id, (<$>), (<*>), compare) +import Prelude (class Ord, class Show, class Functor, class Semigroup, class Eq, (<<<), const, pure, ($), otherwise, (<), (&&), (==), one, (+), map, zero, show, id, (<$>), (<*>), compare, Ordering(..), append) import Data.Foldable (foldl, foldMap, foldr, class Foldable) import Data.List (List(..), length, nub) @@ -47,7 +47,7 @@ instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where eq m1 m2 = toList m1 == toList m2 instance showMap :: (Show k, Show v) => Show (Map k v) where - show m = "fromList " ++ show (toList m) + show m = "fromList " `append` show (toList m) instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where compare m1 m2 = compare (toList m1) (toList m2) @@ -76,18 +76,18 @@ instance traversableMap :: (Ord k) => Traversable (Map k) where showTree :: forall k v. (Show k, Show v) => Map k v -> String showTree Leaf = "Leaf" showTree (Two left k v right) = - "Two (" ++ showTree left ++ - ") (" ++ show k ++ - ") (" ++ show v ++ - ") (" ++ showTree right ++ ")" + "Two (" `append` showTree left `append` + ") (" `append` show k `append` + ") (" `append` show v `append` + ") (" `append` showTree right `append` ")" showTree (Three left k1 v1 mid k2 v2 right) = - "Three (" ++ showTree left ++ - ") (" ++ show k1 ++ - ") (" ++ show v1 ++ - ") (" ++ showTree mid ++ - ") (" ++ show k2 ++ - ") (" ++ show v2 ++ - ") (" ++ showTree right ++ ")" + "Three (" `append` showTree left `append` + ") (" `append` show k1 `append` + ") (" `append` show v1 `append` + ") (" `append` showTree mid `append` + ") (" `append` show k2 `append` + ") (" `append` show v2 `append` + ") (" `append` showTree right `append` ")" -- | An empty map empty :: forall k v. Map k v @@ -110,8 +110,8 @@ checkValid tree = length (nub (allHeights tree)) == one where allHeights :: Map k v -> List Int allHeights Leaf = pure zero - allHeights (Two left _ _ right) = map (\n -> n + one) (allHeights left ++ allHeights right) - allHeights (Three left _ _ mid _ _ right) = map (\n -> n + one) (allHeights left ++ allHeights mid ++ allHeights right) + allHeights (Two left _ _ right) = map (\n -> n + one) (allHeights left `append` allHeights right) + allHeights (Three left _ _ mid _ _ right) = map (\n -> n + one) (allHeights left `append` allHeights mid `append` allHeights right) -- | Lookup a value for the specified key lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v @@ -288,8 +288,8 @@ fromFoldableWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where -- | Convert a map to a list of key/value pairs toList :: forall k v. Map k v -> List (Tuple k v) toList Leaf = Nil -toList (Two left k v right) = toList left ++ pure (Tuple k v) ++ toList right -toList (Three left k1 v1 mid k2 v2 right) = toList left ++ pure (Tuple k1 v1) ++ toList mid ++ pure (Tuple k2 v2) ++ toList right +toList (Two left k v right) = toList left `append` pure (Tuple k v) `append` toList right +toList (Three left k1 v1 mid k2 v2 right) = toList left `append` pure (Tuple k1 v1) `append` toList mid `append` pure (Tuple k2 v2) `append` toList right -- | Create a map from a list of key/value pairs fromList :: forall k v. (Ord k) => List (Tuple k v) -> Map k v @@ -303,14 +303,14 @@ fromListWith = fromFoldableWith -- | Get a list of the keys contained in a map keys :: forall k v. Map k v -> List k keys Leaf = Nil -keys (Two left k _ right) = keys left ++ pure k ++ keys right -keys (Three left k1 _ mid k2 _ right) = keys left ++ pure k1 ++ keys mid ++ pure k2 ++ keys right +keys (Two left k _ right) = keys left `append` pure k `append` keys right +keys (Three left k1 _ mid k2 _ right) = keys left `append` pure k1 `append` keys mid `append` pure k2 `append` keys right -- | Get a list of the values contained in a map values :: forall k v. Map k v -> List v values Leaf = Nil -values (Two left _ v right) = values left ++ pure v ++ values right -values (Three left _ v1 mid _ v2 right) = values left ++ pure v1 ++ values mid ++ pure v2 ++ values right +values (Two left _ v right) = values left `append` pure v `append` values right +values (Three left _ v1 mid _ v2 right) = values left `append` pure v1 `append` values mid `append` pure v2 `append` values right -- | Compute the union of two maps, using the specified function -- | to combine values for duplicate keys. From 175426acee8682ac9791bc10b1523e544241ac48 Mon Sep 17 00:00:00 2001 From: telser Date: Mon, 21 Mar 2016 11:56:05 -0400 Subject: [PATCH 063/125] Fix warnings generated by tests and tell travis-ci to use node 5 --- .travis.yml | 3 +-- test/Test/Data/Map.purs | 21 ++++++++++++++++----- test/Test/Data/StrMap.purs | 20 +++++++++++++++----- test/Test/Main.purs | 13 ++++++++++++- 4 files changed, 44 insertions(+), 13 deletions(-) diff --git a/.travis.yml b/.travis.yml index 791313a3..6e585f55 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,7 +1,6 @@ language: node_js sudo: false -node_js: - - 0.10 +node_js: 5 env: - PATH=$HOME/purescript:$PATH install: diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 99e40342..afa33ea4 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -3,17 +3,20 @@ module Test.Data.Map where import Prelude import Control.Alt ((<|>)) -import Control.Monad.Eff.Console (log) +import Control.Monad.Eff (Eff()) +import Control.Monad.Eff.Console (log, CONSOLE()) +import Control.Monad.Eff.Exception (EXCEPTION()) +import Control.Monad.Eff.Random (RANDOM()) import Data.Foldable (foldl, for_) import Data.Function (on) -import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton, toList) +import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton) import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe.Unsafe (unsafeThrow) import Data.Tuple (Tuple(..), fst) import Test.QuickCheck ((), quickCheck, quickCheck') -import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) -import qualified Data.Map as M +import Data.Map as M newtype TestMap k v = TestMap (M.Map k v) @@ -107,6 +110,14 @@ smallKey k = k number :: Int -> Int number n = n +mapTests :: forall t. + Eff + ( console :: CONSOLE + , random :: RANDOM + , err :: EXCEPTION + | t + ) + Unit mapTests = do -- Data.Map @@ -181,7 +192,7 @@ mapTests = do in f (f arr) == f (arr :: List (Tuple SmallKey Int)) show arr log "fromList . toList = id" - quickCheck $ \(TestMap m) -> let f m = M.fromList (M.toList m) in + quickCheck $ \(TestMap m) -> let f m' = M.fromList (M.toList m') in M.toList (f m) == M.toList (m :: M.Map SmallKey Int) show m log "fromListWith const = fromList" diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 021b578b..ead4c741 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -8,11 +8,13 @@ import Data.Function (on) import Data.Maybe (Maybe(..)) import Data.Maybe.Unsafe (unsafeThrow) import Data.Tuple (Tuple(..), fst) -import Control.Monad.Eff.Console (log) +import Control.Monad.Eff(Eff()) +import Control.Monad.Eff.Console (log, CONSOLE()) +import Control.Monad.Eff.Exception (EXCEPTION()) +import Control.Monad.Eff.Random (RANDOM()) import Test.QuickCheck ((), quickCheck, quickCheck') -import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) -import qualified Data.String as S -import qualified Data.StrMap as M +import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) +import Data.StrMap as M newtype TestStrMap v = TestStrMap (M.StrMap v) @@ -45,6 +47,14 @@ runInstructions instrs t0 = foldl step t0 instrs number :: Int -> Int number n = n +strMapTests :: forall t. + Eff + ( console :: CONSOLE + , random :: RANDOM + , err :: EXCEPTION + | t + ) + Unit strMapTests = do log "Test inserting into empty tree" quickCheck $ \k v -> M.lookup k (M.insert k v M.empty) == Just (number v) @@ -110,7 +120,7 @@ strMapTests = do log "fromList . toList = id" quickCheck $ \(TestStrMap m) -> - let f m = M.fromList (M.toList m) in + let f m1 = M.fromList (M.toList m1) in M.toList (f m) == M.toList (m :: M.StrMap Int) show m log "fromListWith const = fromList" diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 814d8713..e6dbf048 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -2,11 +2,22 @@ module Test.Main where import Prelude -import Control.Monad.Eff.Console (log) +import Control.Monad.Eff (Eff()) +import Control.Monad.Eff.Console (log, CONSOLE()) +import Control.Monad.Eff.Exception (EXCEPTION()) +import Control.Monad.Eff.Random (RANDOM()) import Test.Data.Map (mapTests) import Test.Data.StrMap (strMapTests) +main :: forall t. + Eff + ( console :: CONSOLE + , random :: RANDOM + , err :: EXCEPTION + | t + ) + Unit main = do log "Running Map tests" mapTests From 33f5f26bc603e4a8042f79ea65e5f4acb321feb1 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 28 Mar 2016 01:08:17 +0100 Subject: [PATCH 064/125] Updates for PureScript 0.8 --- .jscsrc | 5 + .jshintrc | 3 +- .travis.yml | 15 +- README.md | 8 +- bower.json | 11 +- docs/Data/Map.md | 209 ------------------------- docs/Data/StrMap.md | 269 --------------------------------- docs/Data/StrMap/ST.md | 51 ------- docs/Data/StrMap/ST/Unsafe.md | 13 -- docs/Data/StrMap/Unsafe.md | 13 -- package.json | 13 +- src/Data/Map.purs | 250 +++++++++++++++--------------- src/Data/StrMap.js | 4 +- src/Data/StrMap.purs | 30 ++-- src/Data/StrMap/ST.purs | 6 +- src/Data/StrMap/ST/Unsafe.purs | 8 +- src/Data/StrMap/Unsafe.purs | 2 +- test/Test/Data/Map.purs | 56 +++---- test/Test/Data/StrMap.purs | 63 ++++---- test/Test/Main.purs | 17 +-- 20 files changed, 245 insertions(+), 801 deletions(-) delete mode 100644 docs/Data/Map.md delete mode 100644 docs/Data/StrMap.md delete mode 100644 docs/Data/StrMap/ST.md delete mode 100644 docs/Data/StrMap/ST/Unsafe.md delete mode 100644 docs/Data/StrMap/Unsafe.md diff --git a/.jscsrc b/.jscsrc index 342da669..2561ce9e 100644 --- a/.jscsrc +++ b/.jscsrc @@ -1,5 +1,10 @@ { "preset": "grunt", + "disallowSpacesInFunctionExpression": null, + "requireSpacesInFunctionExpression": { + "beforeOpeningRoundBrace": true, + "beforeOpeningCurlyBrace": true + }, "disallowSpacesInAnonymousFunctionExpression": null, "requireSpacesInAnonymousFunctionExpression": { "beforeOpeningRoundBrace": true, diff --git a/.jshintrc b/.jshintrc index 2240be2a..620d8d7f 100644 --- a/.jshintrc +++ b/.jshintrc @@ -15,5 +15,6 @@ "singleGroups": true, "undef": true, "unused": true, - "eqnull": true + "eqnull": true, + "predef": ["exports"] } diff --git a/.travis.yml b/.travis.yml index 6e585f55..bab24346 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,5 +1,6 @@ language: node_js -sudo: false +sudo: required +dist: trusty node_js: 5 env: - PATH=$HOME/purescript:$PATH @@ -8,6 +9,16 @@ install: - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz - tar -xvf $HOME/purescript.tar.gz -C $HOME/ - chmod a+x $HOME/purescript + - npm install -g bower - npm install + - bower install script: - - npm run build + - npm test +after_success: +- >- + test $TRAVIS_TAG && + psc-publish > .pursuit.json && + curl -X POST http://pursuit.purescript.org/packages \ + -d @.pursuit.json \ + -H 'Accept: application/json' \ + -H "Authorization: token ${GITHUB_TOKEN}" diff --git a/README.md b/README.md index 8fdd5cdc..169209dd 100644 --- a/README.md +++ b/README.md @@ -12,10 +12,6 @@ Purely-functional map data structures. bower install purescript-maps ``` -## Module documentation +## Documentation -- [Data.Map](docs/Data/Map.md) -- [Data.StrMap](docs/Data/StrMap.md) -- [Data.StrMap.ST](docs/Data/StrMap/ST.md) -- [Data.StrMap.ST.Unsafe](docs/Data/StrMap/ST/Unsafe.md) -- [Data.StrMap.Unsafe](docs/Data/StrMap/Unsafe.md) +Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-maps). diff --git a/bower.json b/bower.json index c030c253..53596b04 100644 --- a/bower.json +++ b/bower.json @@ -6,9 +6,6 @@ "John A. De Goes " ], "description": "Purely functional maps implemented in PureScript", - "keywords": [ - "purescript" - ], "repository": { "type": "git", "url": "git://github.com/purescript/purescript-maps.git" @@ -24,11 +21,11 @@ "package.json" ], "dependencies": { - "purescript-lists": "^0.7.0", - "purescript-st": "^0.1.0", - "purescript-functions": "^0.1.0" + "purescript-functions": "^1.0.0-rc.1", + "purescript-lists": "^1.0.0-rc.1", + "purescript-st": "^1.0.0-rc.1" }, "devDependencies": { - "purescript-quickcheck": "^0.12.0" + "purescript-quickcheck": "^1.0.0-rc.1" } } diff --git a/docs/Data/Map.md b/docs/Data/Map.md deleted file mode 100644 index 1c32d000..00000000 --- a/docs/Data/Map.md +++ /dev/null @@ -1,209 +0,0 @@ -## Module Data.Map - -This module defines a type of maps as balanced 2-3 trees, based on - - -#### `Map` - -``` purescript -data Map k v -``` - -`Map k v` represents maps from keys of type `k` to values of type `v`. - -##### Instances -``` purescript -(Eq k, Eq v) => Eq (Map k v) -(Show k, Show v) => Show (Map k v) -(Ord k, Ord v) => Ord (Map k v) -(Ord k) => Semigroup (Map k v) -(Ord k) => Monoid (Map k v) -Functor (Map k) -Foldable (Map k) -(Ord k) => Traversable (Map k) -``` - -#### `showTree` - -``` purescript -showTree :: forall k v. (Show k, Show v) => Map k v -> String -``` - -Render a `Map` as a `String` - -#### `empty` - -``` purescript -empty :: forall k v. Map k v -``` - -An empty map - -#### `isEmpty` - -``` purescript -isEmpty :: forall k v. Map k v -> Boolean -``` - -Test if a map is empty - -#### `singleton` - -``` purescript -singleton :: forall k v. k -> v -> Map k v -``` - -Create a map with one key/value pair - -#### `checkValid` - -``` purescript -checkValid :: forall k v. Map k v -> Boolean -``` - -Check whether the underlying tree satisfies the 2-3 invariant - -This function is provided for internal use. - -#### `lookup` - -``` purescript -lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v -``` - -Lookup a value for the specified key - -#### `member` - -``` purescript -member :: forall k v. (Ord k) => k -> Map k v -> Boolean -``` - -Test if a key is a member of a map - -#### `insert` - -``` purescript -insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v -``` - -Insert a key/value pair into a map - -#### `delete` - -``` purescript -delete :: forall k v. (Ord k) => k -> Map k v -> Map k v -``` - -Delete a key and its corresponding value from a map - -#### `alter` - -``` purescript -alter :: forall k v. (Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v -``` - -Insert the value, delete a value, or update a value for a key in a map - -#### `update` - -``` purescript -update :: forall k v. (Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v -``` - -Update or delete the value for a key in a map - -#### `fromFoldable` - -``` purescript -fromFoldable :: forall f k v. (Ord k, Foldable f) => f (Tuple k v) -> Map k v -``` - -Convert any foldable collection of key/value pairs to a map. -On key collision, later values take precedence over earlier ones. - -#### `fromFoldableWith` - -``` purescript -fromFoldableWith :: forall f k v. (Ord k, Foldable f) => (v -> v -> v) -> f (Tuple k v) -> Map k v -``` - -Convert any foldable collection of key/value pairs to a map. -On key collision, the values are configurably combined. - -#### `toList` - -``` purescript -toList :: forall k v. Map k v -> List (Tuple k v) -``` - -Convert a map to a list of key/value pairs - -#### `fromList` - -``` purescript -fromList :: forall k v. (Ord k) => List (Tuple k v) -> Map k v -``` - -Create a map from a list of key/value pairs - -#### `fromListWith` - -``` purescript -fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> List (Tuple k v) -> Map k v -``` - -Create a map from a list of key/value pairs, using the specified function -to combine values for duplicate keys. - -#### `keys` - -``` purescript -keys :: forall k v. Map k v -> List k -``` - -Get a list of the keys contained in a map - -#### `values` - -``` purescript -values :: forall k v. Map k v -> List v -``` - -Get a list of the values contained in a map - -#### `unionWith` - -``` purescript -unionWith :: forall k v. (Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v -``` - -Compute the union of two maps, using the specified function -to combine values for duplicate keys. - -#### `union` - -``` purescript -union :: forall k v. (Ord k) => Map k v -> Map k v -> Map k v -``` - -Compute the union of two maps, preferring values from the first map in the case -of duplicate keys - -#### `unions` - -``` purescript -unions :: forall k v f. (Ord k, Foldable f) => f (Map k v) -> Map k v -``` - -Compute the union of a collection of maps - -#### `size` - -``` purescript -size :: forall k v. Map k v -> Int -``` - -Calculate the number of key/value pairs in a map - - diff --git a/docs/Data/StrMap.md b/docs/Data/StrMap.md deleted file mode 100644 index f03f3358..00000000 --- a/docs/Data/StrMap.md +++ /dev/null @@ -1,269 +0,0 @@ -## Module Data.StrMap - -This module defines a type of native Javascript maps which -require the keys to be strings. - -To maximize performance, Javascript objects are not wrapped, -and some native code is used even when it's not necessary. - -#### `StrMap` - -``` purescript -data StrMap :: * -> * -``` - -`StrMap a` represents a map from `String`s to values of type `a`. - -##### Instances -``` purescript -Functor StrMap -Foldable StrMap -Traversable StrMap -(Eq a) => Eq (StrMap a) -(Show a) => Show (StrMap a) -(Semigroup a) => Semigroup (StrMap a) -(Semigroup a) => Monoid (StrMap a) -``` - -#### `thawST` - -``` purescript -thawST :: forall a h r. StrMap a -> Eff (st :: ST h | r) (STStrMap h a) -``` - -Convert an immutable map into a mutable map - -#### `freezeST` - -``` purescript -freezeST :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) -``` - -Convert a mutable map into an immutable map - -#### `runST` - -``` purescript -runST :: forall a r. (forall h. Eff (st :: ST h | r) (STStrMap h a)) -> Eff r (StrMap a) -``` - -Freeze a mutable map, creating an immutable map. Use this function as you would use -`Prelude.runST` to freeze a mutable reference. - -The rank-2 type prevents the map from escaping the scope of `runST`. - -#### `pureST` - -``` purescript -pureST :: forall a. (forall h e. Eff (st :: ST h | e) (STStrMap h a)) -> StrMap a -``` - -#### `fold` - -``` purescript -fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z -``` - -Fold the keys and values of a map - -#### `foldMap` - -``` purescript -foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m -``` - -Fold the keys and values of a map, accumulating values using -some `Monoid`. - -#### `foldM` - -``` purescript -foldM :: forall a m z. (Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z -``` - -Fold the keys and values of a map, accumulating values and effects in -some `Monad`. - -#### `foldMaybe` - -``` purescript -foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z -``` - -Fold the keys and values of a map. - -This function allows the folding function to terminate the fold early, -using `Maybe`. - -#### `all` - -``` purescript -all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean -``` - -Test whether all key/value pairs in a `StrMap` satisfy a predicate. - -#### `empty` - -``` purescript -empty :: forall a. StrMap a -``` - -An empty map - -#### `isSubmap` - -``` purescript -isSubmap :: forall a. (Eq a) => StrMap a -> StrMap a -> Boolean -``` - -Test whether one map contains all of the keys and values contained in another map - -#### `isEmpty` - -``` purescript -isEmpty :: forall a. StrMap a -> Boolean -``` - -Test whether a map is empty - -#### `size` - -``` purescript -size :: forall a. StrMap a -> Number -``` - -Calculate the number of key/value pairs in a map - -#### `singleton` - -``` purescript -singleton :: forall a. String -> a -> StrMap a -``` - -Create a map with one key/value pair - -#### `lookup` - -``` purescript -lookup :: forall a. String -> StrMap a -> Maybe a -``` - -Lookup the value for a key in a map - -#### `member` - -``` purescript -member :: forall a. String -> StrMap a -> Boolean -``` - -Test whether a `String` appears as a key in a map - -#### `insert` - -``` purescript -insert :: forall a. String -> a -> StrMap a -> StrMap a -``` - -Insert a key and value into a map - -#### `delete` - -``` purescript -delete :: forall a. String -> StrMap a -> StrMap a -``` - -Delete a key and value from a map - -#### `alter` - -``` purescript -alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a -``` - -Insert, remove or update a value for a key in a map - -#### `update` - -``` purescript -update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a -``` - -Remove or update a value for a key in a map - -#### `fromFoldable` - -``` purescript -fromFoldable :: forall f a. (Foldable f) => f (Tuple String a) -> StrMap a -``` - -Create a map from a foldable collection of key/value pairs - -#### `fromFoldableWith` - -``` purescript -fromFoldableWith :: forall f a. (Foldable f) => (a -> a -> a) -> f (Tuple String a) -> StrMap a -``` - -Create a map from a foldable collection of key/value pairs, using the -specified function to combine values for duplicate keys. - -#### `fromList` - -``` purescript -fromList :: forall a. List (Tuple String a) -> StrMap a -``` - -Create a map from a list of key/value pairs - -#### `fromListWith` - -``` purescript -fromListWith :: forall a. (a -> a -> a) -> List (Tuple String a) -> StrMap a -``` - -Create a map from a list of key/value pairs, using the specified function -to combine values for duplicate keys. - -#### `toList` - -``` purescript -toList :: forall a. StrMap a -> List (Tuple String a) -``` - -Convert a map into a list of key/value pairs - -#### `keys` - -``` purescript -keys :: forall a. StrMap a -> Array String -``` - -Get an array of the keys in a map - -#### `values` - -``` purescript -values :: forall a. StrMap a -> List a -``` - -Get a list of the values in a map - -#### `union` - -``` purescript -union :: forall a. StrMap a -> StrMap a -> StrMap a -``` - -Compute the union of two maps, preferring the first map in the case of -duplicate keys. - -#### `unions` - -``` purescript -unions :: forall a. List (StrMap a) -> StrMap a -``` - -Compute the union of a collection of maps - - diff --git a/docs/Data/StrMap/ST.md b/docs/Data/StrMap/ST.md deleted file mode 100644 index 135d883b..00000000 --- a/docs/Data/StrMap/ST.md +++ /dev/null @@ -1,51 +0,0 @@ -## Module Data.StrMap.ST - -Helper functions for working with mutable maps using the `ST` effect. - -This module can be used when performance is important and mutation is a local effect. - -#### `STStrMap` - -``` purescript -data STStrMap :: * -> * -> * -``` - -A reference to a mutable map - -The first type parameter represents the memory region which the map belongs to. The second type parameter defines the type of elements of the mutable array. - -The runtime representation of a value of type `STStrMap h a` is the same as that of `StrMap a`, except that mutation is allowed. - -#### `new` - -``` purescript -new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) -``` - -Create a new, empty mutable map - -#### `peek` - -``` purescript -peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (Maybe a) -``` - -Get the value for a key in a mutable map - -#### `poke` - -``` purescript -poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) -``` - -Update the value for a key in a mutable map - -#### `delete` - -``` purescript -delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) -``` - -Remove a key and the corresponding value from a mutable map - - diff --git a/docs/Data/StrMap/ST/Unsafe.md b/docs/Data/StrMap/ST/Unsafe.md deleted file mode 100644 index a94aa46d..00000000 --- a/docs/Data/StrMap/ST/Unsafe.md +++ /dev/null @@ -1,13 +0,0 @@ -## Module Data.StrMap.ST.Unsafe - -#### `unsafeGet` - -``` purescript -unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) -``` - -Unsafely get the map out of ST without copying it - -If you later change the ST version of the map the pure value will also change. - - diff --git a/docs/Data/StrMap/Unsafe.md b/docs/Data/StrMap/Unsafe.md deleted file mode 100644 index fa884986..00000000 --- a/docs/Data/StrMap/Unsafe.md +++ /dev/null @@ -1,13 +0,0 @@ -## Module Data.StrMap.Unsafe - -#### `unsafeIndex` - -``` purescript -unsafeIndex :: forall a. StrMap a -> String -> a -``` - -Unsafely get the value for a key in a map. - -This function does not check whether the key exists in the map. - - diff --git a/package.json b/package.json index fcbd3a85..55fc1c7f 100644 --- a/package.json +++ b/package.json @@ -1,13 +1,14 @@ { "private": true, "scripts": { - "postinstall": "pulp dep install", - "build": "jshint src && jscs src && pulp test && rimraf docs && pulp docs" + "clean": "rimraf output && rimraf .pulp-cache", + "build": "jshint src && jscs src && pulp build", + "test": "jshint src && jscs src && pulp test" }, "devDependencies": { - "jscs": "^1.13.1", - "jshint": "^2.9.1-rc.1", - "pulp": "^4.0.2", - "rimraf": "^2.4.1" + "jscs": "^2.8.0", + "jshint": "^2.9.1", + "pulp": "^8.1.0", + "rimraf": "^2.5.0" } } diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 8909669e..1ddf6420 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -2,7 +2,7 @@ -- | module Data.Map - ( Map() + ( Map , showTree , empty , isEmpty @@ -27,16 +27,17 @@ module Data.Map , size ) where -import Prelude (class Ord, class Show, class Functor, class Semigroup, class Eq, (<<<), const, pure, ($), otherwise, (<), (&&), (==), one, (+), map, zero, show, id, (<$>), (<*>), compare, Ordering(..), append) +import Prelude import Data.Foldable (foldl, foldMap, foldr, class Foldable) import Data.List (List(..), length, nub) import Data.Maybe (Maybe(..), maybe, isJust) -import Data.Maybe.Unsafe (unsafeThrow) import Data.Monoid (class Monoid) import Data.Traversable (traverse, class Traversable) import Data.Tuple (Tuple(..), uncurry) +import Partial.Unsafe (unsafePartial) + -- | `Map k v` represents maps from keys of type `k` to values of type `v`. data Map k v = Leaf @@ -47,7 +48,7 @@ instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where eq m1 m2 = toList m1 == toList m2 instance showMap :: (Show k, Show v) => Show (Map k v) where - show m = "fromList " `append` show (toList m) + show m = "(fromList " <> show (toList m) <> ")" instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where compare m1 m2 = compare (toList m1) (toList m2) @@ -69,25 +70,25 @@ instance foldableMap :: Foldable (Map k) where foldMap f m = foldMap f (values m) instance traversableMap :: (Ord k) => Traversable (Map k) where - traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) (((<$>) (uncurry singleton)) <$> (traverse f <$> toList ms)) + traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toList ms)) sequence = traverse id -- | Render a `Map` as a `String` showTree :: forall k v. (Show k, Show v) => Map k v -> String showTree Leaf = "Leaf" showTree (Two left k v right) = - "Two (" `append` showTree left `append` - ") (" `append` show k `append` - ") (" `append` show v `append` - ") (" `append` showTree right `append` ")" + "Two (" <> showTree left <> + ") (" <> show k <> + ") (" <> show v <> + ") (" <> showTree right <> ")" showTree (Three left k1 v1 mid k2 v2 right) = - "Three (" `append` showTree left `append` - ") (" `append` show k1 `append` - ") (" `append` show v1 `append` - ") (" `append` showTree mid `append` - ") (" `append` show k2 `append` - ") (" `append` show v2 `append` - ") (" `append` showTree right `append` ")" + "Three (" <> showTree left <> + ") (" <> show k1 <> + ") (" <> show v1 <> + ") (" <> showTree mid <> + ") (" <> show k2 <> + ") (" <> show v2 <> + ") (" <> showTree right <> ")" -- | An empty map empty :: forall k v. Map k v @@ -110,37 +111,35 @@ checkValid tree = length (nub (allHeights tree)) == one where allHeights :: Map k v -> List Int allHeights Leaf = pure zero - allHeights (Two left _ _ right) = map (\n -> n + one) (allHeights left `append` allHeights right) - allHeights (Three left _ _ mid _ _ right) = map (\n -> n + one) (allHeights left `append` allHeights mid `append` allHeights right) + allHeights (Two left _ _ right) = map (\n -> n + one) (allHeights left <> allHeights right) + allHeights (Three left _ _ mid _ _ right) = map (\n -> n + one) (allHeights left <> allHeights mid <> allHeights right) -- | Lookup a value for the specified key -lookup :: forall k v. (Ord k) => k -> Map k v -> Maybe v -lookup k tree = - let comp :: k -> k -> Ordering - comp = compare - in case tree of +lookup :: forall k v. Ord k => k -> Map k v -> Maybe v +lookup = unsafePartial \k tree -> + case tree of Leaf -> Nothing - Two left k1 v right -> - case comp k k1 of - EQ -> Just v - LT -> lookup k left - _ -> lookup k right - Three left k1 v1 mid k2 v2 right -> - case comp k k1 of - EQ -> Just v1 - c1 -> - case comp k k2 of - EQ -> Just v2 - c2 -> - case c1 of - LT -> lookup k left - _ -> - case c2 of - GT -> lookup k right - _ -> lookup k mid + _ -> + let comp :: k -> k -> Ordering + comp = compare + in case tree of + Two left k1 v right -> + case comp k k1 of + EQ -> Just v + LT -> lookup k left + _ -> lookup k right + Three left k1 v1 mid k2 v2 right -> + case comp k k1 of + EQ -> Just v1 + c1 -> + case c1, comp k k2 of + _ , EQ -> Just v2 + LT, _ -> lookup k left + _ , GT -> lookup k right + _ , _ -> lookup k mid -- | Test if a key is a member of a map -member :: forall k v. (Ord k) => k -> Map k v -> Boolean +member :: forall k v. Ord k => k -> Map k v -> Boolean member k m = isJust (k `lookup` m) data TreeContext k v @@ -150,7 +149,7 @@ data TreeContext k v | ThreeMiddle (Map k v) k v k v (Map k v) | ThreeRight (Map k v) k v (Map k v) k v -fromZipper :: forall k v. (Ord k) => List (TreeContext k v) -> Map k v -> Map k v +fromZipper :: forall k v. Ord k => List (TreeContext k v) -> Map k v -> Map k v fromZipper Nil tree = tree fromZipper (Cons x ctx) tree = case x of @@ -163,7 +162,7 @@ fromZipper (Cons x ctx) tree = data KickUp k v = KickUp (Map k v) k v (Map k v) -- | Insert a key/value pair into a map -insert :: forall k v. (Ord k) => k -> v -> Map k v -> Map k v +insert :: forall k v. Ord k => k -> v -> Map k v -> Map k v insert = down Nil where comp :: k -> k -> Ordering @@ -180,97 +179,104 @@ insert = down Nil case comp k k1 of EQ -> fromZipper ctx (Three left k v mid k2 v2 right) c1 -> - case comp k k2 of - EQ -> fromZipper ctx (Three left k1 v1 mid k v right) - c2 -> - case c1 of - LT -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left - GT -> - case c2 of - LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid - _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right - _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right + case c1, comp k k2 of + _ , EQ -> fromZipper ctx (Three left k1 v1 mid k v right) + LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left + GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid + _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right up :: List (TreeContext k v) -> KickUp k v -> Map k v up Nil (KickUp left k v right) = Two left k v right - up (Cons x ctx) (KickUp m1 k v m2) = - case x of - TwoLeft k1 v1 right -> fromZipper ctx (Three m1 k v m2 k1 v1 right) - TwoRight left k1 v1 -> fromZipper ctx (Three left k1 v1 m1 k v m2) - ThreeLeft k1 v1 c k2 v2 d -> up ctx (KickUp (Two m1 k v m2) k1 v1 (Two c k2 v2 d)) - ThreeMiddle a k1 v1 k2 v2 d -> up ctx (KickUp (Two a k1 v1 m1) k v (Two m2 k2 v2 d)) - ThreeRight a k1 v1 b k2 v2 -> up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two m1 k v m2)) + up (Cons x ctx) kup = + case x, kup of + TwoLeft k1 v1 right, KickUp left k v mid -> fromZipper ctx (Three left k v mid k1 v1 right) + TwoRight left k1 v1, KickUp mid k v right -> fromZipper ctx (Three left k1 v1 mid k v right) + ThreeLeft k1 v1 c k2 v2 d, KickUp a k v b -> up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) + ThreeMiddle a k1 v1 k2 v2 d, KickUp b k v c -> up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) + ThreeRight a k1 v1 b k2 v2, KickUp c k v d -> up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) -- | Delete a key and its corresponding value from a map -delete :: forall k v. (Ord k) => k -> Map k v -> Map k v +delete :: forall k v. Ord k => k -> Map k v -> Map k v delete = down Nil where + comp :: k -> k -> Ordering + comp = compare + down :: List (TreeContext k v) -> k -> Map k v -> Map k v - down ctx _ Leaf = fromZipper ctx Leaf - down ctx k (Two Leaf k1 _ Leaf) - | k == k1 = up ctx Leaf - down ctx k (Two left k1 v1 right) - | k == k1 = let max = maxNode left - in removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left - | k < k1 = down (Cons (TwoLeft k1 v1 right) ctx) k left - | otherwise = down (Cons (TwoRight left k1 v1) ctx) k right - down ctx k (Three Leaf k1 v1 Leaf k2 v2 Leaf) - | k == k1 = fromZipper ctx (Two Leaf k2 v2 Leaf) - | k == k2 = fromZipper ctx (Two Leaf k1 v1 Leaf) - down ctx k (Three left k1 v1 mid k2 v2 right) - | k == k1 = let max = maxNode left - in removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left - | k == k2 = let max = maxNode mid - in removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid - | k < k1 = down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k left - | k1 < k && k < k2 = down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid - | otherwise = down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right + down = unsafePartial \ctx k m -> case m of + Leaf -> fromZipper ctx Leaf + Two left k1 v1 right -> + case right, comp k k1 of + Leaf, EQ -> up ctx Leaf + _ , EQ -> let max = maxNode left + in removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left + _ , LT -> down (Cons (TwoLeft k1 v1 right) ctx) k left + _ , _ -> down (Cons (TwoRight left k1 v1) ctx) k right + Three left k1 v1 mid k2 v2 right -> + let leaves = + case left, mid, right of + Leaf, Leaf, Leaf -> true + _ , _ , _ -> false + in case leaves, comp k k1, comp k k2 of + true, EQ, _ -> fromZipper ctx (Two Leaf k2 v2 Leaf) + true, _ , EQ -> fromZipper ctx (Two Leaf k1 v1 Leaf) + _ , EQ, _ -> let max = maxNode left + in removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left + _ , _ , EQ -> let max = maxNode mid + in removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid + _ , LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k left + _ , GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid + _ , _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right up :: List (TreeContext k v) -> Map k v -> Map k v - up Nil tree = tree - up (Cons (TwoLeft k1 v1 Leaf) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) - up (Cons (TwoRight Leaf k1 v1) ctx) Leaf = fromZipper ctx (Two Leaf k1 v1 Leaf) - up (Cons (TwoLeft k1 v1 (Two m k2 v2 r)) ctx) l = up ctx (Three l k1 v1 m k2 v2 r) - up (Cons (TwoRight (Two l k1 v1 m) k2 v2) ctx) r = up ctx (Three l k1 v1 m k2 v2 r) - up (Cons (TwoLeft k1 v1 (Three b k2 v2 c k3 v3 d)) ctx) a = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - up (Cons (TwoRight (Three a k1 v1 b k2 v2 c) k3 v3) ctx) d = fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - up (Cons (ThreeLeft k1 v1 Leaf k2 v2 Leaf) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - up (Cons (ThreeMiddle Leaf k1 v1 k2 v2 Leaf) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - up (Cons (ThreeRight Leaf k1 v1 Leaf k2 v2) ctx) Leaf = fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - up (Cons (ThreeLeft k1 v1 (Two b k2 v2 c) k3 v3 d) ctx) a = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - up (Cons (ThreeMiddle (Two a k1 v1 b) k2 v2 k3 v3 d) ctx) c = fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - up (Cons (ThreeMiddle a k1 v1 k2 v2 (Two c k3 v3 d)) ctx) b = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - up (Cons (ThreeRight a k1 v1 (Two b k2 v2 c) k3 v3) ctx) d = fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - up (Cons (ThreeLeft k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 e) ctx) a = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - up (Cons (ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e) ctx) d = fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - up (Cons (ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e)) ctx) b = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - up (Cons (ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4) ctx) e = fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - up _ _ = unsafeThrow "Impossible case in 'up'" + up = unsafePartial \ctxs tree -> + case ctxs of + Nil -> tree + Cons x ctx -> + case x, tree of + TwoLeft k1 v1 Leaf, Leaf -> fromZipper ctx (Two Leaf k1 v1 Leaf) + TwoRight Leaf k1 v1, Leaf -> fromZipper ctx (Two Leaf k1 v1 Leaf) + TwoLeft k1 v1 (Two m k2 v2 r), l -> up ctx (Three l k1 v1 m k2 v2 r) + TwoRight (Two l k1 v1 m) k2 v2, r -> up ctx (Three l k1 v1 m k2 v2 r) + TwoLeft k1 v1 (Three b k2 v2 c k3 v3 d), a -> fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) + TwoRight (Three a k1 v1 b k2 v2 c) k3 v3, d -> fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) + ThreeLeft k1 v1 Leaf k2 v2 Leaf, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + ThreeMiddle Leaf k1 v1 k2 v2 Leaf, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + ThreeRight Leaf k1 v1 Leaf k2 v2, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) + ThreeLeft k1 v1 (Two b k2 v2 c) k3 v3 d, a -> fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) + ThreeMiddle (Two a k1 v1 b) k2 v2 k3 v3 d, c -> fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) + ThreeMiddle a k1 v1 k2 v2 (Two c k3 v3 d), b -> fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) + ThreeRight a k1 v1 (Two b k2 v2 c) k3 v3, d -> fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) + ThreeLeft k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 e, a -> fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) + ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e, d -> fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) + ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e), b -> fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) + ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4, e -> fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) maxNode :: Map k v -> { key :: k, value :: v } - maxNode (Two _ k v Leaf) = { key: k, value: v } - maxNode (Two _ _ _ right) = maxNode right - maxNode (Three _ _ _ _ k v Leaf) = { key: k, value: v } - maxNode (Three _ _ _ _ _ _ right) = maxNode right - maxNode Leaf = unsafeThrow "Impossible case in 'maxNode'" + maxNode = unsafePartial \m -> case m of + Two _ k v Leaf -> { key: k, value: v } + Two _ _ _ right -> maxNode right + Three _ _ _ _ k v Leaf -> { key: k, value: v } + Three _ _ _ _ _ _ right -> maxNode right removeMaxNode :: List (TreeContext k v) -> Map k v -> Map k v - removeMaxNode ctx (Two Leaf _ _ Leaf) = up ctx Leaf - removeMaxNode ctx (Two left k v right) = removeMaxNode (Cons (TwoRight left k v) ctx) right - removeMaxNode ctx (Three Leaf k1 v1 Leaf _ _ Leaf) = up (Cons (TwoRight Leaf k1 v1) ctx) Leaf - removeMaxNode ctx (Three left k1 v1 mid k2 v2 right) = removeMaxNode (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right - removeMaxNode _ Leaf = unsafeThrow "Impossible case in 'removeMaxNode'" + removeMaxNode = unsafePartial \ctx m -> + case m of + Two Leaf _ _ Leaf -> up ctx Leaf + Two left k v right -> removeMaxNode (Cons (TwoRight left k v) ctx) right + Three Leaf k1 v1 Leaf _ _ Leaf -> up (Cons (TwoRight Leaf k1 v1) ctx) Leaf + Three left k1 v1 mid k2 v2 right -> removeMaxNode (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right -- | Insert the value, delete a value, or update a value for a key in a map -alter :: forall k v. (Ord k) => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v +alter :: forall k v. Ord k => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v alter f k m = case f (k `lookup` m) of Nothing -> delete k m Just v -> insert k v m -- | Update or delete the value for a key in a map -update :: forall k v. (Ord k) => (v -> Maybe v) -> k -> Map k v -> Map k v +update :: forall k v. Ord k => (v -> Maybe v) -> k -> Map k v -> Map k v update f k m = alter (maybe Nothing f) k m -- | Convert any foldable collection of key/value pairs to a map. @@ -288,40 +294,40 @@ fromFoldableWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where -- | Convert a map to a list of key/value pairs toList :: forall k v. Map k v -> List (Tuple k v) toList Leaf = Nil -toList (Two left k v right) = toList left `append` pure (Tuple k v) `append` toList right -toList (Three left k1 v1 mid k2 v2 right) = toList left `append` pure (Tuple k1 v1) `append` toList mid `append` pure (Tuple k2 v2) `append` toList right +toList (Two left k v right) = toList left <> pure (Tuple k v) <> toList right +toList (Three left k1 v1 mid k2 v2 right) = toList left <> pure (Tuple k1 v1) <> toList mid <> pure (Tuple k2 v2) <> toList right -- | Create a map from a list of key/value pairs -fromList :: forall k v. (Ord k) => List (Tuple k v) -> Map k v +fromList :: forall k v. Ord k => List (Tuple k v) -> Map k v fromList = fromFoldable -- | Create a map from a list of key/value pairs, using the specified function -- | to combine values for duplicate keys. -fromListWith :: forall k v. (Ord k) => (v -> v -> v) -> List (Tuple k v) -> Map k v +fromListWith :: forall k v. Ord k => (v -> v -> v) -> List (Tuple k v) -> Map k v fromListWith = fromFoldableWith -- | Get a list of the keys contained in a map keys :: forall k v. Map k v -> List k keys Leaf = Nil -keys (Two left k _ right) = keys left `append` pure k `append` keys right -keys (Three left k1 _ mid k2 _ right) = keys left `append` pure k1 `append` keys mid `append` pure k2 `append` keys right +keys (Two left k _ right) = keys left <> pure k <> keys right +keys (Three left k1 _ mid k2 _ right) = keys left <> pure k1 <> keys mid <> pure k2 <> keys right -- | Get a list of the values contained in a map values :: forall k v. Map k v -> List v values Leaf = Nil -values (Two left _ v right) = values left `append` pure v `append` values right -values (Three left _ v1 mid _ v2 right) = values left `append` pure v1 `append` values mid `append` pure v2 `append` values right +values (Two left _ v right) = values left <> pure v <> values right +values (Three left _ v1 mid _ v2 right) = values left <> pure v1 <> values mid <> pure v2 <> values right -- | Compute the union of two maps, using the specified function -- | to combine values for duplicate keys. -unionWith :: forall k v. (Ord k) => (v -> v -> v) -> Map k v -> Map k v -> Map k v +unionWith :: forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v unionWith f m1 m2 = foldl go m2 (toList m1) where go m (Tuple k v) = alter (Just <<< maybe v (f v)) k m -- | Compute the union of two maps, preferring values from the first map in the case -- | of duplicate keys -union :: forall k v. (Ord k) => Map k v -> Map k v -> Map k v +union :: forall k v. Ord k => Map k v -> Map k v -> Map k v union = unionWith const -- | Compute the union of a collection of maps diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index 4b8567da..49d64c2a 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -47,7 +47,7 @@ exports._foldM = function (bind) { return function (f) { return function (mz) { return function (m) { - function g (k) { + function g(k) { return function (z) { return f(z)(k)(m[k]); }; @@ -114,7 +114,7 @@ exports._lookupST = function (no, yes, k, m) { }; }; -function _collect (f) { +function _collect(f) { return function (m) { var r = []; for (var k in m) { diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 828afb57..0667dbc8 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -5,7 +5,7 @@ -- | and some native code is used even when it's not necessary. module Data.StrMap - ( StrMap() + ( StrMap , empty , isEmpty , size @@ -37,20 +37,20 @@ module Data.StrMap , pureST ) where -import Prelude (class Semigroup, class Eq, class Show, class Monad, class Functor, (<>), (<<<), return, (>>=), bind, const, (==), show, (++), (&&), id, (<$>), map, pure, (<*>), (#)) +import Prelude + +import Control.Monad.Eff (Eff, runPure) +import Control.Monad.ST as ST -import Control.Monad.Eff (Eff(), runPure) import Data.Foldable (class Foldable, foldl, foldr, for_) -import Data.Function (Fn2(), runFn2, Fn4(), runFn4) +import Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4) +import Data.List as L import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Monoid (class Monoid, mempty) +import Data.StrMap.ST as SM import Data.Traversable (class Traversable, traverse) import Data.Tuple (Tuple(..), uncurry) -import Data.List as L -import Control.Monad.ST as ST -import Data.StrMap.ST as SM - -- | `StrMap a` represents a map from `String`s to values of type `a`. foreign import data StrMap :: * -> * @@ -79,7 +79,7 @@ mutate :: forall a b. (forall h e. SM.STStrMap h a -> Eff (st :: ST.ST h | e) b) mutate f m = pureST (do s <- thawST m f s - return s) + pure s) foreign import _fmapStrMap :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b) @@ -130,7 +130,7 @@ instance eqStrMap :: (Eq a) => Eq (StrMap a) where eq m1 m2 = (isSubmap m1 m2) && (isSubmap m2 m1) instance showStrMap :: (Show a) => Show (StrMap a) where - show m = "fromList " ++ show (toList m) + show m = "fromList " <> show (toList m) -- | An empty map foreign import empty :: forall a. StrMap a @@ -152,7 +152,7 @@ singleton :: forall a. String -> a -> StrMap a singleton k v = pureST (do s <- SM.new SM.poke s k v - return s) + pure s) foreign import _lookup :: forall a z. Fn4 z (a -> z) String (StrMap a) z @@ -190,7 +190,7 @@ fromFoldable :: forall f a. (Foldable f) => fromFoldable l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> SM.poke s k v) - return s) + pure s) foreign import _lookupST :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z) @@ -201,7 +201,7 @@ fromFoldableWith :: forall f a. (Foldable f) => fromFoldableWith f l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s >>= SM.poke s k) - return s) + pure s) -- | Create a map from a list of key/value pairs fromList :: forall a. L.List (Tuple String a) -> StrMap a @@ -216,14 +216,14 @@ foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array -- | Convert a map into a list of key/value pairs toList :: forall a. StrMap a -> L.List (Tuple String a) -toList = L.toList <<< _collect Tuple +toList = L.fromFoldable <<< _collect Tuple -- | Get an array of the keys in a map foreign import keys :: forall a. StrMap a -> Array String -- | Get a list of the values in a map values :: forall a. StrMap a -> L.List a -values = L.toList <<< _collect (\_ v -> v) +values = L.fromFoldable <<< _collect (\_ v -> v) -- | Compute the union of two maps, preferring the first map in the case of -- | duplicate keys. diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs index 8da7fa0b..5e0cc144 100644 --- a/src/Data/StrMap/ST.purs +++ b/src/Data/StrMap/ST.purs @@ -3,15 +3,15 @@ -- | This module can be used when performance is important and mutation is a local effect. module Data.StrMap.ST - ( STStrMap() + ( STStrMap , new , peek , poke , delete ) where -import Control.Monad.Eff (Eff()) -import Control.Monad.ST (ST()) +import Control.Monad.Eff (Eff) +import Control.Monad.ST (ST) import Data.Maybe (Maybe(..)) -- | A reference to a mutable map diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs index aca05192..234f39f5 100644 --- a/src/Data/StrMap/ST/Unsafe.purs +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -2,10 +2,10 @@ module Data.StrMap.ST.Unsafe ( unsafeGet ) where -import Control.Monad.Eff (Eff()) -import Control.Monad.ST (ST()) -import Data.StrMap (StrMap()) -import Data.StrMap.ST (STStrMap()) +import Control.Monad.Eff (Eff) +import Control.Monad.ST (ST) +import Data.StrMap (StrMap) +import Data.StrMap.ST (STStrMap) -- | Unsafely get the map out of ST without copying it -- | diff --git a/src/Data/StrMap/Unsafe.purs b/src/Data/StrMap/Unsafe.purs index 9aaf8f7f..002df475 100644 --- a/src/Data/StrMap/Unsafe.purs +++ b/src/Data/StrMap/Unsafe.purs @@ -2,7 +2,7 @@ module Data.StrMap.Unsafe ( unsafeIndex ) where -import Data.StrMap (StrMap()) +import Data.StrMap (StrMap) -- | Unsafely get the value for a key in a map. -- | diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index afa33ea4..73dfaa45 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -3,21 +3,23 @@ module Test.Data.Map where import Prelude import Control.Alt ((<|>)) -import Control.Monad.Eff (Eff()) -import Control.Monad.Eff.Console (log, CONSOLE()) -import Control.Monad.Eff.Exception (EXCEPTION()) -import Control.Monad.Eff.Random (RANDOM()) +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (log, CONSOLE) +import Control.Monad.Eff.Exception (EXCEPTION) +import Control.Monad.Eff.Random (RANDOM) + import Data.Foldable (foldl, for_) import Data.Function (on) import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton) +import Data.Map as M import Data.Maybe (Maybe(..), fromMaybe) -import Data.Maybe.Unsafe (unsafeThrow) import Data.Tuple (Tuple(..), fst) + +import Partial.Unsafe (unsafePartial) + import Test.QuickCheck ((), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) -import Data.Map as M - newtype TestMap k v = TestMap (M.Map k v) instance arbTestMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (TestMap k v) where @@ -68,7 +70,7 @@ instance ordSmallKey :: Ord SmallKey where instance arbSmallKey :: Arbitrary SmallKey where arbitrary = do n <- arbitrary - return case n of + pure case n of _ | n < 0.1 -> A _ | n < 0.2 -> B _ | n < 0.3 -> C @@ -83,8 +85,8 @@ instance arbSmallKey :: Arbitrary SmallKey where data Instruction k v = Insert k v | Delete k instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where - show (Insert k v) = "Insert (" ++ show k ++ ") (" ++ show v ++ ")" - show (Delete k) = "Delete (" ++ show k ++ ")" + show (Insert k v) = "Insert (" <> show k <> ") (" <> show v <> ")" + show (Delete k) = "Delete (" <> show k <> ")" instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k v) where arbitrary = do @@ -93,10 +95,10 @@ instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction true -> do k <- arbitrary v <- arbitrary - return (Insert k v) + pure (Insert k v) false -> do k <- arbitrary - return (Delete k) + pure (Delete k) runInstructions :: forall k v. (Ord k) => List (Instruction k v) -> M.Map k v -> M.Map k v runInstructions instrs t0 = foldl step t0 instrs @@ -110,44 +112,37 @@ smallKey k = k number :: Int -> Int number n = n -mapTests :: forall t. - Eff - ( console :: CONSOLE - , random :: RANDOM - , err :: EXCEPTION - | t - ) - Unit +mapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPTION | eff) Unit mapTests = do -- Data.Map log "Test inserting into empty tree" quickCheck $ \k v -> M.lookup (smallKey k) (M.insert k v M.empty) == Just (number v) - ("k: " ++ show k ++ ", v: " ++ show v) + ("k: " <> show k <> ", v: " <> show v) log "Test delete after inserting" quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) - ("k: " ++ show k ++ ", v: " ++ show v) + ("k: " <> show k <> ", v: " <> show v) log "Insert two, lookup first" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 - ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) log "Insert two, lookup second" quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v2 - ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) log "Insert two, delete one" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty))) == Just v2 - ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) log "Check balance property" quickCheck' 1000 $ \instrs -> let tree :: M.Map SmallKey Int tree = runInstructions instrs M.empty - in M.checkValid tree ("Map not balanced:\n " ++ show tree ++ "\nGenerated by:\n " ++ show instrs) + in M.checkValid tree ("Map not balanced:\n " <> show tree <> "\nGenerated by:\n " <> show instrs) log "Lookup from empty" quickCheck $ \k -> M.lookup k (M.empty :: M.Map SmallKey Int) == Nothing @@ -160,7 +155,7 @@ mapTests = do let tree :: M.Map SmallKey Int tree = M.insert k v (runInstructions instrs M.empty) - in M.lookup k tree == Just v ("instrs:\n " ++ show instrs ++ "\nk:\n " ++ show k ++ "\nv:\n " ++ show v) + in M.lookup k tree == Just v ("instrs:\n " <> show instrs <> "\nk:\n " <> show k <> "\nv:\n " <> show v) log "Singleton to list" quickCheck $ \k v -> M.toList (M.singleton k v :: M.Map SmallKey Int) == singleton (Tuple k v) @@ -202,9 +197,8 @@ mapTests = do log "fromListWith (<>) = fromList . collapse with (<>) . group on fst" quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) - foldl1 g (Cons x xs) = foldl g x xs - foldl1 _ Nil = unsafeThrow "Impossible case in 'foldl1'" - f = M.fromList <<< (<$>) (foldl1 combine) <<< + foldl1 g = unsafePartial \(Cons x xs) -> foldl g x xs + f = M.fromList <<< map (foldl1 combine) <<< groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr @@ -212,7 +206,7 @@ mapTests = do quickCheck $ \(TestMap m1) (TestMap m2) k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of Nothing -> M.lookup k m2 - Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) + Just v -> Just (number v)) ("m1: " <> show m1 <> ", m2: " <> show m2 <> ", k: " <> show k <> ", v1: " <> show (M.lookup k m1) <> ", v2: " <> show (M.lookup k m2) <> ", union: " <> show (M.union m1 m2)) log "Union is idempotent" quickCheck $ \(TestMap m1) (TestMap m2) -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Int)) diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index ead4c741..014f7f13 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -2,19 +2,22 @@ module Test.Data.StrMap where import Prelude -import Data.List (List(..), groupBy, sortBy, singleton, toList, zipWith) +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (log, CONSOLE) +import Control.Monad.Eff.Exception (EXCEPTION) +import Control.Monad.Eff.Random (RANDOM) + import Data.Foldable (foldl) import Data.Function (on) +import Data.List (List(..), groupBy, sortBy, singleton, fromFoldable, zipWith) import Data.Maybe (Maybe(..)) -import Data.Maybe.Unsafe (unsafeThrow) +import Data.StrMap as M import Data.Tuple (Tuple(..), fst) -import Control.Monad.Eff(Eff()) -import Control.Monad.Eff.Console (log, CONSOLE()) -import Control.Monad.Eff.Exception (EXCEPTION()) -import Control.Monad.Eff.Random (RANDOM()) + +import Partial.Unsafe (unsafePartial) + import Test.QuickCheck ((), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) -import Data.StrMap as M newtype TestStrMap v = TestStrMap (M.StrMap v) @@ -24,8 +27,8 @@ instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where data Instruction k v = Insert k v | Delete k instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where - show (Insert k v) = "Insert (" ++ show k ++ ") (" ++ show v ++ ")" - show (Delete k) = "Delete (" ++ show k ++ ")" + show (Insert k v) = "Insert (" <> show k <> ") (" <> show v <> ")" + show (Delete k) = "Delete (" <> show k <> ")" instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where arbitrary = do @@ -34,9 +37,9 @@ instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) whe case b of true -> do v <- arbitrary - return (Insert k v) + pure (Insert k v) false -> do - return (Delete k) + pure (Delete k) runInstructions :: forall v. List (Instruction String v) -> M.StrMap v -> M.StrMap v runInstructions instrs t0 = foldl step t0 instrs @@ -47,34 +50,27 @@ runInstructions instrs t0 = foldl step t0 instrs number :: Int -> Int number n = n -strMapTests :: forall t. - Eff - ( console :: CONSOLE - , random :: RANDOM - , err :: EXCEPTION - | t - ) - Unit +strMapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPTION | eff) Unit strMapTests = do log "Test inserting into empty tree" quickCheck $ \k v -> M.lookup k (M.insert k v M.empty) == Just (number v) - ("k: " ++ show k ++ ", v: " ++ show v) + ("k: " <> show k <> ", v: " <> show v) log "Test delete after inserting" quickCheck $ \k v -> M.isEmpty (M.delete k (M.insert k (number v) M.empty)) - ("k: " ++ show k ++ ", v: " ++ show v) + ("k: " <> show k <> ", v: " <> show v) log "Insert two, lookup first" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v1 - ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) log "Insert two, lookup second" quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v2 - ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) log "Insert two, delete one" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty))) == Just v2 - ("k1: " ++ show k1 ++ ", v1: " ++ show v1 ++ ", k2: " ++ show k2 ++ ", v2: " ++ show v2) + ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) log "Lookup from empty" quickCheck $ \k -> M.lookup k (M.empty :: M.StrMap Int) == Nothing @@ -87,7 +83,7 @@ strMapTests = do let tree :: M.StrMap Int tree = M.insert k v (runInstructions instrs M.empty) - in M.lookup k tree == Just v ("instrs:\n " ++ show instrs ++ "\nk:\n " ++ show k ++ "\nv:\n " ++ show v) + in M.lookup k tree == Just v ("instrs:\n " <> show instrs <> "\nk:\n " <> show k <> "\nv:\n " <> show v) log "Singleton to list" quickCheck $ \k v -> M.toList (M.singleton k v :: M.StrMap Int) == singleton (Tuple k v) @@ -114,11 +110,11 @@ strMapTests = do quickCheck (M.lookup "1" nums == Just 2 "invalid lookup - 1") quickCheck (M.lookup "2" nums == Nothing "invalid lookup - 2") - log "toList . fromList = id" + log "fromFoldable . fromList = id" quickCheck $ \arr -> let f x = M.toList (M.fromList x) in f (f arr) == f (arr :: List (Tuple String Int)) show arr - log "fromList . toList = id" + log "fromList . fromFoldable = id" quickCheck $ \(TestStrMap m) -> let f m1 = M.fromList (M.toList m1) in M.toList (f m) == M.toList (m :: M.StrMap Int) show m @@ -130,9 +126,8 @@ strMapTests = do log "fromListWith (<>) = fromList . collapse with (<>) . group on fst" quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) - foldl1 g (Cons x xs) = foldl g x xs - foldl1 _ Nil = unsafeThrow "Impossible case in 'foldl1'" - f = M.fromList <<< (<$>) (foldl1 combine) <<< + foldl1 g = unsafePartial \(Cons x xs) -> foldl g x xs + f = M.fromList <<< map (foldl1 combine) <<< groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr @@ -140,11 +135,11 @@ strMapTests = do quickCheck $ \(TestStrMap m1) (TestStrMap m2) k -> M.lookup k (M.union m1 m2) == (case M.lookup k m1 of Nothing -> M.lookup k m2 - Just v -> Just (number v)) ("m1: " ++ show m1 ++ ", m2: " ++ show m2 ++ ", k: " ++ show k ++ ", v1: " ++ show (M.lookup k m1) ++ ", v2: " ++ show (M.lookup k m2) ++ ", union: " ++ show (M.union m1 m2)) + Just v -> Just (number v)) ("m1: " <> show m1 <> ", m2: " <> show m2 <> ", k: " <> show k <> ", v1: " <> show (M.lookup k m1) <> ", v2: " <> show (M.lookup k m2) <> ", union: " <> show (M.union m1 m2)) log "Union is idempotent" quickCheck $ \(TestStrMap m1) (TestStrMap m2) -> - (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Int)) (show (M.size (m1 `M.union` m2)) ++ " != " ++ show (M.size ((m1 `M.union` m2) `M.union` m2))) + (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Int)) (show (M.size (m1 `M.union` m2)) <> " != " <> show (M.size ((m1 `M.union` m2) `M.union` m2))) - log "toList = zip keys values" - quickCheck $ \(TestStrMap m) -> M.toList m == zipWith Tuple (toList $ M.keys m) (M.values m :: List Int) + log "fromFoldable = zip keys values" + quickCheck $ \(TestStrMap m) -> M.toList m == zipWith Tuple (fromFoldable $ M.keys m) (M.values m :: List Int) diff --git a/test/Test/Main.purs b/test/Test/Main.purs index e6dbf048..25b33de6 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -2,22 +2,15 @@ module Test.Main where import Prelude -import Control.Monad.Eff (Eff()) -import Control.Monad.Eff.Console (log, CONSOLE()) -import Control.Monad.Eff.Exception (EXCEPTION()) -import Control.Monad.Eff.Random (RANDOM()) +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (log, CONSOLE) +import Control.Monad.Eff.Exception (EXCEPTION) +import Control.Monad.Eff.Random (RANDOM) import Test.Data.Map (mapTests) import Test.Data.StrMap (strMapTests) -main :: forall t. - Eff - ( console :: CONSOLE - , random :: RANDOM - , err :: EXCEPTION - | t - ) - Unit +main :: Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPTION) Unit main = do log "Running Map tests" mapTests From 6cfb8a2749f7234209bd93d03856482a38be6bd2 Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Mon, 9 May 2016 16:38:37 -0500 Subject: [PATCH 065/125] Add pop functions --- src/Data/Map.purs | 28 +++++++++++++++++----------- src/Data/StrMap.purs | 6 ++++++ test/Test/Data/Map.purs | 8 ++++++++ test/Test/Data/StrMap.purs | 8 ++++++++ 4 files changed, 39 insertions(+), 11 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 1ddf6420..d52b5156 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -16,6 +16,7 @@ module Data.Map , fromList , fromListWith , delete + , pop , member , alter , update @@ -34,7 +35,7 @@ import Data.List (List(..), length, nub) import Data.Maybe (Maybe(..), maybe, isJust) import Data.Monoid (class Monoid) import Data.Traversable (traverse, class Traversable) -import Data.Tuple (Tuple(..), uncurry) +import Data.Tuple (Tuple(..), uncurry, snd) import Partial.Unsafe (unsafePartial) @@ -195,21 +196,26 @@ insert = down Nil ThreeMiddle a k1 v1 k2 v2 d, KickUp b k v c -> up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) ThreeRight a k1 v1 b k2 v2, KickUp c k v d -> up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) --- | Delete a key and its corresponding value from a map +-- | Delete a key and its corresponding value from a map. delete :: forall k v. Ord k => k -> Map k v -> Map k v -delete = down Nil +delete k m = maybe m snd (pop k m) + +-- | Delete a key and its corresponding value from a map, returning the value +-- | as well as the subsequent map. +pop :: forall k v. Ord k => k -> Map k v -> Maybe (Tuple v (Map k v)) +pop = down Nil where comp :: k -> k -> Ordering comp = compare - down :: List (TreeContext k v) -> k -> Map k v -> Map k v + down :: List (TreeContext k v) -> k -> Map k v -> Maybe (Tuple v (Map k v)) down = unsafePartial \ctx k m -> case m of - Leaf -> fromZipper ctx Leaf + Leaf -> Nothing Two left k1 v1 right -> case right, comp k k1 of - Leaf, EQ -> up ctx Leaf + Leaf, EQ -> Just (Tuple v1 (up ctx Leaf)) _ , EQ -> let max = maxNode left - in removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left + in Just (Tuple v1 (removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left)) _ , LT -> down (Cons (TwoLeft k1 v1 right) ctx) k left _ , _ -> down (Cons (TwoRight left k1 v1) ctx) k right Three left k1 v1 mid k2 v2 right -> @@ -218,12 +224,12 @@ delete = down Nil Leaf, Leaf, Leaf -> true _ , _ , _ -> false in case leaves, comp k k1, comp k k2 of - true, EQ, _ -> fromZipper ctx (Two Leaf k2 v2 Leaf) - true, _ , EQ -> fromZipper ctx (Two Leaf k1 v1 Leaf) + true, EQ, _ -> Just (Tuple v1 (fromZipper ctx (Two Leaf k2 v2 Leaf))) + true, _ , EQ -> Just (Tuple v2 (fromZipper ctx (Two Leaf k1 v1 Leaf))) _ , EQ, _ -> let max = maxNode left - in removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left + in Just (Tuple v1 (removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left)) _ , _ , EQ -> let max = maxNode mid - in removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid + in Just (Tuple v2 (removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid)) _ , LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k left _ , GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid _ , _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 0667dbc8..adc3bb31 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -18,6 +18,7 @@ module Data.StrMap , fromList , fromListWith , delete + , pop , member , alter , update @@ -174,6 +175,11 @@ foreign import _unsafeDeleteStrMap :: forall a. Fn2 (StrMap a) String (StrMap a) delete :: forall a. String -> StrMap a -> StrMap a delete k = mutate (\s -> SM.delete s k) +-- | Delete a key and value from a map, returning the value +-- | as well as the subsequent map +pop :: forall a. String -> StrMap a -> Maybe (Tuple a (StrMap a)) +pop k m = lookup k m <#> \a -> Tuple a (delete k m) + -- | Insert, remove or update a value for a key in a map alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a alter f k m = case f (k `lookup` m) of diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 73dfaa45..2f1215fb 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -125,6 +125,14 @@ mapTests = do quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) ("k: " <> show k <> ", v: " <> show v) + log "Test pop after inserting" + quickCheck $ \k v -> M.pop (smallKey k) (M.insert k (number v) M.empty) == Just (Tuple v M.empty) + ("k: " <> show k <> ", v: " <> show v) + + log "Pop non-existent key" + quickCheck $ \k1 k2 v -> k1 == k2 || M.pop (smallKey k2) (M.insert k1 (number v) M.empty) == Nothing + ("k1: " <> show k1 <> ", k2: " <> show k2 <> ", v: " <> show v) + log "Insert two, lookup first" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 014f7f13..82ad560b 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -60,6 +60,14 @@ strMapTests = do quickCheck $ \k v -> M.isEmpty (M.delete k (M.insert k (number v) M.empty)) ("k: " <> show k <> ", v: " <> show v) + log "Test pop after inserting" + quickCheck $ \k v -> M.pop k (M.insert k (number v) M.empty) == Just (Tuple v M.empty) + ("k: " <> show k <> ", v: " <> show v) + + log "Pop non-existent key" + quickCheck $ \k1 k2 v -> k1 == k2 || M.pop k2 (M.insert k1 (number v) M.empty) == Nothing + ("k1: " <> show k1 <> ", k2: " <> show k2 <> ", v: " <> show v) + log "Insert two, lookup first" quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v1 ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) From cdd695d41260cfce5b4e4915a56817a281e4e757 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Thu, 19 May 2016 01:43:06 +0100 Subject: [PATCH 066/125] Add test for #63 --- test/Test/Data/StrMap.purs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 014f7f13..6be1dbc0 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -143,3 +143,12 @@ strMapTests = do log "fromFoldable = zip keys values" quickCheck $ \(TestStrMap m) -> M.toList m == zipWith Tuple (fromFoldable $ M.keys m) (M.values m :: List Int) + + log "Bug #63: accidental observable mutation in foldMap" + quickCheck \(TestStrMap m) -> + let lhs = go m + rhs = go m + in lhs == rhs ("lhs: " <> show lhs <> ", rhs: " <> show rhs) + where + go :: M.StrMap (Array Ordering) -> Array Ordering + go = M.foldMap \_ v -> v From 6842f5df53e0e338c55866b0a69ac1d89b332eca Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Thu, 19 May 2016 01:44:04 +0100 Subject: [PATCH 067/125] Fix #63 --- src/Data/StrMap.js | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index 49d64c2a..bb5ee353 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -47,6 +47,7 @@ exports._foldM = function (bind) { return function (f) { return function (mz) { return function (m) { + var acc = mz; function g(k) { return function (z) { return f(z)(k)(m[k]); @@ -54,10 +55,10 @@ exports._foldM = function (bind) { } for (var k in m) { if (m.hasOwnProperty(k)) { - mz = bind(mz)(g(k)); + acc = bind(acc)(g(k)); } } - return mz; + return acc; }; }; }; From bf6bb691b1c5c7d54d134791007cd57e69dc7fb4 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 19 May 2016 12:22:54 +0100 Subject: [PATCH 068/125] Add arrays dependency --- bower.json | 1 + 1 file changed, 1 insertion(+) diff --git a/bower.json b/bower.json index 53596b04..b60be006 100644 --- a/bower.json +++ b/bower.json @@ -21,6 +21,7 @@ "package.json" ], "dependencies": { + "purescript-arrays": "^1.0.0-rc.4", "purescript-functions": "^1.0.0-rc.1", "purescript-lists": "^1.0.0-rc.1", "purescript-st": "^1.0.0-rc.1" From da3c79cfea78a5245a803f55f25805ed7339f468 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sat, 21 May 2016 00:37:28 +0100 Subject: [PATCH 069/125] Update build --- .travis.yml | 17 ++++++++--------- package.json | 7 ++++--- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/.travis.yml b/.travis.yml index bab24346..34553056 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,7 +1,7 @@ language: node_js -sudo: required dist: trusty -node_js: 5 +sudo: required +node_js: 6 env: - PATH=$HOME/purescript:$PATH install: @@ -11,14 +11,13 @@ install: - chmod a+x $HOME/purescript - npm install -g bower - npm install - - bower install script: - - npm test + - bower install --production + - npm run -s build + - bower install + - npm -s test after_success: - >- test $TRAVIS_TAG && - psc-publish > .pursuit.json && - curl -X POST http://pursuit.purescript.org/packages \ - -d @.pursuit.json \ - -H 'Accept: application/json' \ - -H "Authorization: token ${GITHUB_TOKEN}" + echo $GITHUB_TOKEN | pulp login && + echo y | pulp publish --no-push diff --git a/package.json b/package.json index 55fc1c7f..8bbaae78 100644 --- a/package.json +++ b/package.json @@ -2,13 +2,14 @@ "private": true, "scripts": { "clean": "rimraf output && rimraf .pulp-cache", - "build": "jshint src && jscs src && pulp build", - "test": "jshint src && jscs src && pulp test" + "build": "jshint src && jscs src && pulp build --censor-lib --strict", + "test": "pulp test" }, "devDependencies": { "jscs": "^2.8.0", "jshint": "^2.9.1", - "pulp": "^8.1.0", + "pulp": "^8.2.0", + "purescript-psa": "^0.3.8", "rimraf": "^2.5.0" } } From 35a8464ab549e51b53e1505f3ed641960b24d5d5 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 1 Jun 2016 03:48:56 +0100 Subject: [PATCH 070/125] Update build for release --- bower.json | 10 +++++----- package.json | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/bower.json b/bower.json index b60be006..0fcc3210 100644 --- a/bower.json +++ b/bower.json @@ -21,12 +21,12 @@ "package.json" ], "dependencies": { - "purescript-arrays": "^1.0.0-rc.4", - "purescript-functions": "^1.0.0-rc.1", - "purescript-lists": "^1.0.0-rc.1", - "purescript-st": "^1.0.0-rc.1" + "purescript-arrays": "^1.0.0", + "purescript-functions": "^1.0.0", + "purescript-lists": "^1.0.0", + "purescript-st": "^1.0.0" }, "devDependencies": { - "purescript-quickcheck": "^1.0.0-rc.1" + "purescript-quickcheck": "^1.0.0" } } diff --git a/package.json b/package.json index 8bbaae78..46e9a546 100644 --- a/package.json +++ b/package.json @@ -2,8 +2,8 @@ "private": true, "scripts": { "clean": "rimraf output && rimraf .pulp-cache", - "build": "jshint src && jscs src && pulp build --censor-lib --strict", - "test": "pulp test" + "build": "jshint src && jscs src && psa \"src/**/*.purs\" \"bower_components/purescript-*/src/**/*.purs\" --censor-lib --strict", + "test": "psc \"src/**/*.purs\" \"bower_components/purescript-*/src/**/*.purs\" \"test/**/*.purs\" && psc-bundle \"output/**/*.js\" --module Test.Main --main Test.Main | node" }, "devDependencies": { "jscs": "^2.8.0", From 7c2354ce36e5cb324a54c6b803eb53e26771a1b0 Mon Sep 17 00:00:00 2001 From: Michael Tolly Date: Wed, 22 Jun 2016 11:59:53 -0500 Subject: [PATCH 071/125] Add lookup{LT,LE,GT,GE}, find{Min,Max} --- src/Data/Map.purs | 69 ++++++++++++++++++++++++++++++++++++++++- test/Test/Data/Map.purs | 55 +++++++++++++++++++++++++++++++- 2 files changed, 122 insertions(+), 2 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index d52b5156..2fdbb2fa 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -10,6 +10,12 @@ module Data.Map , checkValid , insert , lookup + , lookupLE + , lookupLT + , lookupGE + , lookupGT + , findMin + , findMax , fromFoldable , fromFoldableWith , toList @@ -32,7 +38,7 @@ import Prelude import Data.Foldable (foldl, foldMap, foldr, class Foldable) import Data.List (List(..), length, nub) -import Data.Maybe (Maybe(..), maybe, isJust) +import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) import Data.Monoid (class Monoid) import Data.Traversable (traverse, class Traversable) import Data.Tuple (Tuple(..), uncurry, snd) @@ -139,6 +145,67 @@ lookup = unsafePartial \k tree -> _ , GT -> lookup k right _ , _ -> lookup k mid + +-- | Lookup a value for the specified key, or the greatest one less than it +lookupLE :: forall k v. (Ord k) => k -> Map k v -> Maybe { key :: k, value :: v } +lookupLE _ Leaf = Nothing +lookupLE k (Two left k1 v1 right) = case compare k k1 of + EQ -> Just { key: k1, value: v1 } + GT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupLE k right + LT -> lookupLE k left +lookupLE k (Three left k1 v1 mid k2 v2 right) = case compare k k2 of + EQ -> Just { key: k2, value: v2 } + GT -> Just $ fromMaybe { key: k2, value: v2 } $ lookupLE k right + LT -> lookupLE k $ Two left k1 v1 mid + +-- | Lookup a value for the greatest key less than the specified key +lookupLT :: forall k v. (Ord k) => k -> Map k v -> Maybe { key :: k, value :: v } +lookupLT _ Leaf = Nothing +lookupLT k (Two left k1 v1 right) = case compare k k1 of + EQ -> findMax left + GT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupLT k right + LT -> lookupLT k left +lookupLT k (Three left k1 v1 mid k2 v2 right) = case compare k k2 of + EQ -> findMax $ Two left k1 v1 mid + GT -> Just $ fromMaybe { key: k2, value: v2 } $ lookupLT k right + LT -> lookupLT k $ Two left k1 v1 mid + +-- | Lookup a value for the specified key, or the least one greater than it +lookupGE :: forall k v. (Ord k) => k -> Map k v -> Maybe { key :: k, value :: v } +lookupGE _ Leaf = Nothing +lookupGE k (Two left k1 v1 right) = case compare k k1 of + EQ -> Just { key: k1, value: v1 } + LT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupGE k left + GT -> lookupGE k right +lookupGE k (Three left k1 v1 mid k2 v2 right) = case compare k k1 of + EQ -> Just { key: k1, value: v1 } + LT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupGE k left + GT -> lookupGE k $ Two mid k2 v2 right + +-- | Lookup a value for the least key greater than the specified key +lookupGT :: forall k v. (Ord k) => k -> Map k v -> Maybe { key :: k, value :: v } +lookupGT _ Leaf = Nothing +lookupGT k (Two left k1 v1 right) = case compare k k1 of + EQ -> findMin right + LT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupGT k left + GT -> lookupGT k right +lookupGT k (Three left k1 v1 mid k2 v2 right) = case compare k k1 of + EQ -> findMin $ Two mid k2 v2 right + LT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupGT k left + GT -> lookupGT k $ Two mid k2 v2 right + +-- | Returns the pair with the greatest key +findMax :: forall k v. Map k v -> Maybe { key :: k, value :: v } +findMax Leaf = Nothing +findMax (Two _ k1 v1 right) = Just $ fromMaybe { key: k1, value: v1 } $ findMax right +findMax (Three _ _ _ _ k2 v2 right) = Just $ fromMaybe { key: k2, value: v2 } $ findMax right + +-- | Returns the pair with the least key +findMin :: forall k v. Map k v -> Maybe { key :: k, value :: v } +findMin Leaf = Nothing +findMin (Two left k1 v1 _) = Just $ fromMaybe { key: k1, value: v1 } $ findMin left +findMin (Three left k1 v1 _ _ _ _) = Just $ fromMaybe { key: k1, value: v1 } $ findMin left + -- | Test if a key is a member of a map member :: forall k v. Ord k => k -> Map k v -> Boolean member k m = isJust (k `lookup` m) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 2f1215fb..bea03f7c 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -8,7 +8,7 @@ import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) -import Data.Foldable (foldl, for_) +import Data.Foldable (foldl, for_, all) import Data.Function (on) import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton) import Data.Map as M @@ -112,6 +112,9 @@ smallKey k = k number :: Int -> Int number n = n +smallKeyToNumberMap :: M.Map SmallKey Int -> M.Map SmallKey Int +smallKeyToNumberMap m = m + mapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPTION | eff) Unit mapTests = do @@ -247,3 +250,53 @@ mapTests = do quickCheck $ \xs -> let xs' = nubBy ((==) `on` fst) xs in M.size (M.fromList xs') == length (xs' :: List (Tuple SmallKey Int)) + + log "lookupLE result is correct" + quickCheck $ \k (TestMap m) -> case M.lookupLE k (smallKeyToNumberMap m) of + Nothing -> all (_ > k) $ M.keys m + Just { key: k1, value: v } -> let + isCloserKey k2 = k1 < k2 && k2 < k + isLTwhenEQexists = k1 < k && M.member k m + in k1 <= k + && all (not <<< isCloserKey) (M.keys m) + && not isLTwhenEQexists + && M.lookup k1 m == Just v + + log "lookupGE result is correct" + quickCheck $ \k (TestMap m) -> case M.lookupGE k (smallKeyToNumberMap m) of + Nothing -> all (_ < k) $ M.keys m + Just { key: k1, value: v } -> let + isCloserKey k2 = k < k2 && k2 < k1 + isGTwhenEQexists = k < k1 && M.member k m + in k1 >= k + && all (not <<< isCloserKey) (M.keys m) + && not isGTwhenEQexists + && M.lookup k1 m == Just v + + log "lookupLT result is correct" + quickCheck $ \k (TestMap m) -> case M.lookupLT k (smallKeyToNumberMap m) of + Nothing -> all (_ >= k) $ M.keys m + Just { key: k1, value: v } -> let + isCloserKey k2 = k1 < k2 && k2 < k + in k1 < k + && all (not <<< isCloserKey) (M.keys m) + && M.lookup k1 m == Just v + + log "lookupGT result is correct" + quickCheck $ \k (TestMap m) -> case M.lookupGT k (smallKeyToNumberMap m) of + Nothing -> all (_ <= k) $ M.keys m + Just { key: k1, value: v } -> let + isCloserKey k2 = k < k2 && k2 < k1 + in k1 > k + && all (not <<< isCloserKey) (M.keys m) + && M.lookup k1 m == Just v + + log "findMin result is correct" + quickCheck $ \(TestMap m) -> case M.findMin (smallKeyToNumberMap m) of + Nothing -> M.isEmpty m + Just { key: k, value: v } -> M.lookup k m == Just v && all (_ >= k) (M.keys m) + + log "findMax result is correct" + quickCheck $ \(TestMap m) -> case M.findMax (smallKeyToNumberMap m) of + Nothing -> M.isEmpty m + Just { key: k, value: v } -> M.lookup k m == Just v && all (_ <= k) (M.keys m) From 8d59376dc4d5431c50fb68096654e458fa2b3e65 Mon Sep 17 00:00:00 2001 From: Alex Gryzlov Date: Tue, 13 Sep 2016 13:44:47 +0300 Subject: [PATCH 072/125] add mapWithKey --- src/Data/Map.purs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 2fdbb2fa..e403a0a8 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -32,6 +32,7 @@ module Data.Map , unionWith , unions , size + , mapWithKey ) where import Prelude @@ -410,3 +411,9 @@ unions = foldl union empty -- | Calculate the number of key/value pairs in a map size :: forall k v. Map k v -> Int size = length <<< values + +-- | Apply a function of two arguments to each key/value pair, producing a new map +mapWithKey :: forall k v v'. (k -> v -> v') -> Map k v -> Map k v' +mapWithKey _ Leaf = Leaf +mapWithKey f (Two left k v right) = Two (mapWithKey f left) k (f k v) (mapWithKey f right) +mapWithKey f (Three left k1 v1 mid k2 v2 right) = Three (mapWithKey f left) k1 (f k1 v1) (mapWithKey f mid) k2 (f k2 v2) (mapWithKey f right) From 77f5362a964e82755bb0857599e4b704cc958abb Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Tue, 13 Sep 2016 18:42:54 -0700 Subject: [PATCH 073/125] v1.2.0 From 103122a51d0280c07849894d9ea04f30a12e9f38 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sun, 16 Oct 2016 19:36:36 +0100 Subject: [PATCH 074/125] Prepare for 2.0 release --- bower.json | 10 +++++----- src/Data/Map.purs | 38 +++++++++++++++++++------------------- src/Data/StrMap.purs | 22 +++++++--------------- test/Test/Data/Map.purs | 27 ++++++++++++++------------- test/Test/Data/StrMap.purs | 23 ++++++++++++----------- 5 files changed, 57 insertions(+), 63 deletions(-) diff --git a/bower.json b/bower.json index 0fcc3210..476e5dc5 100644 --- a/bower.json +++ b/bower.json @@ -21,12 +21,12 @@ "package.json" ], "dependencies": { - "purescript-arrays": "^1.0.0", - "purescript-functions": "^1.0.0", - "purescript-lists": "^1.0.0", - "purescript-st": "^1.0.0" + "purescript-arrays": "^3.0.0", + "purescript-functions": "^2.0.0", + "purescript-lists": "^3.0.0", + "purescript-st": "^2.0.0" }, "devDependencies": { - "purescript-quickcheck": "^1.0.0" + "purescript-quickcheck": "^3.0.0" } } diff --git a/src/Data/Map.purs b/src/Data/Map.purs index e403a0a8..bf072a79 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -19,8 +19,7 @@ module Data.Map , fromFoldable , fromFoldableWith , toList - , fromList - , fromListWith + , toUnfoldable , delete , pop , member @@ -38,11 +37,12 @@ module Data.Map import Prelude import Data.Foldable (foldl, foldMap, foldr, class Foldable) -import Data.List (List(..), length, nub) +import Data.List (List(..), (:), length, nub) import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) import Data.Monoid (class Monoid) import Data.Traversable (traverse, class Traversable) import Data.Tuple (Tuple(..), uncurry, snd) +import Data.Unfoldable (class Unfoldable, unfoldr) import Partial.Unsafe (unsafePartial) @@ -55,16 +55,16 @@ data Map k v instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where eq m1 m2 = toList m1 == toList m2 -instance showMap :: (Show k, Show v) => Show (Map k v) where - show m = "(fromList " <> show (toList m) <> ")" - instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where compare m1 m2 = compare (toList m1) (toList m2) -instance semigroupMap :: (Ord k) => Semigroup (Map k v) where +instance showMap :: (Show k, Show v) => Show (Map k v) where + show m = "(fromList " <> show (toList m) <> ")" + +instance semigroupMap :: Ord k => Semigroup (Map k v) where append = union -instance monoidMap :: (Ord k) => Monoid (Map k v) where +instance monoidMap :: Ord k => Monoid (Map k v) where mempty = empty instance functorMap :: Functor (Map k) where @@ -77,7 +77,7 @@ instance foldableMap :: Foldable (Map k) where foldr f z m = foldr f z (values m) foldMap f m = foldMap f (values m) -instance traversableMap :: (Ord k) => Traversable (Map k) where +instance traversableMap :: Ord k => Traversable (Map k) where traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toList ms)) sequence = traverse id @@ -368,17 +368,17 @@ fromFoldableWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where -- | Convert a map to a list of key/value pairs toList :: forall k v. Map k v -> List (Tuple k v) toList Leaf = Nil -toList (Two left k v right) = toList left <> pure (Tuple k v) <> toList right -toList (Three left k1 v1 mid k2 v2 right) = toList left <> pure (Tuple k1 v1) <> toList mid <> pure (Tuple k2 v2) <> toList right - --- | Create a map from a list of key/value pairs -fromList :: forall k v. Ord k => List (Tuple k v) -> Map k v -fromList = fromFoldable +toList (Two left k v right) = toList left <> Tuple k v : toList right +toList (Three left k1 v1 mid k2 v2 right) = toList left <> Tuple k1 v1 : toList mid <> Tuple k2 v2 : toList right --- | Create a map from a list of key/value pairs, using the specified function --- | to combine values for duplicate keys. -fromListWith :: forall k v. Ord k => (v -> v -> v) -> List (Tuple k v) -> Map k v -fromListWith = fromFoldableWith +-- | Convert a map to an unfoldable structure of key/value pairs +toUnfoldable :: forall f k v. (Ord k, Unfoldable f) => Map k v -> f (Tuple k v) +toUnfoldable = unfoldr go + where + go :: Map k v -> Maybe (Tuple (Tuple k v) (Map k v)) + go Leaf = Nothing + go (Two left k v right) = Just $ Tuple (Tuple k v) (left <> right) + go (Three left k1 v1 mid k2 v2 right) = Just $ Tuple (Tuple k1 v1) (Two left k2 v2 right) -- | Get a list of the keys contained in a map keys :: forall k v. Map k v -> List k diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index adc3bb31..19389fef 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -13,10 +13,9 @@ module Data.StrMap , insert , lookup , toList + , toUnfoldable , fromFoldable , fromFoldableWith - , fromList - , fromListWith , delete , pop , member @@ -51,6 +50,7 @@ import Data.Monoid (class Monoid, mempty) import Data.StrMap.ST as SM import Data.Traversable (class Traversable, traverse) import Data.Tuple (Tuple(..), uncurry) +import Data.Unfoldable (class Unfoldable) -- | `StrMap a` represents a map from `String`s to values of type `a`. foreign import data StrMap :: * -> * @@ -191,8 +191,7 @@ update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a update f k m = alter (maybe Nothing f) k m -- | Create a map from a foldable collection of key/value pairs -fromFoldable :: forall f a. (Foldable f) => - f (Tuple String a) -> StrMap a +fromFoldable :: forall f a. Foldable f => f (Tuple String a) -> StrMap a fromFoldable l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> SM.poke s k v) @@ -202,28 +201,21 @@ foreign import _lookupST :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h -- | Create a map from a foldable collection of key/value pairs, using the -- | specified function to combine values for duplicate keys. -fromFoldableWith :: forall f a. (Foldable f) => - (a -> a -> a) -> f (Tuple String a) -> StrMap a +fromFoldableWith :: forall f a. Foldable f => (a -> a -> a) -> f (Tuple String a) -> StrMap a fromFoldableWith f l = pureST (do s <- SM.new for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s >>= SM.poke s k) pure s) --- | Create a map from a list of key/value pairs -fromList :: forall a. L.List (Tuple String a) -> StrMap a -fromList = fromFoldable - --- | Create a map from a list of key/value pairs, using the specified function --- | to combine values for duplicate keys. -fromListWith :: forall a. (a -> a -> a) -> L.List (Tuple String a) -> StrMap a -fromListWith = fromFoldableWith - foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array b -- | Convert a map into a list of key/value pairs toList :: forall a. StrMap a -> L.List (Tuple String a) toList = L.fromFoldable <<< _collect Tuple +toUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a) +toUnfoldable = L.toUnfoldable <<< toList + -- | Get an array of the keys in a map foreign import keys :: forall a. StrMap a -> Array String diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index bea03f7c..05b5e5d7 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -11,19 +11,20 @@ import Control.Monad.Eff.Random (RANDOM) import Data.Foldable (foldl, for_, all) import Data.Function (on) import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton) +import Data.List.NonEmpty as NEL import Data.Map as M import Data.Maybe (Maybe(..), fromMaybe) import Data.Tuple (Tuple(..), fst) import Partial.Unsafe (unsafePartial) -import Test.QuickCheck ((), quickCheck, quickCheck') +import Test.QuickCheck ((), (===), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) newtype TestMap k v = TestMap (M.Map k v) instance arbTestMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (TestMap k v) where - arbitrary = TestMap <<< M.fromList <$> arbitrary + arbitrary = TestMap <<< (M.fromFoldable :: List (Tuple k v) -> M.Map k v) <$> arbitrary data SmallKey = A | B | C | D | E | F | G | H | I | J @@ -193,25 +194,25 @@ mapTests = do quickCheck (M.lookup 1 nums == Just 2 "invalid lookup - 1") quickCheck (M.lookup 2 nums == Nothing "invalid lookup - 2") - log "toList . fromList = id" - quickCheck $ \arr -> let f x = M.toList (M.fromList x) + log "toList . fromFoldable = id" + quickCheck $ \arr -> let f x = M.toList (M.fromFoldable x) in f (f arr) == f (arr :: List (Tuple SmallKey Int)) show arr - log "fromList . toList = id" - quickCheck $ \(TestMap m) -> let f m' = M.fromList (M.toList m') in + log "fromFoldable . toList = id" + quickCheck $ \(TestMap m) -> let f m' = M.fromFoldable (M.toList m') in M.toList (f m) == M.toList (m :: M.Map SmallKey Int) show m - log "fromListWith const = fromList" - quickCheck $ \arr -> M.fromListWith const arr == - M.fromList (arr :: List (Tuple SmallKey Int)) show arr + log "fromFoldableWith const = fromFoldable" + quickCheck $ \arr -> M.fromFoldableWith const arr == + M.fromFoldable (arr :: List (Tuple SmallKey Int)) show arr - log "fromListWith (<>) = fromList . collapse with (<>) . group on fst" + log "fromFoldableWith (<>) = fromFoldable . collapse with (<>) . group on fst" quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) foldl1 g = unsafePartial \(Cons x xs) -> foldl g x xs - f = M.fromList <<< map (foldl1 combine) <<< + f = M.fromFoldable <<< map (foldl1 combine <<< NEL.toList) <<< groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in - M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr + M.fromFoldableWith (<>) arr === f (arr :: List (Tuple String String)) log "Lookup from union" quickCheck $ \(TestMap m1) (TestMap m2) k -> @@ -249,7 +250,7 @@ mapTests = do log "size" quickCheck $ \xs -> let xs' = nubBy ((==) `on` fst) xs - in M.size (M.fromList xs') == length (xs' :: List (Tuple SmallKey Int)) + in M.size (M.fromFoldable xs') == length (xs' :: List (Tuple SmallKey Int)) log "lookupLE result is correct" quickCheck $ \k (TestMap m) -> case M.lookupLE k (smallKeyToNumberMap m) of diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 0ee6047e..35ec50bc 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -10,6 +10,7 @@ import Control.Monad.Eff.Random (RANDOM) import Data.Foldable (foldl) import Data.Function (on) import Data.List (List(..), groupBy, sortBy, singleton, fromFoldable, zipWith) +import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..)) import Data.StrMap as M import Data.Tuple (Tuple(..), fst) @@ -22,7 +23,7 @@ import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) newtype TestStrMap v = TestStrMap (M.StrMap v) instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where - arbitrary = TestStrMap <<< M.fromList <$> arbitrary + arbitrary = TestStrMap <<< (M.fromFoldable :: List (Tuple String v) -> M.StrMap v) <$> arbitrary data Instruction k v = Insert k v | Delete k @@ -118,26 +119,26 @@ strMapTests = do quickCheck (M.lookup "1" nums == Just 2 "invalid lookup - 1") quickCheck (M.lookup "2" nums == Nothing "invalid lookup - 2") - log "fromFoldable . fromList = id" - quickCheck $ \arr -> let f x = M.toList (M.fromList x) + log "toList . fromFoldable = id" + quickCheck $ \arr -> let f x = M.toList (M.fromFoldable x) in f (f arr) == f (arr :: List (Tuple String Int)) show arr - log "fromList . fromFoldable = id" + log "fromFoldable . toList = id" quickCheck $ \(TestStrMap m) -> - let f m1 = M.fromList (M.toList m1) in + let f m1 = M.fromFoldable (M.toList m1) in M.toList (f m) == M.toList (m :: M.StrMap Int) show m - log "fromListWith const = fromList" - quickCheck $ \arr -> M.fromListWith const arr == - M.fromList (arr :: List (Tuple String Int)) show arr + log "fromFoldableWith const = fromFoldable" + quickCheck $ \arr -> M.fromFoldableWith const arr == + M.fromFoldable (arr :: List (Tuple String Int)) show arr - log "fromListWith (<>) = fromList . collapse with (<>) . group on fst" + log "fromFoldableWith (<>) = fromFoldable . collapse with (<>) . group on fst" quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) foldl1 g = unsafePartial \(Cons x xs) -> foldl g x xs - f = M.fromList <<< map (foldl1 combine) <<< + f = M.fromFoldable <<< map (foldl1 combine <<< NEL.toList) <<< groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in - M.fromListWith (<>) arr == f (arr :: List (Tuple String String)) show arr + M.fromFoldableWith (<>) arr == f (arr :: List (Tuple String String)) show arr log "Lookup from union" quickCheck $ \(TestStrMap m1) (TestStrMap m2) k -> From 9d9079541f2c23265350302b550276574b70ff2b Mon Sep 17 00:00:00 2001 From: Joshua Horowitz Date: Sat, 8 Oct 2016 00:38:39 -0700 Subject: [PATCH 075/125] Add StrMap.mapWithKey --- src/Data/StrMap.js | 11 +++++++++++ src/Data/StrMap.purs | 7 +++++++ test/Test/Data/Map.purs | 7 +++++++ test/Test/Data/StrMap.purs | 9 ++++++++- 4 files changed, 33 insertions(+), 1 deletion(-) diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index bb5ee353..2213c184 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -42,6 +42,17 @@ exports._fmapStrMap = function (m0, f) { return m; }; +// jshint maxparams: 2 +exports._mapWithKey = function (m0, f) { + var m = {}; + for (var k in m0) { + if (m0.hasOwnProperty(k)) { + m[k] = f(k)(m0[k]); + } + } + return m; +}; + // jshint maxparams: 1 exports._foldM = function (bind) { return function (f) { diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 19389fef..c47ceef7 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -21,6 +21,7 @@ module Data.StrMap , member , alter , update + , mapWithKey , keys , values , union @@ -232,6 +233,12 @@ union m = mutate (\s -> foldM SM.poke s m) unions :: forall a. L.List (StrMap a) -> StrMap a unions = foldl union empty +foreign import _mapWithKey :: forall a b. Fn2 (StrMap a) (String -> a -> b) (StrMap b) + +-- | Apply a function of two arguments to each key/value pair, producing a new map +mapWithKey :: forall a b. (String -> a -> b) -> StrMap a -> StrMap b +mapWithKey f m = runFn2 _mapWithKey m f + instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) where append m1 m2 = mutate (\s1 -> foldM (\s2 k v2 -> SM.poke s2 k (runFn4 _lookup v2 (\v1 -> v1 <> v2) k m2)) s1 m1) m2 diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 05b5e5d7..3153d5fa 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -301,3 +301,10 @@ mapTests = do quickCheck $ \(TestMap m) -> case M.findMax (smallKeyToNumberMap m) of Nothing -> M.isEmpty m Just { key: k, value: v } -> M.lookup k m == Just v && all (_ <= k) (M.keys m) + + log "mapWithKey is correct" + quickCheck $ \(TestMap m :: TestMap String Int) -> let + f k v = k <> show v + resultViaMapWithKey = m # M.mapWithKey f + resultViaLists = m # M.toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable + in resultViaMapWithKey === resultViaLists diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 35ec50bc..33acb595 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -17,7 +17,7 @@ import Data.Tuple (Tuple(..), fst) import Partial.Unsafe (unsafePartial) -import Test.QuickCheck ((), quickCheck, quickCheck') +import Test.QuickCheck ((), quickCheck, quickCheck', (===)) import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) newtype TestStrMap v = TestStrMap (M.StrMap v) @@ -153,6 +153,13 @@ strMapTests = do log "fromFoldable = zip keys values" quickCheck $ \(TestStrMap m) -> M.toList m == zipWith Tuple (fromFoldable $ M.keys m) (M.values m :: List Int) + log "mapWithKey is correct" + quickCheck $ \(TestStrMap m :: TestStrMap Int) -> let + f k v = k <> show v + resultViaMapWithKey = m # M.mapWithKey f + resultViaLists = m # M.toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable + in resultViaMapWithKey === resultViaLists + log "Bug #63: accidental observable mutation in foldMap" quickCheck \(TestStrMap m) -> let lhs = go m From 389b7efe4a91f7ffd35d03815717bf03dbb8d35e Mon Sep 17 00:00:00 2001 From: aratama Date: Mon, 7 Nov 2016 09:58:48 +0900 Subject: [PATCH 076/125] fix toUnfoldable --- src/Data/Map.purs | 2 +- test/Test/Data/Map.purs | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index bf072a79..d0d08279 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -378,7 +378,7 @@ toUnfoldable = unfoldr go go :: Map k v -> Maybe (Tuple (Tuple k v) (Map k v)) go Leaf = Nothing go (Two left k v right) = Just $ Tuple (Tuple k v) (left <> right) - go (Three left k1 v1 mid k2 v2 right) = Just $ Tuple (Tuple k1 v1) (Two left k2 v2 right) + go (Three left k1 v1 mid k2 v2 right) = Just $ Tuple (Tuple k1 v1) (insert k2 v2 (left <> mid <> right)) -- | Get a list of the keys contained in a map keys :: forall k v. Map k v -> List k diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 3153d5fa..552d2e2d 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -202,6 +202,10 @@ mapTests = do quickCheck $ \(TestMap m) -> let f m' = M.fromFoldable (M.toList m') in M.toList (f m) == M.toList (m :: M.Map SmallKey Int) show m + log "fromFoldable . toUnfoldable = id" + quickCheck $ \(TestMap m) -> let f m' = M.fromFoldable (M.toUnfoldable m' :: List (Tuple SmallKey Int)) in + f m == (m :: M.Map SmallKey Int) show m + log "fromFoldableWith const = fromFoldable" quickCheck $ \arr -> M.fromFoldableWith const arr == M.fromFoldable (arr :: List (Tuple SmallKey Int)) show arr From 079c2fbfb58580ede30fd4ec13a07438173d03c7 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 15 Nov 2016 14:47:29 +0000 Subject: [PATCH 077/125] Update README.md --- README.md | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 169209dd..1c8d27c5 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,7 @@ # purescript-maps -[![Latest release](http://img.shields.io/bower/v/purescript-maps.svg)](https://github.com/purescript/purescript-maps/releases) -[![Build Status](https://travis-ci.org/purescript/purescript-maps.svg?branch=master)](https://travis-ci.org/purescript/purescript-maps) -[![Dependency Status](https://www.versioneye.com/user/projects/55848c1b363861001d000315/badge.svg?style=flat)](https://www.versioneye.com/user/projects/55848c1b363861001d000315) +[![Latest release](http://img.shields.io/github/release/purescript/purescript-maps.svg)](https://github.com/purescript/purescript-maps/releases) +[![Build status](https://travis-ci.org/purescript/purescript-maps.svg?branch=master)](https://travis-ci.org/purescript/purescript-maps) Purely-functional map data structures. From ba06addc892163861f71925c985e268eef9688e3 Mon Sep 17 00:00:00 2001 From: Sam Thomson Date: Sun, 20 Nov 2016 23:14:29 -0800 Subject: [PATCH 078/125] More efficient `toUnfoldable` without the `Ord` constraint Keep a List of Maps as the unfold state, instead of a single Map. Unioning Maps was linear time (making the entire function quadratic?). Prepending to a List is constant time and doesn't require an `Ord k` instance. --- src/Data/Map.purs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index d0d08279..f2a873db 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -372,13 +372,15 @@ toList (Two left k v right) = toList left <> Tuple k v : toList right toList (Three left k1 v1 mid k2 v2 right) = toList left <> Tuple k1 v1 : toList mid <> Tuple k2 v2 : toList right -- | Convert a map to an unfoldable structure of key/value pairs -toUnfoldable :: forall f k v. (Ord k, Unfoldable f) => Map k v -> f (Tuple k v) -toUnfoldable = unfoldr go - where - go :: Map k v -> Maybe (Tuple (Tuple k v) (Map k v)) - go Leaf = Nothing - go (Two left k v right) = Just $ Tuple (Tuple k v) (left <> right) - go (Three left k1 v1 mid k2 v2 right) = Just $ Tuple (Tuple k1 v1) (insert k2 v2 (left <> mid <> right)) +toUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) +toUnfoldable m = unfoldr go (m : Nil) where + go Nil = Nothing + go (hd : tl) = case hd of + Leaf -> go tl + Two left k v right -> + Just $ Tuple (Tuple k v) (left : right : tl) + Three left k1 v1 mid k2 v2 right -> + Just $ Tuple (Tuple k1 v1) ((singleton k2 v2) : left : mid : right : tl) -- | Get a list of the keys contained in a map keys :: forall k v. Map k v -> List k From 4900da6becb9fd4e1a7a4a473af655fcfd6ab85d Mon Sep 17 00:00:00 2001 From: joneshf Date: Wed, 7 Dec 2016 07:45:08 -0800 Subject: [PATCH 079/125] Don't use external API MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The original implementation was based on code use external to this module. Because of that, we had an additional constraint of `Ord k`—from `union`. However, we know the implementation in this module. So, we can use that knowledge to remove the `Ord k` constraint`. --- src/Data/Map.purs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index d0d08279..7ea8c4e8 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -77,8 +77,21 @@ instance foldableMap :: Foldable (Map k) where foldr f z m = foldr f z (values m) foldMap f m = foldMap f (values m) -instance traversableMap :: Ord k => Traversable (Map k) where - traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toList ms)) +instance traversableMap :: Traversable (Map k) where + traverse f Leaf = pure Leaf + traverse f (Two left k v right) = + Two <$> traverse f left + <*> pure k + <*> f v + <*> traverse f right + traverse f (Three left k1 v1 mid k2 v2 right) = + Three <$> traverse f left + <*> pure k1 + <*> f v1 + <*> traverse f mid + <*> pure k2 + <*> f v2 + <*> traverse f right sequence = traverse id -- | Render a `Map` as a `String` From e5331b2ad9b7bc5b3c2e196321ad42da73866212 Mon Sep 17 00:00:00 2001 From: joneshf Date: Wed, 7 Dec 2016 07:48:57 -0800 Subject: [PATCH 080/125] Remove unnecessary import --- src/Data/Map.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 7ea8c4e8..9c332ca2 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -41,7 +41,7 @@ import Data.List (List(..), (:), length, nub) import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) import Data.Monoid (class Monoid) import Data.Traversable (traverse, class Traversable) -import Data.Tuple (Tuple(..), uncurry, snd) +import Data.Tuple (Tuple(Tuple), snd) import Data.Unfoldable (class Unfoldable, unfoldr) import Partial.Unsafe (unsafePartial) From 2fa4b8bdb9133b4c5a38f9d2f447dbd0aab53284 Mon Sep 17 00:00:00 2001 From: Sam Thomson Date: Wed, 7 Dec 2016 20:10:44 -0800 Subject: [PATCH 081/125] style fix suggested by hdgarrood --- src/Data/Map.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index f2a873db..24da6c14 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -380,7 +380,7 @@ toUnfoldable m = unfoldr go (m : Nil) where Two left k v right -> Just $ Tuple (Tuple k v) (left : right : tl) Three left k1 v1 mid k2 v2 right -> - Just $ Tuple (Tuple k1 v1) ((singleton k2 v2) : left : mid : right : tl) + Just $ Tuple (Tuple k1 v1) (singleton k2 v2 : left : mid : right : tl) -- | Get a list of the keys contained in a map keys :: forall k v. Map k v -> List k From 8185cf789260bc22dd747be78fc3c3a12d781e7f Mon Sep 17 00:00:00 2001 From: Joshua Horowitz Date: Wed, 18 Jan 2017 23:10:52 -0800 Subject: [PATCH 082/125] Added toAscList as synonym of current toList --- src/Data/Map.purs | 5 +++++ test/Test/Data/Map.purs | 6 ++++++ 2 files changed, 11 insertions(+) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 534c8ba6..6553667d 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -19,6 +19,7 @@ module Data.Map , fromFoldable , fromFoldableWith , toList + , toAscList , toUnfoldable , delete , pop @@ -384,6 +385,10 @@ toList Leaf = Nil toList (Two left k v right) = toList left <> Tuple k v : toList right toList (Three left k1 v1 mid k2 v2 right) = toList left <> Tuple k1 v1 : toList mid <> Tuple k2 v2 : toList right +-- | Convert a map to a list of key/value pairs where the keys are in ascending order +toAscList :: forall k v. Map k v -> List (Tuple k v) +toAscList = toList + -- | Convert a map to an unfoldable structure of key/value pairs toUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) toUnfoldable m = unfoldr go (m : Nil) where diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 552d2e2d..279dd5fc 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -218,6 +218,12 @@ mapTests = do groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in M.fromFoldableWith (<>) arr === f (arr :: List (Tuple String String)) + log "toAscList is sorted version of toList" + quickCheck $ \(TestMap m) -> + let list = M.toList (m :: M.Map SmallKey Int) + ascList = M.toAscList m + in ascList === sortBy (compare `on` fst) list + log "Lookup from union" quickCheck $ \(TestMap m1) (TestMap m2) k -> M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of From 7a6cd515e01e2eb25f52d1ffaeccb7a367599e04 Mon Sep 17 00:00:00 2001 From: Joshua Horowitz Date: Thu, 19 Jan 2017 12:24:39 -0800 Subject: [PATCH 083/125] Switched Eq, Ord, and Show instances to use toAscList --- src/Data/Map.purs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 6553667d..08b1bfb2 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -54,13 +54,13 @@ data Map k v | Three (Map k v) k v (Map k v) k v (Map k v) instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where - eq m1 m2 = toList m1 == toList m2 + eq m1 m2 = toAscList m1 == toAscList m2 instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where - compare m1 m2 = compare (toList m1) (toList m2) + compare m1 m2 = compare (toAscList m1) (toAscList m2) instance showMap :: (Show k, Show v) => Show (Map k v) where - show m = "(fromList " <> show (toList m) <> ")" + show m = "(fromList " <> show (toAscList m) <> ")" instance semigroupMap :: Ord k => Semigroup (Map k v) where append = union From 6620634891edd6791aff4aea130181b0a640a9a9 Mon Sep 17 00:00:00 2001 From: Joshua Horowitz Date: Thu, 19 Jan 2017 15:38:04 -0800 Subject: [PATCH 084/125] Added toAscUnfoldable in place of toAscList --- src/Data/Map.purs | 37 ++++++++++++++++++++++++------------- test/Test/Data/Map.purs | 39 ++++++++++++++++++++------------------- 2 files changed, 44 insertions(+), 32 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 08b1bfb2..ff72ffe8 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -19,8 +19,8 @@ module Data.Map , fromFoldable , fromFoldableWith , toList - , toAscList , toUnfoldable + , toAscUnfoldable , delete , pop , member @@ -36,7 +36,6 @@ module Data.Map ) where import Prelude - import Data.Foldable (foldl, foldMap, foldr, class Foldable) import Data.List (List(..), (:), length, nub) import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) @@ -44,7 +43,6 @@ import Data.Monoid (class Monoid) import Data.Traversable (traverse, class Traversable) import Data.Tuple (Tuple(Tuple), snd) import Data.Unfoldable (class Unfoldable, unfoldr) - import Partial.Unsafe (unsafePartial) -- | `Map k v` represents maps from keys of type `k` to values of type `v`. @@ -53,14 +51,18 @@ data Map k v | Two (Map k v) k v (Map k v) | Three (Map k v) k v (Map k v) k v (Map k v) +-- Internal use +toAscArray :: forall k v. Map k v -> Array (Tuple k v) +toAscArray = toAscUnfoldable + instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where - eq m1 m2 = toAscList m1 == toAscList m2 + eq m1 m2 = toAscArray m1 == toAscArray m2 instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where - compare m1 m2 = compare (toAscList m1) (toAscList m2) + compare m1 m2 = compare (toAscArray m1) (toAscArray m2) instance showMap :: (Show k, Show v) => Show (Map k v) where - show m = "(fromList " <> show (toAscList m) <> ")" + show m = "(fromFoldable " <> show (toAscArray m) <> ")" instance semigroupMap :: Ord k => Semigroup (Map k v) where append = union @@ -381,13 +383,7 @@ fromFoldableWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where -- | Convert a map to a list of key/value pairs toList :: forall k v. Map k v -> List (Tuple k v) -toList Leaf = Nil -toList (Two left k v right) = toList left <> Tuple k v : toList right -toList (Three left k1 v1 mid k2 v2 right) = toList left <> Tuple k1 v1 : toList mid <> Tuple k2 v2 : toList right - --- | Convert a map to a list of key/value pairs where the keys are in ascending order -toAscList :: forall k v. Map k v -> List (Tuple k v) -toAscList = toList +toList = toUnfoldable -- | Convert a map to an unfoldable structure of key/value pairs toUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) @@ -400,6 +396,21 @@ toUnfoldable m = unfoldr go (m : Nil) where Three left k1 v1 mid k2 v2 right -> Just $ Tuple (Tuple k1 v1) (singleton k2 v2 : left : mid : right : tl) +-- | Convert a map to an unfoldable structure of key/value pairs where the keys are in ascending order +toAscUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) +toAscUnfoldable m = unfoldr go (m : Nil) where + go Nil = Nothing + go (hd : tl) = case hd of + Leaf -> go tl + Two Leaf k v Leaf -> + Just $ Tuple (Tuple k v) tl + Two Leaf k v right -> + Just $ Tuple (Tuple k v) (right : tl) + Two left k v right -> + go $ left : singleton k v : right : tl + Three left k1 v1 mid k2 v2 right -> + go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl + -- | Get a list of the keys contained in a map keys :: forall k v. Map k v -> List k keys Leaf = Nil diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 279dd5fc..0de2e063 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -1,23 +1,19 @@ module Test.Data.Map where import Prelude - +import Data.List.NonEmpty as NEL +import Data.Map as M import Control.Alt ((<|>)) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) - import Data.Foldable (foldl, for_, all) import Data.Function (on) -import Data.List (List(..), groupBy, length, nubBy, sortBy, singleton) -import Data.List.NonEmpty as NEL -import Data.Map as M +import Data.List (List(Cons), groupBy, length, nubBy, singleton, sort, sortBy) import Data.Maybe (Maybe(..), fromMaybe) import Data.Tuple (Tuple(..), fst) - import Partial.Unsafe (unsafePartial) - import Test.QuickCheck ((), (===), quickCheck, quickCheck') import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) @@ -194,21 +190,26 @@ mapTests = do quickCheck (M.lookup 1 nums == Just 2 "invalid lookup - 1") quickCheck (M.lookup 2 nums == Nothing "invalid lookup - 2") - log "toList . fromFoldable = id" - quickCheck $ \arr -> let f x = M.toList (M.fromFoldable x) - in f (f arr) == f (arr :: List (Tuple SmallKey Int)) show arr + log "sort . toList . fromFoldable = sort (on lists without key-duplicates)" + quickCheck $ \(list :: List (Tuple SmallKey Int)) -> + let nubbedList = nubBy ((==) `on` fst) list + f x = M.toList (M.fromFoldable x) + in sort (f nubbedList) == sort nubbedList show nubbedList log "fromFoldable . toList = id" - quickCheck $ \(TestMap m) -> let f m' = M.fromFoldable (M.toList m') in - M.toList (f m) == M.toList (m :: M.Map SmallKey Int) show m + quickCheck $ \(TestMap (m :: M.Map SmallKey Int)) -> + let f m' = M.fromFoldable (M.toList m') + in f m == m show m log "fromFoldable . toUnfoldable = id" - quickCheck $ \(TestMap m) -> let f m' = M.fromFoldable (M.toUnfoldable m' :: List (Tuple SmallKey Int)) in - f m == (m :: M.Map SmallKey Int) show m + quickCheck $ \(TestMap (m :: M.Map SmallKey Int)) -> + let f m' = M.fromFoldable (M.toUnfoldable m' :: List (Tuple SmallKey Int)) + in f m == m show m log "fromFoldableWith const = fromFoldable" - quickCheck $ \arr -> M.fromFoldableWith const arr == - M.fromFoldable (arr :: List (Tuple SmallKey Int)) show arr + quickCheck $ \arr -> + M.fromFoldableWith const arr == + M.fromFoldable (arr :: List (Tuple SmallKey Int)) show arr log "fromFoldableWith (<>) = fromFoldable . collapse with (<>) . group on fst" quickCheck $ \arr -> @@ -218,10 +219,10 @@ mapTests = do groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in M.fromFoldableWith (<>) arr === f (arr :: List (Tuple String String)) - log "toAscList is sorted version of toList" + log "toAscUnfoldable is sorted version of toUnfoldable" quickCheck $ \(TestMap m) -> - let list = M.toList (m :: M.Map SmallKey Int) - ascList = M.toAscList m + let list = M.toUnfoldable (m :: M.Map SmallKey Int) + ascList = M.toAscUnfoldable m in ascList === sortBy (compare `on` fst) list log "Lookup from union" From e3d0ddbc46db89b1c8363a245ef24f17470bc013 Mon Sep 17 00:00:00 2001 From: Joshua Horowitz Date: Fri, 20 Jan 2017 16:49:02 -0800 Subject: [PATCH 085/125] Changes per @hdgarrood's comments --- src/Data/Map.purs | 5 +++-- test/Test/Data/Map.purs | 14 +++++--------- 2 files changed, 8 insertions(+), 11 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index ff72ffe8..09067fae 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -381,9 +381,10 @@ fromFoldableWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where combine v (Just v') = Just $ f v v' combine v Nothing = Just v --- | Convert a map to a list of key/value pairs +-- | Convert a map to a list of key/value pairs. +-- | DEPRECATED: use toUnfoldable or toAscUnfoldable instead. toList :: forall k v. Map k v -> List (Tuple k v) -toList = toUnfoldable +toList = toAscUnfoldable -- | Convert a map to an unfoldable structure of key/value pairs toUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 0de2e063..737b19fe 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -166,7 +166,7 @@ mapTests = do in M.lookup k tree == Just v ("instrs:\n " <> show instrs <> "\nk:\n " <> show k <> "\nv:\n " <> show v) log "Singleton to list" - quickCheck $ \k v -> M.toList (M.singleton k v :: M.Map SmallKey Int) == singleton (Tuple k v) + quickCheck $ \k v -> M.toUnfoldable (M.singleton k v :: M.Map SmallKey Int) == singleton (Tuple k v) log "fromFoldable [] = empty" quickCheck (M.fromFoldable [] == (M.empty :: M.Map Unit Unit) @@ -190,17 +190,12 @@ mapTests = do quickCheck (M.lookup 1 nums == Just 2 "invalid lookup - 1") quickCheck (M.lookup 2 nums == Nothing "invalid lookup - 2") - log "sort . toList . fromFoldable = sort (on lists without key-duplicates)" + log "sort . toUnfoldable . fromFoldable = sort (on lists without key-duplicates)" quickCheck $ \(list :: List (Tuple SmallKey Int)) -> let nubbedList = nubBy ((==) `on` fst) list - f x = M.toList (M.fromFoldable x) + f x = M.toUnfoldable (M.fromFoldable x) in sort (f nubbedList) == sort nubbedList show nubbedList - log "fromFoldable . toList = id" - quickCheck $ \(TestMap (m :: M.Map SmallKey Int)) -> - let f m' = M.fromFoldable (M.toList m') - in f m == m show m - log "fromFoldable . toUnfoldable = id" quickCheck $ \(TestMap (m :: M.Map SmallKey Int)) -> let f m' = M.fromFoldable (M.toUnfoldable m' :: List (Tuple SmallKey Int)) @@ -317,5 +312,6 @@ mapTests = do quickCheck $ \(TestMap m :: TestMap String Int) -> let f k v = k <> show v resultViaMapWithKey = m # M.mapWithKey f - resultViaLists = m # M.toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable + toList = M.toUnfoldable :: forall k v. M.Map k v -> List (Tuple k v) + resultViaLists = m # toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable in resultViaMapWithKey === resultViaLists From e08029b0171d97e4141f72a89ee909b6e7ddb97b Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sat, 21 Jan 2017 14:01:10 +0000 Subject: [PATCH 086/125] v2.1.0 From 1e2a248b8a8ac060174fa58c3b6f120969894b5d Mon Sep 17 00:00:00 2001 From: rightfold Date: Wed, 25 Jan 2017 11:17:36 +0100 Subject: [PATCH 087/125] Fix hasOwnProperty bug again and forever --- src/Data/StrMap.js | 18 +++++++++--------- test/Test/Data/StrMap.purs | 3 ++- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index 2213c184..c3a27169 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -6,7 +6,7 @@ exports._copy = function (m) { var r = {}; for (var k in m) { - if (m.hasOwnProperty(k)) { + if ({}.hasOwnProperty.call(m, k)) { r[k] = m[k]; } } @@ -17,7 +17,7 @@ exports._copyEff = function (m) { return function () { var r = {}; for (var k in m) { - if (m.hasOwnProperty(k)) { + if ({}.hasOwnProperty.call(m, k)) { r[k] = m[k]; } } @@ -35,7 +35,7 @@ exports.runST = function (f) { exports._fmapStrMap = function (m0, f) { var m = {}; for (var k in m0) { - if (m0.hasOwnProperty(k)) { + if ({}.hasOwnProperty.call(m0, k)) { m[k] = f(m0[k]); } } @@ -46,7 +46,7 @@ exports._fmapStrMap = function (m0, f) { exports._mapWithKey = function (m0, f) { var m = {}; for (var k in m0) { - if (m0.hasOwnProperty(k)) { + if ({}.hasOwnProperty.call(m0, k)) { m[k] = f(k)(m0[k]); } } @@ -65,7 +65,7 @@ exports._foldM = function (bind) { }; } for (var k in m) { - if (m.hasOwnProperty(k)) { + if ({}.hasOwnProperty.call(m, k)) { acc = bind(acc)(g(k)); } } @@ -78,7 +78,7 @@ exports._foldM = function (bind) { // jshint maxparams: 4 exports._foldSCStrMap = function (m, z, f, fromMaybe) { for (var k in m) { - if (m.hasOwnProperty(k)) { + if ({}.hasOwnProperty.call(m, k)) { var maybeR = f(z)(k)(m[k]); var r = fromMaybe(null)(maybeR); if (r === null) return z; @@ -92,7 +92,7 @@ exports._foldSCStrMap = function (m, z, f, fromMaybe) { exports.all = function (f) { return function (m) { for (var k in m) { - if (m.hasOwnProperty(k) && !f(k)(m[k])) return false; + if ({}.hasOwnProperty.call(m, k) && !f(k)(m[k])) return false; } return true; }; @@ -101,7 +101,7 @@ exports.all = function (f) { exports.size = function (m) { var s = 0; for (var k in m) { - if (m.hasOwnProperty(k)) { + if ({}.hasOwnProperty.call(m, k)) { ++s; } } @@ -130,7 +130,7 @@ function _collect(f) { return function (m) { var r = []; for (var k in m) { - if (m.hasOwnProperty(k)) { + if ({}.hasOwnProperty.call(m, k)) { r.push(f(k)(m[k])); } } diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 33acb595..303971d2 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -34,7 +34,8 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where arbitrary = do b <- arbitrary - k <- arbitrary + kIshasOwnProperty <- (&&) <$> arbitrary <*> arbitrary + k <- if kIshasOwnProperty then pure "hasOwnProperty" else arbitrary case b of true -> do v <- arbitrary From 4c5c4a1481977b614283710f8ae7a3526ea64e52 Mon Sep 17 00:00:00 2001 From: rightfold Date: Wed, 25 Jan 2017 13:13:45 +0100 Subject: [PATCH 088/125] Cache {}.hasOwnProperty --- src/Data/StrMap.js | 26 ++++++++------------------ src/Data/StrMap.purs | 2 -- 2 files changed, 8 insertions(+), 20 deletions(-) diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index c3a27169..0b1255a8 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -3,21 +3,11 @@ // module Data.StrMap -exports._copy = function (m) { - var r = {}; - for (var k in m) { - if ({}.hasOwnProperty.call(m, k)) { - r[k] = m[k]; - } - } - return r; -}; - exports._copyEff = function (m) { return function () { var r = {}; for (var k in m) { - if ({}.hasOwnProperty.call(m, k)) { + if (hasOwnProperty.call(m, k)) { r[k] = m[k]; } } @@ -35,7 +25,7 @@ exports.runST = function (f) { exports._fmapStrMap = function (m0, f) { var m = {}; for (var k in m0) { - if ({}.hasOwnProperty.call(m0, k)) { + if (hasOwnProperty.call(m0, k)) { m[k] = f(m0[k]); } } @@ -46,7 +36,7 @@ exports._fmapStrMap = function (m0, f) { exports._mapWithKey = function (m0, f) { var m = {}; for (var k in m0) { - if ({}.hasOwnProperty.call(m0, k)) { + if (hasOwnProperty.call(m0, k)) { m[k] = f(k)(m0[k]); } } @@ -65,7 +55,7 @@ exports._foldM = function (bind) { }; } for (var k in m) { - if ({}.hasOwnProperty.call(m, k)) { + if (hasOwnProperty.call(m, k)) { acc = bind(acc)(g(k)); } } @@ -78,7 +68,7 @@ exports._foldM = function (bind) { // jshint maxparams: 4 exports._foldSCStrMap = function (m, z, f, fromMaybe) { for (var k in m) { - if ({}.hasOwnProperty.call(m, k)) { + if (hasOwnProperty.call(m, k)) { var maybeR = f(z)(k)(m[k]); var r = fromMaybe(null)(maybeR); if (r === null) return z; @@ -92,7 +82,7 @@ exports._foldSCStrMap = function (m, z, f, fromMaybe) { exports.all = function (f) { return function (m) { for (var k in m) { - if ({}.hasOwnProperty.call(m, k) && !f(k)(m[k])) return false; + if (hasOwnProperty.call(m, k) && !f(k)(m[k])) return false; } return true; }; @@ -101,7 +91,7 @@ exports.all = function (f) { exports.size = function (m) { var s = 0; for (var k in m) { - if ({}.hasOwnProperty.call(m, k)) { + if (hasOwnProperty.call(m, k)) { ++s; } } @@ -130,7 +120,7 @@ function _collect(f) { return function (m) { var r = []; for (var k in m) { - if ({}.hasOwnProperty.call(m, k)) { + if (hasOwnProperty.call(m, k)) { r.push(f(k)(m[k])); } } diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index c47ceef7..5f2c9dae 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -56,8 +56,6 @@ import Data.Unfoldable (class Unfoldable) -- | `StrMap a` represents a map from `String`s to values of type `a`. foreign import data StrMap :: * -> * -foreign import _copy :: forall a. StrMap a -> StrMap a - foreign import _copyEff :: forall a b h r. a -> Eff (st :: ST.ST h | r) b -- | Convert an immutable map into a mutable map From 3379032f380a47ad2e463f8c385e5c1495002707 Mon Sep 17 00:00:00 2001 From: rightfold Date: Wed, 25 Jan 2017 17:53:28 +0100 Subject: [PATCH 089/125] Use frequency instead of random Boolean --- test/Test/Data/StrMap.purs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 303971d2..6eaab4db 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -19,6 +19,7 @@ import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((), quickCheck, quickCheck', (===)) import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) +import Test.QuickCheck.Gen as Gen newtype TestStrMap v = TestStrMap (M.StrMap v) @@ -34,8 +35,8 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where arbitrary = do b <- arbitrary - kIshasOwnProperty <- (&&) <$> arbitrary <*> arbitrary - k <- if kIshasOwnProperty then pure "hasOwnProperty" else arbitrary + k <- Gen.frequency (Tuple 10.0 (pure "hasOwnProperty")) + (Tuple 50.0 arbitrary `Cons` Nil) case b of true -> do v <- arbitrary From b8a999d1d4f5124791d988bc311973fa2b4e5866 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 13 Feb 2017 03:09:37 +0000 Subject: [PATCH 090/125] clarify insertion behavior in docs and tests Make it clear to library users that the insert function replaces the value assigned to an existing key. --- src/Data/Map.purs | 2 +- src/Data/StrMap.purs | 2 +- test/Test/Data/Map.purs | 4 ++++ test/Test/Data/StrMap.purs | 3 +++ 4 files changed, 9 insertions(+), 2 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 09067fae..039d8a2a 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -246,7 +246,7 @@ fromZipper (Cons x ctx) tree = data KickUp k v = KickUp (Map k v) k v (Map k v) --- | Insert a key/value pair into a map +-- | Insert or replace a key/value pair in a map insert :: forall k v. Ord k => k -> v -> Map k v -> Map k v insert = down Nil where diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 5f2c9dae..08b04fd7 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -164,7 +164,7 @@ lookup = runFn4 _lookup Nothing Just member :: forall a. String -> StrMap a -> Boolean member = runFn4 _lookup false (const true) --- | Insert a key and value into a map +-- | Insert or replace a key/value pair in a map insert :: forall a. String -> a -> StrMap a -> StrMap a insert k v = mutate (\s -> SM.poke s k v) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 737b19fe..207712cf 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -121,6 +121,10 @@ mapTests = do quickCheck $ \k v -> M.lookup (smallKey k) (M.insert k v M.empty) == Just (number v) ("k: " <> show k <> ", v: " <> show v) + log "Test inserting two values with same key" + quickCheck $ \k v1 v2 -> + M.lookup (smallKey k) (M.insert k v2 (M.insert k v1 M.empty)) == Just (number v2) + log "Test delete after inserting" quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) ("k: " <> show k <> ", v: " <> show v) diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 6eaab4db..a2f4e098 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -59,6 +59,9 @@ strMapTests = do quickCheck $ \k v -> M.lookup k (M.insert k v M.empty) == Just (number v) ("k: " <> show k <> ", v: " <> show v) + quickCheck $ \k v1 v2 -> + M.lookup (smallKey k) (M.insert k v2 (M.insert k v1 M.empty)) == Just (number v2) + log "Test delete after inserting" quickCheck $ \k v -> M.isEmpty (M.delete k (M.insert k (number v) M.empty)) ("k: " <> show k <> ", v: " <> show v) From 8b6c0dc5b5b7bdab0888757b2811a2e15816b521 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 13 Feb 2017 03:20:15 +0000 Subject: [PATCH 091/125] document new StrMap test --- test/Test/Data/StrMap.purs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index a2f4e098..ef299847 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -59,8 +59,9 @@ strMapTests = do quickCheck $ \k v -> M.lookup k (M.insert k v M.empty) == Just (number v) ("k: " <> show k <> ", v: " <> show v) + log "Test inserting two values with same key" quickCheck $ \k v1 v2 -> - M.lookup (smallKey k) (M.insert k v2 (M.insert k v1 M.empty)) == Just (number v2) + M.lookup k (M.insert k v2 (M.insert k v1 M.empty)) == Just (number v2) log "Test delete after inserting" quickCheck $ \k v -> M.isEmpty (M.delete k (M.insert k (number v) M.empty)) From 957b0738462f2edbd54ecaccdc62a4d999a45bdb Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 13 Feb 2017 22:35:52 +0000 Subject: [PATCH 092/125] use derived instances in tests --- test/Test/Data/Map.purs | 30 ++---------------------------- 1 file changed, 2 insertions(+), 28 deletions(-) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 737b19fe..6ad9ad9b 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -23,6 +23,8 @@ instance arbTestMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Tes arbitrary = TestMap <<< (M.fromFoldable :: List (Tuple k v) -> M.Map k v) <$> arbitrary data SmallKey = A | B | C | D | E | F | G | H | I | J +derive instance eqSmallKey :: Eq SmallKey +derive instance ordSmallKey :: Ord SmallKey instance showSmallKey :: Show SmallKey where show A = "A" @@ -36,34 +38,6 @@ instance showSmallKey :: Show SmallKey where show I = "I" show J = "J" -instance eqSmallKey :: Eq SmallKey where - eq A A = true - eq B B = true - eq C C = true - eq D D = true - eq E E = true - eq F F = true - eq G G = true - eq H H = true - eq I I = true - eq J J = true - eq _ _ = false - -smallKeyToInt :: SmallKey -> Int -smallKeyToInt A = 0 -smallKeyToInt B = 1 -smallKeyToInt C = 2 -smallKeyToInt D = 3 -smallKeyToInt E = 4 -smallKeyToInt F = 5 -smallKeyToInt G = 6 -smallKeyToInt H = 7 -smallKeyToInt I = 8 -smallKeyToInt J = 9 - -instance ordSmallKey :: Ord SmallKey where - compare = compare `on` smallKeyToInt - instance arbSmallKey :: Arbitrary SmallKey where arbitrary = do n <- arbitrary From 771c5dce665b5aa8c8f92354fb98f4d94eea7138 Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Wed, 15 Feb 2017 01:59:17 +0100 Subject: [PATCH 093/125] Avoid Discard constraint --- src/Data/StrMap.purs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 5f2c9dae..24348d9a 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -76,10 +76,10 @@ pureST :: forall a. (forall h e. Eff (st :: ST.ST h | e) (SM.STStrMap h a)) -> S 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 +mutate f m = pureST do s <- thawST m - f s - pure s) + _ <- f s + pure s foreign import _fmapStrMap :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b) @@ -149,10 +149,10 @@ foreign import size :: forall a. StrMap a -> Number -- | Create a map with one key/value pair singleton :: forall a. String -> a -> StrMap a -singleton k v = pureST (do +singleton k v = pureST do s <- SM.new - SM.poke s k v - pure s) + _ <- SM.poke s k v + pure s foreign import _lookup :: forall a z. Fn4 z (a -> z) String (StrMap a) z @@ -166,13 +166,13 @@ member = runFn4 _lookup false (const true) -- | Insert a key and value into a map insert :: forall a. String -> a -> StrMap a -> StrMap a -insert k v = mutate (\s -> SM.poke s k v) +insert k v = mutate (\s -> void $ SM.poke s k v) foreign import _unsafeDeleteStrMap :: forall a. Fn2 (StrMap a) String (StrMap a) -- | Delete a key and value from a map delete :: forall a. String -> StrMap a -> StrMap a -delete k = mutate (\s -> SM.delete s k) +delete k = mutate (\s -> void $ SM.delete s k) -- | Delete a key and value from a map, returning the value -- | as well as the subsequent map @@ -225,7 +225,7 @@ values = L.fromFoldable <<< _collect (\_ v -> v) -- | Compute the union of two maps, preferring the first map in the case of -- | duplicate keys. union :: forall a. StrMap a -> StrMap a -> StrMap a -union m = mutate (\s -> foldM SM.poke s m) +union m = mutate (\s -> void $ foldM SM.poke s m) -- | Compute the union of a collection of maps unions :: forall a. L.List (StrMap a) -> StrMap a @@ -238,7 +238,7 @@ mapWithKey :: forall a b. (String -> a -> b) -> StrMap a -> StrMap b mapWithKey f m = runFn2 _mapWithKey m f instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) where - append m1 m2 = mutate (\s1 -> foldM (\s2 k v2 -> SM.poke s2 k (runFn4 _lookup v2 (\v1 -> v1 <> v2) k m2)) s1 m1) m2 + append m1 m2 = mutate (\s1 -> void $ foldM (\s2 k v2 -> SM.poke s2 k (runFn4 _lookup v2 (\v1 -> v1 <> v2) k m2)) s1 m1) m2 instance monoidStrMap :: (Semigroup a) => Monoid (StrMap a) where mempty = empty From b91dd5c0643b081aa58f98d8f7061e3609a9100c Mon Sep 17 00:00:00 2001 From: rightfold Date: Wed, 15 Feb 2017 12:54:20 +0100 Subject: [PATCH 094/125] Make StrMap.size return an integer instead of a float --- src/Data/StrMap.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 24348d9a..16e7bb7f 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -145,7 +145,7 @@ isEmpty :: forall a. StrMap a -> Boolean isEmpty = all (\_ _ -> false) -- | Calculate the number of key/value pairs in a map -foreign import size :: forall a. StrMap a -> Number +foreign import size :: forall a. StrMap a -> Int -- | Create a map with one key/value pair singleton :: forall a. String -> a -> StrMap a From 4d4cac185c13c3331119c98b5d3c4cffef028f1e Mon Sep 17 00:00:00 2001 From: rightfold Date: Fri, 24 Mar 2017 00:00:57 +0100 Subject: [PATCH 095/125] Generalize StrMap.unions to Foldable --- src/Data/StrMap.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 24348d9a..0118eb7c 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -228,7 +228,7 @@ union :: forall a. StrMap a -> StrMap a -> StrMap a union m = mutate (\s -> void $ foldM SM.poke s m) -- | Compute the union of a collection of maps -unions :: forall a. L.List (StrMap a) -> StrMap a +unions :: forall f a. Foldable f => f (StrMap a) -> StrMap a unions = foldl union empty foreign import _mapWithKey :: forall a b. Fn2 (StrMap a) (String -> a -> b) (StrMap b) From c56d09b61385efc1ec62319cf152c66dc901fdda Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sun, 12 Mar 2017 23:51:12 +0000 Subject: [PATCH 096/125] Update for PureScript 0.11 --- .eslintrc.json | 28 ++++++++++++++++++++++++++++ .gitignore | 3 +-- .jscsrc | 17 ----------------- .jshintrc | 20 -------------------- .travis.yml | 2 +- bower.json | 10 +++++----- package.json | 13 ++++++------- src/Data/Map.purs | 24 +++++++++--------------- src/Data/StrMap.js | 20 +++++--------------- src/Data/StrMap.purs | 10 +++++----- src/Data/StrMap/ST.js | 3 --- src/Data/StrMap/ST.purs | 2 +- src/Data/StrMap/ST/Unsafe.js | 3 --- src/Data/StrMap/Unsafe.js | 3 --- test/Test/Data/Map.purs | 4 ++-- test/Test/Data/StrMap.purs | 6 +++--- test/Test/Main.purs | 2 +- 17 files changed, 67 insertions(+), 103 deletions(-) create mode 100644 .eslintrc.json delete mode 100644 .jscsrc delete mode 100644 .jshintrc diff --git a/.eslintrc.json b/.eslintrc.json new file mode 100644 index 00000000..84cef4f0 --- /dev/null +++ b/.eslintrc.json @@ -0,0 +1,28 @@ +{ + "parserOptions": { + "ecmaVersion": 5 + }, + "extends": "eslint:recommended", + "env": { + "commonjs": true + }, + "rules": { + "strict": [2, "global"], + "block-scoped-var": 2, + "consistent-return": 2, + "eqeqeq": [2, "smart"], + "guard-for-in": 2, + "no-caller": 2, + "no-extend-native": 2, + "no-loop-func": 2, + "no-new": 2, + "no-param-reassign": 2, + "no-return-assign": 2, + "no-unused-expressions": 2, + "no-use-before-define": 2, + "radix": [2, "always"], + "indent": [2, 2], + "quotes": [2, "double"], + "semi": [2, "always"] + } +} diff --git a/.gitignore b/.gitignore index e306283b..7050558b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,6 @@ /.* !/.gitignore -!/.jscsrc -!/.jshintrc +!/.eslintrc.json !/.travis.yml /bower_components/ /node_modules/ diff --git a/.jscsrc b/.jscsrc deleted file mode 100644 index 2561ce9e..00000000 --- a/.jscsrc +++ /dev/null @@ -1,17 +0,0 @@ -{ - "preset": "grunt", - "disallowSpacesInFunctionExpression": null, - "requireSpacesInFunctionExpression": { - "beforeOpeningRoundBrace": true, - "beforeOpeningCurlyBrace": true - }, - "disallowSpacesInAnonymousFunctionExpression": null, - "requireSpacesInAnonymousFunctionExpression": { - "beforeOpeningRoundBrace": true, - "beforeOpeningCurlyBrace": true - }, - "disallowSpacesInsideObjectBrackets": null, - "requireSpacesInsideObjectBrackets": "all", - "validateQuoteMarks": "\"", - "requireCurlyBraces": null -} diff --git a/.jshintrc b/.jshintrc deleted file mode 100644 index 620d8d7f..00000000 --- a/.jshintrc +++ /dev/null @@ -1,20 +0,0 @@ -{ - "bitwise": true, - "eqeqeq": true, - "forin": true, - "freeze": true, - "funcscope": true, - "futurehostile": true, - "strict": "global", - "latedef": true, - "maxparams": 1, - "noarg": true, - "nocomma": true, - "nonew": true, - "notypeof": true, - "singleGroups": true, - "undef": true, - "unused": true, - "eqnull": true, - "predef": ["exports"] -} diff --git a/.travis.yml b/.travis.yml index 34553056..4cbd5fde 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,7 +1,7 @@ language: node_js dist: trusty sudo: required -node_js: 6 +node_js: stable env: - PATH=$HOME/purescript:$PATH install: diff --git a/bower.json b/bower.json index 476e5dc5..4527f5a7 100644 --- a/bower.json +++ b/bower.json @@ -21,12 +21,12 @@ "package.json" ], "dependencies": { - "purescript-arrays": "^3.0.0", - "purescript-functions": "^2.0.0", - "purescript-lists": "^3.0.0", - "purescript-st": "^2.0.0" + "purescript-arrays": "^4.0.0", + "purescript-functions": "^3.0.0", + "purescript-lists": "^4.0.0", + "purescript-st": "^3.0.0" }, "devDependencies": { - "purescript-quickcheck": "^3.0.0" + "purescript-quickcheck": "^4.0.0" } } diff --git a/package.json b/package.json index 46e9a546..132cefcd 100644 --- a/package.json +++ b/package.json @@ -2,14 +2,13 @@ "private": true, "scripts": { "clean": "rimraf output && rimraf .pulp-cache", - "build": "jshint src && jscs src && psa \"src/**/*.purs\" \"bower_components/purescript-*/src/**/*.purs\" --censor-lib --strict", - "test": "psc \"src/**/*.purs\" \"bower_components/purescript-*/src/**/*.purs\" \"test/**/*.purs\" && psc-bundle \"output/**/*.js\" --module Test.Main --main Test.Main | node" + "build": "eslint src && pulp build -- --censor-lib --strict", + "test": "pulp test" }, "devDependencies": { - "jscs": "^2.8.0", - "jshint": "^2.9.1", - "pulp": "^8.2.0", - "purescript-psa": "^0.3.8", - "rimraf": "^2.5.0" + "eslint": "^3.17.1", + "pulp": "^10.0.4", + "purescript-psa": "^0.5.0-rc.1", + "rimraf": "^2.6.1" } } diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 09067fae..e6f91c68 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -18,7 +18,6 @@ module Data.Map , findMax , fromFoldable , fromFoldableWith - , toList , toUnfoldable , toAscUnfoldable , delete @@ -98,7 +97,7 @@ instance traversableMap :: Traversable (Map k) where sequence = traverse id -- | Render a `Map` as a `String` -showTree :: forall k v. (Show k, Show v) => Map k v -> String +showTree :: forall k v. Show k => Show v => Map k v -> String showTree Leaf = "Leaf" showTree (Two left k v right) = "Two (" <> showTree left <> @@ -164,7 +163,7 @@ lookup = unsafePartial \k tree -> -- | Lookup a value for the specified key, or the greatest one less than it -lookupLE :: forall k v. (Ord k) => k -> Map k v -> Maybe { key :: k, value :: v } +lookupLE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } lookupLE _ Leaf = Nothing lookupLE k (Two left k1 v1 right) = case compare k k1 of EQ -> Just { key: k1, value: v1 } @@ -176,7 +175,7 @@ lookupLE k (Three left k1 v1 mid k2 v2 right) = case compare k k2 of LT -> lookupLE k $ Two left k1 v1 mid -- | Lookup a value for the greatest key less than the specified key -lookupLT :: forall k v. (Ord k) => k -> Map k v -> Maybe { key :: k, value :: v } +lookupLT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } lookupLT _ Leaf = Nothing lookupLT k (Two left k1 v1 right) = case compare k k1 of EQ -> findMax left @@ -188,7 +187,7 @@ lookupLT k (Three left k1 v1 mid k2 v2 right) = case compare k k2 of LT -> lookupLT k $ Two left k1 v1 mid -- | Lookup a value for the specified key, or the least one greater than it -lookupGE :: forall k v. (Ord k) => k -> Map k v -> Maybe { key :: k, value :: v } +lookupGE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } lookupGE _ Leaf = Nothing lookupGE k (Two left k1 v1 right) = case compare k k1 of EQ -> Just { key: k1, value: v1 } @@ -200,7 +199,7 @@ lookupGE k (Three left k1 v1 mid k2 v2 right) = case compare k k1 of GT -> lookupGE k $ Two mid k2 v2 right -- | Lookup a value for the least key greater than the specified key -lookupGT :: forall k v. (Ord k) => k -> Map k v -> Maybe { key :: k, value :: v } +lookupGT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } lookupGT _ Leaf = Nothing lookupGT k (Two left k1 v1 right) = case compare k k1 of EQ -> findMin right @@ -371,21 +370,16 @@ update f k m = alter (maybe Nothing f) k m -- | Convert any foldable collection of key/value pairs to a map. -- | On key collision, later values take precedence over earlier ones. -fromFoldable :: forall f k v. (Ord k, Foldable f) => f (Tuple k v) -> Map k v +fromFoldable :: forall f k v. Ord k => Foldable f => f (Tuple k v) -> Map k v fromFoldable = foldl (\m (Tuple k v) -> insert k v m) empty -- | Convert any foldable collection of key/value pairs to a map. -- | On key collision, the values are configurably combined. -fromFoldableWith :: forall f k v. (Ord k, Foldable f) => (v -> v -> v) -> f (Tuple k v) -> Map k v +fromFoldableWith :: forall f k v. Ord k => Foldable f => (v -> v -> v) -> f (Tuple k v) -> Map k v fromFoldableWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where combine v (Just v') = Just $ f v v' combine v Nothing = Just v --- | Convert a map to a list of key/value pairs. --- | DEPRECATED: use toUnfoldable or toAscUnfoldable instead. -toList :: forall k v. Map k v -> List (Tuple k v) -toList = toAscUnfoldable - -- | Convert a map to an unfoldable structure of key/value pairs toUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) toUnfoldable m = unfoldr go (m : Nil) where @@ -427,7 +421,7 @@ values (Three left _ v1 mid _ v2 right) = values left <> pure v1 <> values mid < -- | Compute the union of two maps, using the specified function -- | to combine values for duplicate keys. unionWith :: forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v -unionWith f m1 m2 = foldl go m2 (toList m1) +unionWith f m1 m2 = foldl go m2 (toUnfoldable m1 :: List (Tuple k v)) where go m (Tuple k v) = alter (Just <<< maybe v (f v)) k m @@ -437,7 +431,7 @@ union :: forall k v. Ord k => Map k v -> Map k v -> Map k v union = unionWith const -- | Compute the union of a collection of maps -unions :: forall k v f. (Ord k, Foldable f) => f (Map k v) -> Map k v +unions :: forall k v f. Ord k => Foldable f => f (Map k v) -> Map k v unions = foldl union empty -- | Calculate the number of key/value pairs in a map diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index 0b1255a8..13d81e4e 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -1,8 +1,5 @@ -/* global exports */ "use strict"; -// module Data.StrMap - exports._copyEff = function (m) { return function () { var r = {}; @@ -21,7 +18,6 @@ exports.runST = function (f) { return f; }; -// jshint maxparams: 2 exports._fmapStrMap = function (m0, f) { var m = {}; for (var k in m0) { @@ -32,7 +28,6 @@ exports._fmapStrMap = function (m0, f) { return m; }; -// jshint maxparams: 2 exports._mapWithKey = function (m0, f) { var m = {}; for (var k in m0) { @@ -43,7 +38,6 @@ exports._mapWithKey = function (m0, f) { return m; }; -// jshint maxparams: 1 exports._foldM = function (bind) { return function (f) { return function (mz) { @@ -65,20 +59,19 @@ exports._foldM = function (bind) { }; }; -// jshint maxparams: 4 exports._foldSCStrMap = function (m, z, f, fromMaybe) { + var acc = z; for (var k in m) { if (hasOwnProperty.call(m, k)) { - var maybeR = f(z)(k)(m[k]); + var maybeR = f(acc)(k)(m[k]); var r = fromMaybe(null)(maybeR); - if (r === null) return z; - else z = r; + if (r === null) return acc; + else acc = r; } } - return z; + return acc; }; -// jshint maxparams: 1 exports.all = function (f) { return function (m) { for (var k in m) { @@ -98,18 +91,15 @@ exports.size = function (m) { return s; }; -// jshint maxparams: 4 exports._lookup = function (no, yes, k, m) { return k in m ? yes(m[k]) : no; }; -// jshint maxparams: 2 exports._unsafeDeleteStrMap = function (m, k) { delete m[k]; return m; }; -// jshint maxparams: 4 exports._lookupST = function (no, yes, k, m) { return function () { return k in m ? yes(m[k]) : no; diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 24348d9a..522d85de 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -54,7 +54,7 @@ import Data.Tuple (Tuple(..), uncurry) import Data.Unfoldable (class Unfoldable) -- | `StrMap a` represents a map from `String`s to values of type `a`. -foreign import data StrMap :: * -> * +foreign import data StrMap :: Type -> Type foreign import _copyEff :: forall a b h r. a -> Eff (st :: ST.ST h | r) b @@ -94,13 +94,13 @@ fold = _foldM ((#)) -- | Fold the keys and values of a map, accumulating values using -- | some `Monoid`. -foldMap :: forall a m. (Monoid m) => (String -> a -> m) -> StrMap a -> m +foldMap :: forall a m. Monoid m => (String -> a -> m) -> StrMap a -> m foldMap f = fold (\acc k v -> acc <> f k v) mempty -- | Fold the keys and values of a map, accumulating values and effects in -- | some `Monad`. -foldM :: forall a m z. (Monad m) => (z -> String -> a -> m z) -> z -> StrMap a -> m z -foldM f z = _foldM (>>=) f (pure z) +foldM :: forall a m z. Monad m => (z -> String -> a -> m z) -> z -> StrMap a -> m z +foldM f z = _foldM bind f (pure z) instance foldableStrMap :: Foldable StrMap where foldl f = fold (\z _ -> f z) @@ -136,7 +136,7 @@ instance showStrMap :: (Show a) => Show (StrMap a) where foreign import empty :: forall a. StrMap a -- | Test whether one map contains all of the keys and values contained in another map -isSubmap :: forall a. (Eq a) => StrMap a -> StrMap a -> Boolean +isSubmap :: forall a. Eq a => StrMap a -> StrMap a -> Boolean isSubmap m1 m2 = all f m1 where f k v = runFn4 _lookup false ((==) v) k m2 diff --git a/src/Data/StrMap/ST.js b/src/Data/StrMap/ST.js index bc0a0e47..7baf2f84 100644 --- a/src/Data/StrMap/ST.js +++ b/src/Data/StrMap/ST.js @@ -1,8 +1,5 @@ -/* global exports */ "use strict"; -// module Data.StrMap.ST - exports["new"] = function () { return {}; }; diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs index 5e0cc144..ccf56105 100644 --- a/src/Data/StrMap/ST.purs +++ b/src/Data/StrMap/ST.purs @@ -19,7 +19,7 @@ import Data.Maybe (Maybe(..)) -- | The first type parameter represents the memory region which the map belongs to. The second type parameter defines the type of elements of the mutable array. -- | -- | The runtime representation of a value of type `STStrMap h a` is the same as that of `StrMap a`, except that mutation is allowed. -foreign import data STStrMap :: * -> * -> * +foreign import data STStrMap :: Type -> Type -> Type -- | Create a new, empty mutable map foreign import new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) diff --git a/src/Data/StrMap/ST/Unsafe.js b/src/Data/StrMap/ST/Unsafe.js index b18005f2..58e388a2 100644 --- a/src/Data/StrMap/ST/Unsafe.js +++ b/src/Data/StrMap/ST/Unsafe.js @@ -1,8 +1,5 @@ -/* global exports */ "use strict"; -// module Data.StrMap.ST.Unsafe - exports.unsafeGet = function (m) { return function () { return m; diff --git a/src/Data/StrMap/Unsafe.js b/src/Data/StrMap/Unsafe.js index 40c9e19c..1cec670e 100644 --- a/src/Data/StrMap/Unsafe.js +++ b/src/Data/StrMap/Unsafe.js @@ -1,8 +1,5 @@ -/* global exports */ "use strict"; -// module Data.StrMap.Unsafe - exports.unsafeIndex = function (m) { return function (k) { return m[k]; diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 737b19fe..bbc0c670 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -97,7 +97,7 @@ instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k <- arbitrary pure (Delete k) -runInstructions :: forall k v. (Ord k) => List (Instruction k v) -> M.Map k v -> M.Map k v +runInstructions :: forall k v. Ord k => List (Instruction k v) -> M.Map k v -> M.Map k v runInstructions instrs t0 = foldl step t0 instrs where step tree (Insert k v) = M.insert k v tree @@ -112,7 +112,7 @@ number n = n smallKeyToNumberMap :: M.Map SmallKey Int -> M.Map SmallKey Int smallKeyToNumberMap m = m -mapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPTION | eff) Unit +mapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) Unit mapTests = do -- Data.Map diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 6eaab4db..e54dd14e 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -11,6 +11,7 @@ import Data.Foldable (foldl) import Data.Function (on) import Data.List (List(..), groupBy, sortBy, singleton, fromFoldable, zipWith) import Data.List.NonEmpty as NEL +import Data.NonEmpty ((:|)) import Data.Maybe (Maybe(..)) import Data.StrMap as M import Data.Tuple (Tuple(..), fst) @@ -35,8 +36,7 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where arbitrary = do b <- arbitrary - k <- Gen.frequency (Tuple 10.0 (pure "hasOwnProperty")) - (Tuple 50.0 arbitrary `Cons` Nil) + k <- Gen.frequency $ Tuple 10.0 (pure "hasOwnProperty") :| Tuple 50.0 arbitrary `Cons` Nil case b of true -> do v <- arbitrary @@ -53,7 +53,7 @@ runInstructions instrs t0 = foldl step t0 instrs number :: Int -> Int number n = n -strMapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPTION | eff) Unit +strMapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) Unit strMapTests = do log "Test inserting into empty tree" quickCheck $ \k v -> M.lookup k (M.insert k v M.empty) == Just (number v) diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 25b33de6..232714d2 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -10,7 +10,7 @@ import Control.Monad.Eff.Random (RANDOM) import Test.Data.Map (mapTests) import Test.Data.StrMap (strMapTests) -main :: Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPTION) Unit +main :: Eff (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION) Unit main = do log "Running Map tests" mapTests From 352779652456cbdf5b00899e389f724918da4749 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 13 Feb 2017 21:59:04 +0000 Subject: [PATCH 097/125] simplify some arbitrary instances in tests --- test/Test/Data/Map.purs | 26 +++----------------------- 1 file changed, 3 insertions(+), 23 deletions(-) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 5dfd109a..d810ce30 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -15,6 +15,7 @@ import Data.Maybe (Maybe(..), fromMaybe) import Data.Tuple (Tuple(..), fst) import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((), (===), quickCheck, quickCheck') +import Test.QuickCheck.Gen (oneOf) import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) newtype TestMap k v = TestMap (M.Map k v) @@ -39,19 +40,7 @@ instance showSmallKey :: Show SmallKey where show J = "J" instance arbSmallKey :: Arbitrary SmallKey where - arbitrary = do - n <- arbitrary - pure case n of - _ | n < 0.1 -> A - _ | n < 0.2 -> B - _ | n < 0.3 -> C - _ | n < 0.4 -> D - _ | n < 0.5 -> E - _ | n < 0.6 -> F - _ | n < 0.7 -> G - _ | n < 0.8 -> H - _ | n < 0.9 -> I - _ -> J + arbitrary = oneOf (pure A) (map pure [B, C, D, E, F, G, H, I]) data Instruction k v = Insert k v | Delete k @@ -60,16 +49,7 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where show (Delete k) = "Delete (" <> show k <> ")" instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k v) where - arbitrary = do - b <- arbitrary - case b of - true -> do - k <- arbitrary - v <- arbitrary - pure (Insert k v) - false -> do - k <- arbitrary - pure (Delete k) + arbitrary = oneOf (Insert <$> arbitrary <*> arbitrary) [(Delete <$> arbitrary)] runInstructions :: forall k v. Ord k => List (Instruction k v) -> M.Map k v -> M.Map k v runInstructions instrs t0 = foldl step t0 instrs From 72fb00b3a07613989fbcb8cfbf67e27f788cd1aa Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 13 Feb 2017 22:29:28 +0000 Subject: [PATCH 098/125] use elements where appropriate Replace a use of oneOf with elements in tests. Also correct for a missing constructor. --- test/Test/Data/Map.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index d810ce30..a9a9b6e5 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -15,7 +15,7 @@ import Data.Maybe (Maybe(..), fromMaybe) import Data.Tuple (Tuple(..), fst) import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((), (===), quickCheck, quickCheck') -import Test.QuickCheck.Gen (oneOf) +import Test.QuickCheck.Gen (elements, oneOf) import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) newtype TestMap k v = TestMap (M.Map k v) @@ -40,7 +40,7 @@ instance showSmallKey :: Show SmallKey where show J = "J" instance arbSmallKey :: Arbitrary SmallKey where - arbitrary = oneOf (pure A) (map pure [B, C, D, E, F, G, H, I]) + arbitrary = elements A [B, C, D, E, F, G, H, I, J] data Instruction k v = Insert k v | Delete k From e8e0db5a42b00480fe8b67a324777cf1db9c59b8 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 13 Feb 2017 23:08:51 +0000 Subject: [PATCH 099/125] redundant parens --- test/Test/Data/Map.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index a9a9b6e5..34107533 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -49,7 +49,7 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where show (Delete k) = "Delete (" <> show k <> ")" instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k v) where - arbitrary = oneOf (Insert <$> arbitrary <*> arbitrary) [(Delete <$> arbitrary)] + arbitrary = oneOf (Insert <$> arbitrary <*> arbitrary) [Delete <$> arbitrary] runInstructions :: forall k v. Ord k => List (Instruction k v) -> M.Map k v -> M.Map k v runInstructions instrs t0 = foldl step t0 instrs From a8089de0eb9a7733066e918657e1b3a9df1032eb Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 27 Mar 2017 22:00:16 +0100 Subject: [PATCH 100/125] Fix tests --- test/Test/Data/Map.purs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 34107533..26612d8d 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -8,6 +8,7 @@ import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) +import Data.NonEmpty ((:|)) import Data.Foldable (foldl, for_, all) import Data.Function (on) import Data.List (List(Cons), groupBy, length, nubBy, singleton, sort, sortBy) @@ -40,7 +41,7 @@ instance showSmallKey :: Show SmallKey where show J = "J" instance arbSmallKey :: Arbitrary SmallKey where - arbitrary = elements A [B, C, D, E, F, G, H, I, J] + arbitrary = elements $ A :| [B, C, D, E, F, G, H, I, J] data Instruction k v = Insert k v | Delete k @@ -49,7 +50,7 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where show (Delete k) = "Delete (" <> show k <> ")" instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k v) where - arbitrary = oneOf (Insert <$> arbitrary <*> arbitrary) [Delete <$> arbitrary] + arbitrary = oneOf $ (Insert <$> arbitrary <*> arbitrary) :| [Delete <$> arbitrary] runInstructions :: forall k v. Ord k => List (Instruction k v) -> M.Map k v -> M.Map k v runInstructions instrs t0 = foldl step t0 instrs From b758c036d88fbeb7a994d0f891f6e6cdb38e86d1 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 27 Mar 2017 23:07:57 +0100 Subject: [PATCH 101/125] Add Eq1 and Ord1 instances --- src/Data/Map.purs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 6c5bd9f1..abbbb179 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -35,10 +35,12 @@ module Data.Map ) where import Prelude +import Data.Eq (class Eq1) import Data.Foldable (foldl, foldMap, foldr, class Foldable) import Data.List (List(..), (:), length, nub) import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) import Data.Monoid (class Monoid) +import Data.Ord (class Ord1) import Data.Traversable (traverse, class Traversable) import Data.Tuple (Tuple(Tuple), snd) import Data.Unfoldable (class Unfoldable, unfoldr) @@ -54,9 +56,15 @@ data Map k v toAscArray :: forall k v. Map k v -> Array (Tuple k v) toAscArray = toAscUnfoldable +instance eq1Map :: Eq k => Eq1 (Map k) where + eq1 = eq + instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where eq m1 m2 = toAscArray m1 == toAscArray m2 +instance ord1Map :: Ord k => Ord1 (Map k) where + compare1 = compare + instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where compare m1 m2 = compare (toAscArray m1) (toAscArray m2) From 9c0cc7fcd177f770a7723c5535ab48d1cb851f53 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 27 Mar 2017 23:10:22 +0100 Subject: [PATCH 102/125] Add Eq1 instance, make array usage consistent, drop toList --- src/Data/StrMap.purs | 30 +++++++++++++++++------------- test/Test/Data/StrMap.purs | 37 +++++++++++++++++++------------------ 2 files changed, 36 insertions(+), 31 deletions(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 3ca1e59b..6186e273 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -12,7 +12,6 @@ module Data.StrMap , singleton , insert , lookup - , toList , toUnfoldable , fromFoldable , fromFoldableWith @@ -43,9 +42,10 @@ import Prelude import Control.Monad.Eff (Eff, runPure) import Control.Monad.ST as ST +import Data.Array as A +import Data.Eq (class Eq1) import Data.Foldable (class Foldable, foldl, foldr, for_) import Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4) -import Data.List as L import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Monoid (class Monoid, mempty) import Data.StrMap.ST as SM @@ -108,7 +108,7 @@ instance foldableStrMap :: Foldable StrMap where foldMap f = foldMap (const f) instance traversableStrMap :: Traversable StrMap where - traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toList ms)) + traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toArray ms)) sequence = traverse id -- Unfortunately the above are not short-circuitable (consider using purescript-machines) @@ -126,11 +126,14 @@ foldMaybe f z m = runFn4 _foldSCStrMap m z f fromMaybe -- | Test whether all key/value pairs in a `StrMap` satisfy a predicate. foreign import all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean -instance eqStrMap :: (Eq a) => Eq (StrMap a) where +instance eqStrMap :: Eq a => Eq (StrMap a) where eq m1 m2 = (isSubmap m1 m2) && (isSubmap m2 m1) -instance showStrMap :: (Show a) => Show (StrMap a) where - show m = "fromList " <> show (toList m) +instance eq1StrMap :: Eq1 StrMap where + eq1 = eq + +instance showStrMap :: Show a => Show (StrMap a) where + show m = "(fromFoldable " <> show (toArray m) <> ")" -- | An empty map foreign import empty :: forall a. StrMap a @@ -208,19 +211,20 @@ fromFoldableWith f l = pureST (do foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array b --- | Convert a map into a list of key/value pairs -toList :: forall a. StrMap a -> L.List (Tuple String a) -toList = L.fromFoldable <<< _collect Tuple - +-- | Unfolds a map into a list of key/value pairs toUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a) -toUnfoldable = L.toUnfoldable <<< toList +toUnfoldable = A.toUnfoldable <<< _collect Tuple + +-- Internal +toArray :: forall a. StrMap a -> Array (Tuple String a) +toArray = _collect Tuple -- | Get an array of the keys in a map foreign import keys :: forall a. StrMap a -> Array String -- | Get a list of the values in a map -values :: forall a. StrMap a -> L.List a -values = L.fromFoldable <<< _collect (\_ v -> v) +values :: forall a. StrMap a -> Array a +values = _collect (\_ v -> v) -- | Compute the union of two maps, preferring the first map in the case of -- | duplicate keys. diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index be6c5709..37f7e462 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -7,12 +7,13 @@ import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) +import Data.Array as A import Data.Foldable (foldl) import Data.Function (on) -import Data.List (List(..), groupBy, sortBy, singleton, fromFoldable, zipWith) +import Data.List as L import Data.List.NonEmpty as NEL -import Data.NonEmpty ((:|)) import Data.Maybe (Maybe(..)) +import Data.NonEmpty ((:|)) import Data.StrMap as M import Data.Tuple (Tuple(..), fst) @@ -25,7 +26,7 @@ import Test.QuickCheck.Gen as Gen newtype TestStrMap v = TestStrMap (M.StrMap v) instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where - arbitrary = TestStrMap <<< (M.fromFoldable :: List (Tuple String v) -> M.StrMap v) <$> arbitrary + arbitrary = TestStrMap <<< (M.fromFoldable :: L.List (Tuple String v) -> M.StrMap v) <$> arbitrary data Instruction k v = Insert k v | Delete k @@ -36,7 +37,7 @@ instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where arbitrary = do b <- arbitrary - k <- Gen.frequency $ Tuple 10.0 (pure "hasOwnProperty") :| Tuple 50.0 arbitrary `Cons` Nil + k <- Gen.frequency $ Tuple 10.0 (pure "hasOwnProperty") :| pure (Tuple 50.0 arbitrary) case b of true -> do v <- arbitrary @@ -44,7 +45,7 @@ instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) whe false -> do pure (Delete k) -runInstructions :: forall v. List (Instruction String v) -> M.StrMap v -> M.StrMap v +runInstructions :: forall v. L.List (Instruction String v) -> M.StrMap v -> M.StrMap v runInstructions instrs t0 = foldl step t0 instrs where step tree (Insert k v) = M.insert k v tree @@ -101,7 +102,7 @@ strMapTests = do in M.lookup k tree == Just v ("instrs:\n " <> show instrs <> "\nk:\n " <> show k <> "\nv:\n " <> show v) log "Singleton to list" - quickCheck $ \k v -> M.toList (M.singleton k v :: M.StrMap Int) == singleton (Tuple k v) + quickCheck $ \k v -> M.toUnfoldable (M.singleton k v :: M.StrMap Int) == L.singleton (Tuple k v) log "fromFoldable [] = empty" quickCheck (M.fromFoldable [] == (M.empty :: M.StrMap Unit) @@ -125,26 +126,26 @@ strMapTests = do quickCheck (M.lookup "1" nums == Just 2 "invalid lookup - 1") quickCheck (M.lookup "2" nums == Nothing "invalid lookup - 2") - log "toList . fromFoldable = id" - quickCheck $ \arr -> let f x = M.toList (M.fromFoldable x) - in f (f arr) == f (arr :: List (Tuple String Int)) show arr + log "toUnfoldable . fromFoldable = id" + quickCheck $ \arr -> let f x = M.toUnfoldable (M.fromFoldable x) + in f (f arr) == f (arr :: L.List (Tuple String Int)) show arr - log "fromFoldable . toList = id" + log "fromFoldable . toUnfoldable = id" quickCheck $ \(TestStrMap m) -> - let f m1 = M.fromFoldable (M.toList m1) in - M.toList (f m) == M.toList (m :: M.StrMap Int) show m + let f m1 = M.fromFoldable ((M.toUnfoldable m1) :: L.List (Tuple String Int)) in + M.toUnfoldable (f m) == (M.toUnfoldable m :: L.List (Tuple String Int)) show m log "fromFoldableWith const = fromFoldable" quickCheck $ \arr -> M.fromFoldableWith const arr == - M.fromFoldable (arr :: List (Tuple String Int)) show arr + M.fromFoldable (arr :: L.List (Tuple String Int)) show arr log "fromFoldableWith (<>) = fromFoldable . collapse with (<>) . group on fst" quickCheck $ \arr -> let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) - foldl1 g = unsafePartial \(Cons x xs) -> foldl g x xs + foldl1 g = unsafePartial \(L.Cons x xs) -> foldl g x xs f = M.fromFoldable <<< map (foldl1 combine <<< NEL.toList) <<< - groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in - M.fromFoldableWith (<>) arr == f (arr :: List (Tuple String String)) show arr + L.groupBy ((==) `on` fst) <<< L.sortBy (compare `on` fst) in + M.fromFoldableWith (<>) arr == f (arr :: L.List (Tuple String String)) show arr log "Lookup from union" quickCheck $ \(TestStrMap m1) (TestStrMap m2) k -> @@ -157,13 +158,13 @@ strMapTests = do (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Int)) (show (M.size (m1 `M.union` m2)) <> " != " <> show (M.size ((m1 `M.union` m2) `M.union` m2))) log "fromFoldable = zip keys values" - quickCheck $ \(TestStrMap m) -> M.toList m == zipWith Tuple (fromFoldable $ M.keys m) (M.values m :: List Int) + quickCheck $ \(TestStrMap m) -> M.toUnfoldable m == A.zipWith Tuple (M.keys m) (M.values m :: Array Int) log "mapWithKey is correct" quickCheck $ \(TestStrMap m :: TestStrMap Int) -> let f k v = k <> show v resultViaMapWithKey = m # M.mapWithKey f - resultViaLists = m # M.toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable + resultViaLists = m # M.toUnfoldable # map (\(Tuple k v) → Tuple k (f k v)) # (M.fromFoldable :: forall a. L.List (Tuple String a) -> M.StrMap a) in resultViaMapWithKey === resultViaLists log "Bug #63: accidental observable mutation in foldMap" From 73c2289335a5ca97f507a719b628d34b06c8269d Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 27 Mar 2017 23:13:35 +0100 Subject: [PATCH 103/125] Rename unsafeGet to unsafeFreeze --- src/Data/StrMap/ST/Unsafe.js | 2 +- src/Data/StrMap/ST/Unsafe.purs | 6 ++---- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Data/StrMap/ST/Unsafe.js b/src/Data/StrMap/ST/Unsafe.js index 58e388a2..83807658 100644 --- a/src/Data/StrMap/ST/Unsafe.js +++ b/src/Data/StrMap/ST/Unsafe.js @@ -1,6 +1,6 @@ "use strict"; -exports.unsafeGet = function (m) { +exports.unsafeFreeze = function (m) { return function () { return m; }; diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs index 234f39f5..19c36d39 100644 --- a/src/Data/StrMap/ST/Unsafe.purs +++ b/src/Data/StrMap/ST/Unsafe.purs @@ -1,6 +1,4 @@ -module Data.StrMap.ST.Unsafe - ( unsafeGet - ) where +module Data.StrMap.ST.Unsafe where import Control.Monad.Eff (Eff) import Control.Monad.ST (ST) @@ -10,4 +8,4 @@ import Data.StrMap.ST (STStrMap) -- | Unsafely get the map out of ST without copying it -- | -- | If you later change the ST version of the map the pure value will also change. -foreign import unsafeGet :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) +foreign import unsafeFreeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) From 2c42ac7f175e19e263ddd22d4ab4cdfa25141079 Mon Sep 17 00:00:00 2001 From: Joshua Horowitz Date: Wed, 3 May 2017 03:59:42 -0700 Subject: [PATCH 104/125] Faster & simpler traverse for StrMap --- src/Data/StrMap.purs | 10 ++++++++-- test/Test/Data/StrMap.purs | 21 ++++++++++++++++++++- 2 files changed, 28 insertions(+), 3 deletions(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 6186e273..c1194cb9 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -13,6 +13,7 @@ module Data.StrMap , insert , lookup , toUnfoldable + , toAscUnfoldable , fromFoldable , fromFoldableWith , delete @@ -50,7 +51,7 @@ import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Monoid (class Monoid, mempty) import Data.StrMap.ST as SM import Data.Traversable (class Traversable, traverse) -import Data.Tuple (Tuple(..), uncurry) +import Data.Tuple (Tuple(..), fst) import Data.Unfoldable (class Unfoldable) -- | `StrMap a` represents a map from `String`s to values of type `a`. @@ -108,7 +109,7 @@ instance foldableStrMap :: Foldable StrMap where foldMap f = foldMap (const f) instance traversableStrMap :: Traversable StrMap where - traverse f ms = foldr (\x acc -> union <$> x <*> acc) (pure empty) ((map (uncurry singleton)) <$> (traverse f <$> toArray ms)) + traverse f ms = fold (\acc k v -> insert k <$> f v <*> acc) (pure empty) ms sequence = traverse id -- Unfortunately the above are not short-circuitable (consider using purescript-machines) @@ -215,6 +216,11 @@ foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array toUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a) toUnfoldable = A.toUnfoldable <<< _collect Tuple +-- | Unfolds a map into a list of key/value pairs which is guaranteed to be +-- | sorted by key +toAscUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a) +toAscUnfoldable = A.toUnfoldable <<< A.sortWith fst <<< _collect Tuple + -- Internal toArray :: forall a. StrMap a -> Array (Tuple String a) toArray = _collect Tuple diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 37f7e462..f393e4f2 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -15,7 +15,8 @@ import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) import Data.StrMap as M -import Data.Tuple (Tuple(..), fst) +import Data.Tuple (Tuple(..), fst, uncurry) +import Data.Traversable (traverse, sequence) import Partial.Unsafe (unsafePartial) @@ -28,6 +29,11 @@ newtype TestStrMap v = TestStrMap (M.StrMap v) instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where arbitrary = TestStrMap <<< (M.fromFoldable :: L.List (Tuple String v) -> M.StrMap v) <$> arbitrary +newtype SmallArray v = SmallArray (Array v) + +instance arbSmallArray :: (Arbitrary v) => Arbitrary (SmallArray v) where + arbitrary = SmallArray <$> Gen.resize 3 arbitrary + data Instruction k v = Insert k v | Delete k instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where @@ -54,6 +60,14 @@ runInstructions instrs t0 = foldl step t0 instrs number :: Int -> Int number n = n +oldTraverse :: forall a b m. Applicative m => (a -> m b) -> M.StrMap a -> m (M.StrMap b) +oldTraverse f ms = A.foldr (\x acc -> M.union <$> x <*> acc) (pure M.empty) ((map (uncurry M.singleton)) <$> (traverse f <$> (M.toUnfoldable ms :: Array (Tuple String a)))) +oldSequence :: forall a m. Applicative m => M.StrMap (m a) -> m (M.StrMap a) +oldSequence = oldTraverse id + +toAscArray :: forall a. M.StrMap a -> Array (Tuple String a) +toAscArray = M.toAscUnfoldable + strMapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) Unit strMapTests = do log "Test inserting into empty tree" @@ -167,6 +181,11 @@ strMapTests = do resultViaLists = m # M.toUnfoldable # map (\(Tuple k v) → Tuple k (f k v)) # (M.fromFoldable :: forall a. L.List (Tuple String a) -> M.StrMap a) in resultViaMapWithKey === resultViaLists + log "sequence gives the same results as an old version (up to ordering)" + quickCheck \(TestStrMap mOfSmallArrays :: TestStrMap (SmallArray Int)) -> + let m = (\(SmallArray a) -> a) <$> mOfSmallArrays + in A.sort (toAscArray <$> oldSequence m) === A.sort (toAscArray <$> sequence m) + log "Bug #63: accidental observable mutation in foldMap" quickCheck \(TestStrMap m) -> let lhs = go m From 91cee50f097b224ef4fd2ef70a5a5d66db3469a0 Mon Sep 17 00:00:00 2001 From: Joshua Horowitz Date: Wed, 3 May 2017 21:59:21 -0700 Subject: [PATCH 105/125] Better test of Traversable StrMap (& new instance of Ord StrMap) --- src/Data/StrMap.purs | 7 +++++++ test/Test/Data/StrMap.purs | 23 +++++++++++++---------- 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index c1194cb9..67714de3 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -133,6 +133,13 @@ instance eqStrMap :: Eq a => Eq (StrMap a) where instance eq1StrMap :: Eq1 StrMap where eq1 = eq +-- Internal use +toAscArray :: forall v. StrMap v -> Array (Tuple String v) +toAscArray = toAscUnfoldable + +instance ordStrMap :: Ord a => Ord (StrMap a) where + compare m1 m2 = compare (toAscArray m1) (toAscArray m2) + instance showStrMap :: Show a => Show (StrMap a) where show m = "(fromFoldable " <> show (toArray m) <> ")" diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index f393e4f2..d1203c89 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -15,8 +15,8 @@ import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) import Data.StrMap as M -import Data.Tuple (Tuple(..), fst, uncurry) -import Data.Traversable (traverse, sequence) +import Data.Tuple (Tuple(..), fst) +import Data.Traversable (sequence) import Partial.Unsafe (unsafePartial) @@ -60,11 +60,6 @@ runInstructions instrs t0 = foldl step t0 instrs number :: Int -> Int number n = n -oldTraverse :: forall a b m. Applicative m => (a -> m b) -> M.StrMap a -> m (M.StrMap b) -oldTraverse f ms = A.foldr (\x acc -> M.union <$> x <*> acc) (pure M.empty) ((map (uncurry M.singleton)) <$> (traverse f <$> (M.toUnfoldable ms :: Array (Tuple String a)))) -oldSequence :: forall a m. Applicative m => M.StrMap (m a) -> m (M.StrMap a) -oldSequence = oldTraverse id - toAscArray :: forall a. M.StrMap a -> Array (Tuple String a) toAscArray = M.toAscUnfoldable @@ -181,10 +176,18 @@ strMapTests = do resultViaLists = m # M.toUnfoldable # map (\(Tuple k v) → Tuple k (f k v)) # (M.fromFoldable :: forall a. L.List (Tuple String a) -> M.StrMap a) in resultViaMapWithKey === resultViaLists - log "sequence gives the same results as an old version (up to ordering)" + log "sequence works (for m = Array)" quickCheck \(TestStrMap mOfSmallArrays :: TestStrMap (SmallArray Int)) -> - let m = (\(SmallArray a) -> a) <$> mOfSmallArrays - in A.sort (toAscArray <$> oldSequence m) === A.sort (toAscArray <$> sequence m) + let m = (\(SmallArray a) -> a) <$> mOfSmallArrays + Tuple keys values = A.unzip (toAscArray m) + resultViaArrays = (M.fromFoldable <<< A.zip keys) <$> sequence values + in A.sort (sequence m) === A.sort (resultViaArrays) + + log "sequence works (for m = Maybe)" + quickCheck \(TestStrMap m :: TestStrMap (Maybe Int)) -> + let Tuple keys values = A.unzip (toAscArray m) + resultViaArrays = (M.fromFoldable <<< A.zip keys) <$> sequence values + in sequence m === resultViaArrays log "Bug #63: accidental observable mutation in foldMap" quickCheck \(TestStrMap m) -> From 26512bb8d383594c48b64963ee06c6e3ff7a0207 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Tue, 30 May 2017 19:43:15 +0100 Subject: [PATCH 106/125] kill unnecessary code in StrMap singleton --- src/Data/StrMap.purs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 67714de3..dfb30c20 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -162,8 +162,7 @@ foreign import size :: forall a. StrMap a -> Int singleton :: forall a. String -> a -> StrMap a singleton k v = pureST do s <- SM.new - _ <- SM.poke s k v - pure s + SM.poke s k v foreign import _lookup :: forall a z. Fn4 z (a -> z) String (StrMap a) z From b60c246bd7b69b5547143d76703481eae14bdc15 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Fri, 2 Jun 2017 12:29:22 +0100 Subject: [PATCH 107/125] simplify pop code --- src/Data/Map.purs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index abbbb179..16f7b2b9 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -294,21 +294,21 @@ delete k m = maybe m snd (pop k m) -- | Delete a key and its corresponding value from a map, returning the value -- | as well as the subsequent map. pop :: forall k v. Ord k => k -> Map k v -> Maybe (Tuple v (Map k v)) -pop = down Nil +pop k = down Nil where comp :: k -> k -> Ordering comp = compare - down :: List (TreeContext k v) -> k -> Map k v -> Maybe (Tuple v (Map k v)) - down = unsafePartial \ctx k m -> case m of + down :: List (TreeContext k v) -> Map k v -> Maybe (Tuple v (Map k v)) + down = unsafePartial \ctx m -> case m of Leaf -> Nothing Two left k1 v1 right -> case right, comp k k1 of Leaf, EQ -> Just (Tuple v1 (up ctx Leaf)) _ , EQ -> let max = maxNode left in Just (Tuple v1 (removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left)) - _ , LT -> down (Cons (TwoLeft k1 v1 right) ctx) k left - _ , _ -> down (Cons (TwoRight left k1 v1) ctx) k right + _ , LT -> down (Cons (TwoLeft k1 v1 right) ctx) left + _ , _ -> down (Cons (TwoRight left k1 v1) ctx) right Three left k1 v1 mid k2 v2 right -> let leaves = case left, mid, right of @@ -321,9 +321,9 @@ pop = down Nil in Just (Tuple v1 (removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left)) _ , _ , EQ -> let max = maxNode mid in Just (Tuple v2 (removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid)) - _ , LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k left - _ , GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k mid - _ , _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k right + _ , LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) left + _ , GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) mid + _ , _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right up :: List (TreeContext k v) -> Map k v -> Map k v up = unsafePartial \ctxs tree -> @@ -351,9 +351,9 @@ pop = down Nil maxNode :: Map k v -> { key :: k, value :: v } maxNode = unsafePartial \m -> case m of - Two _ k v Leaf -> { key: k, value: v } + Two _ k' v Leaf -> { key: k', value: v } Two _ _ _ right -> maxNode right - Three _ _ _ _ k v Leaf -> { key: k, value: v } + Three _ _ _ _ k' v Leaf -> { key: k', value: v } Three _ _ _ _ _ _ right -> maxNode right @@ -361,7 +361,7 @@ pop = down Nil removeMaxNode = unsafePartial \ctx m -> case m of Two Leaf _ _ Leaf -> up ctx Leaf - Two left k v right -> removeMaxNode (Cons (TwoRight left k v) ctx) right + Two left k' v right -> removeMaxNode (Cons (TwoRight left k' v) ctx) right Three Leaf k1 v1 Leaf _ _ Leaf -> up (Cons (TwoRight Leaf k1 v1) ctx) Leaf Three left k1 v1 mid k2 v2 right -> removeMaxNode (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right From 3a2e9ecc3448ac7cf340c5624233cea8aa9e0e6e Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Sat, 3 Jun 2017 19:22:13 +0100 Subject: [PATCH 108/125] cleaner lookup code (#103) * cleaner lookup code may also result in slight speed improvement. * restore use of `comp` Avoid instance lookup overhead. * use comp optimization in all lookups discussion in https://github.com/purescript/purescript-maps/pull/103 an optimization to reduce instance lookup --- src/Data/Map.purs | 153 ++++++++++++++++++++++++++-------------------- 1 file changed, 86 insertions(+), 67 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index abbbb179..6f86d8ab 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -145,78 +145,97 @@ checkValid tree = length (nub (allHeights tree)) == one allHeights (Two left _ _ right) = map (\n -> n + one) (allHeights left <> allHeights right) allHeights (Three left _ _ mid _ _ right) = map (\n -> n + one) (allHeights left <> allHeights mid <> allHeights right) --- | Lookup a value for the specified key +-- | Look up a value for the specified key lookup :: forall k v. Ord k => k -> Map k v -> Maybe v -lookup = unsafePartial \k tree -> - case tree of - Leaf -> Nothing - _ -> - let comp :: k -> k -> Ordering - comp = compare - in case tree of - Two left k1 v right -> - case comp k k1 of - EQ -> Just v - LT -> lookup k left - _ -> lookup k right - Three left k1 v1 mid k2 v2 right -> - case comp k k1 of - EQ -> Just v1 - c1 -> - case c1, comp k k2 of - _ , EQ -> Just v2 - LT, _ -> lookup k left - _ , GT -> lookup k right - _ , _ -> lookup k mid - - --- | Lookup a value for the specified key, or the greatest one less than it +lookup k = go + where + comp :: k -> k -> Ordering + comp = compare + + go Leaf = Nothing + go (Two left k1 v right) = + case comp k k1 of + EQ -> Just v + LT -> go left + _ -> go right + go (Three left k1 v1 mid k2 v2 right) = + case comp k k1 of + EQ -> Just v1 + c1 -> + case c1, comp k k2 of + _ , EQ -> Just v2 + LT, _ -> go left + _ , GT -> go right + _ , _ -> go mid + + +-- | Look up a value for the specified key, or the greatest one less than it lookupLE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupLE _ Leaf = Nothing -lookupLE k (Two left k1 v1 right) = case compare k k1 of - EQ -> Just { key: k1, value: v1 } - GT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupLE k right - LT -> lookupLE k left -lookupLE k (Three left k1 v1 mid k2 v2 right) = case compare k k2 of - EQ -> Just { key: k2, value: v2 } - GT -> Just $ fromMaybe { key: k2, value: v2 } $ lookupLE k right - LT -> lookupLE k $ Two left k1 v1 mid - --- | Lookup a value for the greatest key less than the specified key +lookupLE k = go + where + comp :: k -> k -> Ordering + comp = compare + + go Leaf = Nothing + go (Two left k1 v1 right) = case comp k k1 of + EQ -> Just { key: k1, value: v1 } + GT -> Just $ fromMaybe { key: k1, value: v1 } $ go right + LT -> go left + go (Three left k1 v1 mid k2 v2 right) = case comp k k2 of + EQ -> Just { key: k2, value: v2 } + GT -> Just $ fromMaybe { key: k2, value: v2 } $ go right + LT -> go $ Two left k1 v1 mid + +-- | Look up a value for the greatest key less than the specified key lookupLT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupLT _ Leaf = Nothing -lookupLT k (Two left k1 v1 right) = case compare k k1 of - EQ -> findMax left - GT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupLT k right - LT -> lookupLT k left -lookupLT k (Three left k1 v1 mid k2 v2 right) = case compare k k2 of - EQ -> findMax $ Two left k1 v1 mid - GT -> Just $ fromMaybe { key: k2, value: v2 } $ lookupLT k right - LT -> lookupLT k $ Two left k1 v1 mid - --- | Lookup a value for the specified key, or the least one greater than it +lookupLT k = go + where + comp :: k -> k -> Ordering + comp = compare + + go Leaf = Nothing + go (Two left k1 v1 right) = case comp k k1 of + EQ -> findMax left + GT -> Just $ fromMaybe { key: k1, value: v1 } $ go right + LT -> go left + go (Three left k1 v1 mid k2 v2 right) = case comp k k2 of + EQ -> findMax $ Two left k1 v1 mid + GT -> Just $ fromMaybe { key: k2, value: v2 } $ go right + LT -> go $ Two left k1 v1 mid + +-- | Look up a value for the specified key, or the least one greater than it lookupGE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupGE _ Leaf = Nothing -lookupGE k (Two left k1 v1 right) = case compare k k1 of - EQ -> Just { key: k1, value: v1 } - LT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupGE k left - GT -> lookupGE k right -lookupGE k (Three left k1 v1 mid k2 v2 right) = case compare k k1 of - EQ -> Just { key: k1, value: v1 } - LT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupGE k left - GT -> lookupGE k $ Two mid k2 v2 right - --- | Lookup a value for the least key greater than the specified key +lookupGE k = go + where + comp :: k -> k -> Ordering + comp = compare + + go Leaf = Nothing + go (Two left k1 v1 right) = case comp k k1 of + EQ -> Just { key: k1, value: v1 } + LT -> Just $ fromMaybe { key: k1, value: v1 } $ go left + GT -> go right + go (Three left k1 v1 mid k2 v2 right) = case comp k k1 of + EQ -> Just { key: k1, value: v1 } + LT -> Just $ fromMaybe { key: k1, value: v1 } $ go left + GT -> go $ Two mid k2 v2 right + +-- | Look up a value for the least key greater than the specified key lookupGT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupGT _ Leaf = Nothing -lookupGT k (Two left k1 v1 right) = case compare k k1 of - EQ -> findMin right - LT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupGT k left - GT -> lookupGT k right -lookupGT k (Three left k1 v1 mid k2 v2 right) = case compare k k1 of - EQ -> findMin $ Two mid k2 v2 right - LT -> Just $ fromMaybe { key: k1, value: v1 } $ lookupGT k left - GT -> lookupGT k $ Two mid k2 v2 right +lookupGT k = go + where + comp :: k -> k -> Ordering + comp = compare + + go Leaf = Nothing + go (Two left k1 v1 right) = case comp k k1 of + EQ -> findMin right + LT -> Just $ fromMaybe { key: k1, value: v1 } $ go left + GT -> go right + go (Three left k1 v1 mid k2 v2 right) = case comp k k1 of + EQ -> findMin $ Two mid k2 v2 right + LT -> Just $ fromMaybe { key: k1, value: v1 } $ go left + GT -> go $ Two mid k2 v2 right -- | Returns the pair with the greatest key findMax :: forall k v. Map k v -> Maybe { key :: k, value :: v } From bbf299b5e07d65b682bfd33c7aed11b7b7d4882e Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Sun, 4 Jun 2017 16:21:06 +0100 Subject: [PATCH 109/125] filterValues and filterKeys (#97) * filterValues and filterKeys whitespace pluralize test fixes simplify tests use ST to reduce algorithmic complexity * refactor filters in terms of k/v filter also add documentation * use ~> * rename filter fns following review: https://github.com/purescript/purescript-maps/pull/97#pullrequestreview-41924986 --- src/Data/StrMap.purs | 26 ++++++++++++++++++++++++++ test/Test/Data/StrMap.purs | 26 +++++++++++++++++++++++++- 2 files changed, 51 insertions(+), 1 deletion(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index dfb30c20..e5c0b798 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -22,6 +22,9 @@ module Data.StrMap , alter , update , mapWithKey + , filterWithKey + , filterKeys + , filter , keys , values , union @@ -258,3 +261,26 @@ instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) where instance monoidStrMap :: (Semigroup a) => Monoid (StrMap a) where mempty = empty + +-- | Filter out those key/value pairs of a map for which a predicate +-- | fails to hold. +filterWithKey :: forall a. (String -> a -> Boolean) -> StrMap a -> StrMap a +filterWithKey predicate m = pureST go + where + go :: forall h e. Eff (st :: ST.ST h | e) (SM.STStrMap h a) + go = do + m' <- SM.new + foldM step m' m + + where + step acc k v = if predicate k v then SM.poke acc k v else pure acc + +-- | Filter out those key/value pairs of a map for which a predicate +-- | on the key fails to hold. +filterKeys :: (String -> Boolean) -> StrMap ~> StrMap +filterKeys predicate = filterWithKey $ const <<< predicate + +-- | Filter out those key/value pairs of a map for which a predicate +-- | on the value fails to hold. +filter :: forall a. (a -> Boolean) -> StrMap a -> StrMap a +filter predicate = filterWithKey $ const predicate diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index d1203c89..3ce6fbda 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -15,7 +15,7 @@ import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) import Data.StrMap as M -import Data.Tuple (Tuple(..), fst) +import Data.Tuple (Tuple(..), fst, uncurry) import Data.Traversable (sequence) import Partial.Unsafe (unsafePartial) @@ -113,6 +113,30 @@ strMapTests = do log "Singleton to list" quickCheck $ \k v -> M.toUnfoldable (M.singleton k v :: M.StrMap Int) == L.singleton (Tuple k v) + log "filterWithKey gives submap" + quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> + M.isSubmap (M.filterWithKey p s) s + + log "filterWithKey keeps those keys for which predicate is true" + quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> + A.all (uncurry p) (M.toAscUnfoldable (M.filterWithKey p s) :: Array (Tuple String Int)) + + log "filterKeys gives submap" + quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> + M.isSubmap (M.filterKeys p s) s + + log "filterKeys keeps those keys for which predicate is true" + quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> + A.all p (M.keys (M.filterKeys p s)) + + log "filter gives submap" + quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> + M.isSubmap (M.filter p s) s + + log "filter keeps those values for which predicate is true" + quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> + A.all p (M.values (M.filter p s)) + log "fromFoldable [] = empty" quickCheck (M.fromFoldable [] == (M.empty :: M.StrMap Unit) "was not empty") From cb51f082e15e313b8c4bf3aa4cb7c0346571b4d4 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Sun, 4 Jun 2017 16:22:13 +0100 Subject: [PATCH 110/125] simplify insertion code (#104) * simplify insertion code * restore use of `comp` avoid instance lookup overhead --- src/Data/Map.purs | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index f11e830e..ea134a87 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -274,37 +274,37 @@ data KickUp k v = KickUp (Map k v) k v (Map k v) -- | Insert or replace a key/value pair in a map insert :: forall k v. Ord k => k -> v -> Map k v -> Map k v -insert = down Nil +insert k v = down Nil where comp :: k -> k -> Ordering comp = compare - down :: List (TreeContext k v) -> k -> v -> Map k v -> Map k v - down ctx k v Leaf = up ctx (KickUp Leaf k v Leaf) - down ctx k v (Two left k1 v1 right) = + down :: List (TreeContext k v) -> Map k v -> Map k v + down ctx Leaf = up ctx (KickUp Leaf k v Leaf) + down ctx (Two left k1 v1 right) = case comp k k1 of EQ -> fromZipper ctx (Two left k v right) - LT -> down (Cons (TwoLeft k1 v1 right) ctx) k v left - _ -> down (Cons (TwoRight left k1 v1) ctx) k v right - down ctx k v (Three left k1 v1 mid k2 v2 right) = + LT -> down (Cons (TwoLeft k1 v1 right) ctx) left + _ -> down (Cons (TwoRight left k1 v1) ctx) right + down ctx (Three left k1 v1 mid k2 v2 right) = case comp k k1 of EQ -> fromZipper ctx (Three left k v mid k2 v2 right) c1 -> case c1, comp k k2 of _ , EQ -> fromZipper ctx (Three left k1 v1 mid k v right) - LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) k v left - GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) k v mid - _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) k v right + LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) left + GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) mid + _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right up :: List (TreeContext k v) -> KickUp k v -> Map k v - up Nil (KickUp left k v right) = Two left k v right + up Nil (KickUp left k' v' right) = Two left k' v' right up (Cons x ctx) kup = case x, kup of - TwoLeft k1 v1 right, KickUp left k v mid -> fromZipper ctx (Three left k v mid k1 v1 right) - TwoRight left k1 v1, KickUp mid k v right -> fromZipper ctx (Three left k1 v1 mid k v right) - ThreeLeft k1 v1 c k2 v2 d, KickUp a k v b -> up ctx (KickUp (Two a k v b) k1 v1 (Two c k2 v2 d)) - ThreeMiddle a k1 v1 k2 v2 d, KickUp b k v c -> up ctx (KickUp (Two a k1 v1 b) k v (Two c k2 v2 d)) - ThreeRight a k1 v1 b k2 v2, KickUp c k v d -> up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k v d)) + TwoLeft k1 v1 right, KickUp left k' v' mid -> fromZipper ctx (Three left k' v' mid k1 v1 right) + TwoRight left k1 v1, KickUp mid k' v' right -> fromZipper ctx (Three left k1 v1 mid k' v' right) + ThreeLeft k1 v1 c k2 v2 d, KickUp a k' v' b -> up ctx (KickUp (Two a k' v' b) k1 v1 (Two c k2 v2 d)) + ThreeMiddle a k1 v1 k2 v2 d, KickUp b k' v' c -> up ctx (KickUp (Two a k1 v1 b) k' v' (Two c k2 v2 d)) + ThreeRight a k1 v1 b k2 v2, KickUp c k' v' d -> up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k' v' d)) -- | Delete a key and its corresponding value from a map. delete :: forall k v. Ord k => k -> Map k v -> Map k v From 2cd994e37179a44ec57876442d769453bbf4c787 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Sun, 4 Jun 2017 16:22:35 +0100 Subject: [PATCH 111/125] persistent map filters and isSubMap (#99) * persistent map filters and isSubMap * rename filter fns following review https://github.com/purescript/purescript-maps/pull/97#pullrequestreview-41924986 --- src/Data/Map.purs | 28 +++++++++++++++++++++++++++- test/Test/Data/Map.purs | 27 ++++++++++++++++++++++++++- 2 files changed, 53 insertions(+), 2 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index ea134a87..569ae587 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -30,19 +30,24 @@ module Data.Map , union , unionWith , unions + , isSubmap , size , mapWithKey + , filterWithKey + , filterKeys + , filter ) where import Prelude import Data.Eq (class Eq1) import Data.Foldable (foldl, foldMap, foldr, class Foldable) import Data.List (List(..), (:), length, nub) +import Data.List.Lazy as LL import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) import Data.Monoid (class Monoid) import Data.Ord (class Ord1) import Data.Traversable (traverse, class Traversable) -import Data.Tuple (Tuple(Tuple), snd) +import Data.Tuple (Tuple(Tuple), snd, uncurry) import Data.Unfoldable (class Unfoldable, unfoldr) import Partial.Unsafe (unsafePartial) @@ -461,6 +466,11 @@ union = unionWith const unions :: forall k v f. Ord k => Foldable f => f (Map k v) -> Map k v unions = foldl union empty +-- | Test whether one map contains all of the keys and values contained in another map +isSubmap :: forall k v. Ord k => Eq v => Map k v -> Map k v -> Boolean +isSubmap m1 m2 = LL.all f $ (toUnfoldable m1 :: LL.List (Tuple k v)) + where f (Tuple k v) = lookup k m2 == Just v + -- | Calculate the number of key/value pairs in a map size :: forall k v. Map k v -> Int size = length <<< values @@ -470,3 +480,19 @@ mapWithKey :: forall k v v'. (k -> v -> v') -> Map k v -> Map k v' mapWithKey _ Leaf = Leaf mapWithKey f (Two left k v right) = Two (mapWithKey f left) k (f k v) (mapWithKey f right) mapWithKey f (Three left k1 v1 mid k2 v2 right) = Three (mapWithKey f left) k1 (f k1 v1) (mapWithKey f mid) k2 (f k2 v2) (mapWithKey f right) + +-- | Filter out those key/value pairs of a map for which a predicate +-- | fails to hold. +filterWithKey :: forall k v. Ord k => (k -> v -> Boolean) -> Map k v -> Map k v +filterWithKey predicate = + fromFoldable <<< LL.filter (uncurry predicate) <<< toUnfoldable + +-- | Filter out those key/value pairs of a map for which a predicate +-- | on the key fails to hold. +filterKeys :: forall k. Ord k => (k -> Boolean) -> Map k ~> Map k +filterKeys predicate = filterWithKey $ const <<< predicate + +-- | Filter out those key/value pairs of a map for which a predicate +-- | on the value fails to hold. +filter :: forall k v. Ord k => (v -> Boolean) -> Map k v -> Map k v +filter predicate = filterWithKey $ const predicate diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index 26612d8d..d4a6a272 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -8,12 +8,13 @@ import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) +import Data.Array as A import Data.NonEmpty ((:|)) import Data.Foldable (foldl, for_, all) import Data.Function (on) import Data.List (List(Cons), groupBy, length, nubBy, singleton, sort, sortBy) import Data.Maybe (Maybe(..), fromMaybe) -import Data.Tuple (Tuple(..), fst) +import Data.Tuple (Tuple(..), fst, uncurry) import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((), (===), quickCheck, quickCheck') import Test.QuickCheck.Gen (elements, oneOf) @@ -274,3 +275,27 @@ mapTests = do toList = M.toUnfoldable :: forall k v. M.Map k v -> List (Tuple k v) resultViaLists = m # toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable in resultViaMapWithKey === resultViaLists + + log "filterWithKey gives submap" + quickCheck $ \(TestMap s :: TestMap String Int) p -> + M.isSubmap (M.filterWithKey p s) s + + log "filterWithKey keeps those keys for which predicate is true" + quickCheck $ \(TestMap s :: TestMap String Int) p -> + A.all (uncurry p) (M.toAscUnfoldable (M.filterWithKey p s) :: Array (Tuple String Int)) + + log "filterKeys gives submap" + quickCheck $ \(TestMap s :: TestMap String Int) p -> + M.isSubmap (M.filterKeys p s) s + + log "filterKeys keeps those keys for which predicate is true" + quickCheck $ \(TestMap s :: TestMap String Int) p -> + A.all p (M.keys (M.filterKeys p s)) + + log "filter gives submap" + quickCheck $ \(TestMap s :: TestMap String Int) p -> + M.isSubmap (M.filter p s) s + + log "filter keeps those values for which predicate is true" + quickCheck $ \(TestMap s :: TestMap String Int) p -> + A.all p (M.values (M.filter p s)) From 4ca48e739e98edd30ecc95e1eaf98064fb59132d Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 5 Jun 2017 17:42:42 +0100 Subject: [PATCH 112/125] Add generators for `Map` and `StrMap` --- src/Data/Map/Gen.purs | 24 ++++++++++++++++++++++++ src/Data/StrMap/Gen.purs | 23 +++++++++++++++++++++++ test/Test/Data/Map.purs | 11 ++++++----- test/Test/Data/StrMap.purs | 8 +++----- 4 files changed, 56 insertions(+), 10 deletions(-) create mode 100644 src/Data/Map/Gen.purs create mode 100644 src/Data/StrMap/Gen.purs diff --git a/src/Data/Map/Gen.purs b/src/Data/Map/Gen.purs new file mode 100644 index 00000000..6398a2db --- /dev/null +++ b/src/Data/Map/Gen.purs @@ -0,0 +1,24 @@ +module Data.Map.Gen where + +import Prelude + +import Control.Monad.Gen (class MonadGen, chooseInt, resize, sized, unfoldable) +import Control.Monad.Rec.Class (class MonadRec) +import Data.Map (Map, fromFoldable) +import Data.Tuple (Tuple(..)) +import Data.List (List) + +-- | Generates a `Map` using the specified key and value generators. +genMap + :: forall m a b + . MonadRec m + => MonadGen m + => Ord a + => m a + -> m b + -> m (Map a b) +genMap genKey genValue = sized \size -> do + newSize <- chooseInt 0 size + resize (const newSize) $ + (fromFoldable :: List (Tuple a b) -> Map a b) + <$> unfoldable (Tuple <$> genKey <*> genValue) diff --git a/src/Data/StrMap/Gen.purs b/src/Data/StrMap/Gen.purs new file mode 100644 index 00000000..f44385d2 --- /dev/null +++ b/src/Data/StrMap/Gen.purs @@ -0,0 +1,23 @@ +module Data.StrMap.Gen where + +import Prelude + +import Control.Monad.Gen (class MonadGen, chooseInt, resize, sized, unfoldable) +import Control.Monad.Rec.Class (class MonadRec) +import Data.StrMap (StrMap, fromFoldable) +import Data.Tuple (Tuple(..)) +import Data.List (List) + +-- | Generates a `StrMap` using the specified key and value generators. +genStrMap + :: forall m a + . MonadRec m + => MonadGen m + => m String + -> m a + -> m (StrMap a) +genStrMap genKey genValue = sized \size -> do + newSize <- chooseInt 0 size + resize (const newSize) $ + (fromFoldable :: List (Tuple String a) -> StrMap a) + <$> unfoldable (Tuple <$> genKey <*> genValue) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index d4a6a272..ee803345 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -1,29 +1,30 @@ module Test.Data.Map where import Prelude -import Data.List.NonEmpty as NEL -import Data.Map as M import Control.Alt ((<|>)) import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) import Data.Array as A -import Data.NonEmpty ((:|)) import Data.Foldable (foldl, for_, all) import Data.Function (on) import Data.List (List(Cons), groupBy, length, nubBy, singleton, sort, sortBy) +import Data.List.NonEmpty as NEL +import Data.Map as M +import Data.Map.Gen (genMap) import Data.Maybe (Maybe(..), fromMaybe) +import Data.NonEmpty ((:|)) import Data.Tuple (Tuple(..), fst, uncurry) import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((), (===), quickCheck, quickCheck') -import Test.QuickCheck.Gen (elements, oneOf) import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) +import Test.QuickCheck.Gen (elements, oneOf) newtype TestMap k v = TestMap (M.Map k v) instance arbTestMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (TestMap k v) where - arbitrary = TestMap <<< (M.fromFoldable :: List (Tuple k v) -> M.Map k v) <$> arbitrary + arbitrary = TestMap <$> genMap arbitrary arbitrary data SmallKey = A | B | C | D | E | F | G | H | I | J derive instance eqSmallKey :: Eq SmallKey diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 3ce6fbda..54cf3901 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -6,7 +6,6 @@ import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) - import Data.Array as A import Data.Foldable (foldl) import Data.Function (on) @@ -15,11 +14,10 @@ import Data.List.NonEmpty as NEL import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) import Data.StrMap as M -import Data.Tuple (Tuple(..), fst, uncurry) +import Data.StrMap.Gen (genStrMap) import Data.Traversable (sequence) - +import Data.Tuple (Tuple(..), fst, uncurry) import Partial.Unsafe (unsafePartial) - import Test.QuickCheck ((), quickCheck, quickCheck', (===)) import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) import Test.QuickCheck.Gen as Gen @@ -27,7 +25,7 @@ import Test.QuickCheck.Gen as Gen newtype TestStrMap v = TestStrMap (M.StrMap v) instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where - arbitrary = TestStrMap <<< (M.fromFoldable :: L.List (Tuple String v) -> M.StrMap v) <$> arbitrary + arbitrary = TestStrMap <$> genStrMap arbitrary arbitrary newtype SmallArray v = SmallArray (Array v) From 654cf9086bf003a94b8d04000d60800254112486 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 5 Jun 2017 17:47:03 +0100 Subject: [PATCH 113/125] Add `purescript-gen` dependency --- bower.json | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/bower.json b/bower.json index 4527f5a7..c3501a22 100644 --- a/bower.json +++ b/bower.json @@ -24,7 +24,8 @@ "purescript-arrays": "^4.0.0", "purescript-functions": "^3.0.0", "purescript-lists": "^4.0.0", - "purescript-st": "^3.0.0" + "purescript-st": "^3.0.0", + "purescript-gen": "^1.1.0" }, "devDependencies": { "purescript-quickcheck": "^4.0.0" From 92ac171955f535a61fc39f002d3a3ba695a70a22 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 5 Jun 2017 21:57:52 +0100 Subject: [PATCH 114/125] size in log(n) (#107) * size benchmarks addresses #101 * size through log(n) traversal addresses #100 --- bench/Bench/Data/Map.purs | 33 +++++++++++++++++++++++++++++++++ bench/Bench/Main.purs | 10 ++++++++++ bower.json | 3 ++- package.json | 6 +++++- src/Data/Map.purs | 4 +++- 5 files changed, 53 insertions(+), 3 deletions(-) create mode 100644 bench/Bench/Data/Map.purs create mode 100644 bench/Bench/Main.purs diff --git a/bench/Bench/Data/Map.purs b/bench/Bench/Data/Map.purs new file mode 100644 index 00000000..a92d014a --- /dev/null +++ b/bench/Bench/Data/Map.purs @@ -0,0 +1,33 @@ +module Bench.Data.Map where + +import Prelude +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE, log) +import Performance.Minibench (bench, benchWith) + +import Data.Tuple (Tuple(..)) +import Data.List as L +import Data.Map as M + +benchMap :: Eff (console :: CONSOLE) Unit +benchMap = benchSize + where + benchSize = do + let nats = L.range 0 999999 + natPairs = (flip Tuple) unit <$> nats + singletonMap = M.singleton 0 unit + smallMap = M.fromFoldable $ L.take 100 natPairs + midMap = M.fromFoldable $ L.take 10000 natPairs + bigMap = M.fromFoldable $ natPairs + + log "size: singleton map" + bench \_ -> M.size singletonMap + + log $ "size: small map (" <> show (M.size smallMap) <> ")" + bench \_ -> M.size smallMap + + log $ "size: midsize map (" <> show (M.size midMap) <> ")" + benchWith 100 \_ -> M.size midMap + + log $ "size: big map (" <> show (M.size bigMap) <> ")" + benchWith 10 \_ -> M.size bigMap diff --git a/bench/Bench/Main.purs b/bench/Bench/Main.purs new file mode 100644 index 00000000..be3c4332 --- /dev/null +++ b/bench/Bench/Main.purs @@ -0,0 +1,10 @@ +module Bench.Main where + +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE) +import Data.Unit (Unit) + +import Bench.Data.Map (benchMap) + +main :: Eff (console :: CONSOLE) Unit +main = benchMap diff --git a/bower.json b/bower.json index c3501a22..ae41f4ae 100644 --- a/bower.json +++ b/bower.json @@ -28,6 +28,7 @@ "purescript-gen": "^1.1.0" }, "devDependencies": { - "purescript-quickcheck": "^4.0.0" + "purescript-quickcheck": "^4.0.0", + "purescript-minibench": "^1.0.0" } } diff --git a/package.json b/package.json index 132cefcd..0373d0c9 100644 --- a/package.json +++ b/package.json @@ -3,7 +3,11 @@ "scripts": { "clean": "rimraf output && rimraf .pulp-cache", "build": "eslint src && pulp build -- --censor-lib --strict", - "test": "pulp test" + "test": "pulp test", + + "bench:build": "purs compile 'bench/**/*.purs' 'src/**/*.purs' 'bower_components/*/src/**/*.purs'", + "bench:run": "node -e 'require(\"./output/Bench.Main/index.js\").main()'", + "bench": "npm run bench:build && npm run bench:run" }, "devDependencies": { "eslint": "^3.17.1", diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 569ae587..220441d0 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -473,7 +473,9 @@ isSubmap m1 m2 = LL.all f $ (toUnfoldable m1 :: LL.List (Tuple k v)) -- | Calculate the number of key/value pairs in a map size :: forall k v. Map k v -> Int -size = length <<< values +size Leaf = 0 +size (Two m1 _ _ m2) = 1 + size m1 + size m2 +size (Three m1 _ _ m2 _ _ m3) = 2 + size m1 + size m2 + size m3 -- | Apply a function of two arguments to each key/value pair, producing a new map mapWithKey :: forall k v v'. (k -> v -> v') -> Map k v -> Map k v' From d5ec2b36324de3347c2082ded6b92dbea112e239 Mon Sep 17 00:00:00 2001 From: Andreas Schacker Date: Tue, 6 Jun 2017 19:27:11 +0200 Subject: [PATCH 115/125] Export `toArrayWithKey` function --- src/Data/StrMap.js | 6 +++--- src/Data/StrMap.purs | 11 ++++++----- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js index 13d81e4e..ab82f990 100644 --- a/src/Data/StrMap.js +++ b/src/Data/StrMap.js @@ -106,7 +106,7 @@ exports._lookupST = function (no, yes, k, m) { }; }; -function _collect(f) { +function toArrayWithKey(f) { return function (m) { var r = []; for (var k in m) { @@ -118,8 +118,8 @@ function _collect(f) { }; } -exports._collect = _collect; +exports.toArrayWithKey = toArrayWithKey; -exports.keys = Object.keys || _collect(function (k) { +exports.keys = Object.keys || toArrayWithKey(function (k) { return function () { return k; }; }); diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index e5c0b798..9105106d 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -39,6 +39,7 @@ module Data.StrMap , freezeST , runST , pureST + , toArrayWithKey ) where import Prelude @@ -219,27 +220,27 @@ fromFoldableWith f l = pureST (do for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s >>= SM.poke s k) pure s) -foreign import _collect :: forall a b . (String -> a -> b) -> StrMap a -> Array b +foreign import toArrayWithKey :: forall a b . (String -> a -> b) -> StrMap a -> Array b -- | Unfolds a map into a list of key/value pairs toUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a) -toUnfoldable = A.toUnfoldable <<< _collect Tuple +toUnfoldable = A.toUnfoldable <<< toArrayWithKey Tuple -- | Unfolds a map into a list of key/value pairs which is guaranteed to be -- | sorted by key toAscUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a) -toAscUnfoldable = A.toUnfoldable <<< A.sortWith fst <<< _collect Tuple +toAscUnfoldable = A.toUnfoldable <<< A.sortWith fst <<< toArrayWithKey Tuple -- Internal toArray :: forall a. StrMap a -> Array (Tuple String a) -toArray = _collect Tuple +toArray = toArrayWithKey Tuple -- | Get an array of the keys in a map foreign import keys :: forall a. StrMap a -> Array String -- | Get a list of the values in a map values :: forall a. StrMap a -> Array a -values = _collect (\_ v -> v) +values = toArrayWithKey (\_ v -> v) -- | Compute the union of two maps, preferring the first map in the case of -- | duplicate keys. From 9365860172643e88d228b46957a4d10375b300b6 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Wed, 7 Jun 2017 21:00:13 +0100 Subject: [PATCH 116/125] stack-safe fromFoldable (#110) with benchmarks that reflect no performance degradation addresses #108 --- bench/Bench/Data/Map.purs | 24 +++++++++++++++++++++++- bench/Bench/Data/StrMap.purs | 27 +++++++++++++++++++++++++++ bench/Bench/Main.purs | 17 ++++++++++++++--- src/Data/StrMap.purs | 8 ++++---- 4 files changed, 68 insertions(+), 8 deletions(-) create mode 100644 bench/Bench/Data/StrMap.purs diff --git a/bench/Bench/Data/Map.purs b/bench/Bench/Data/Map.purs index a92d014a..a2197fc7 100644 --- a/bench/Bench/Data/Map.purs +++ b/bench/Bench/Data/Map.purs @@ -10,8 +10,19 @@ import Data.List as L import Data.Map as M benchMap :: Eff (console :: CONSOLE) Unit -benchMap = benchSize +benchMap = do + log "size" + log "---------------" + benchSize + + log "" + + log "fromFoldable" + log "------------" + benchFromFoldable + where + benchSize = do let nats = L.range 0 999999 natPairs = (flip Tuple) unit <$> nats @@ -31,3 +42,14 @@ benchMap = benchSize log $ "size: big map (" <> show (M.size bigMap) <> ")" benchWith 10 \_ -> M.size bigMap + + benchFromFoldable = do + let natStrs = show <$> L.range 0 99999 + natPairs = (flip Tuple) unit <$> natStrs + shortPairList = L.take 10000 natPairs + + log $ "fromFoldable (" <> show (L.length shortPairList) <> ")" + benchWith 100 \_ -> M.fromFoldable shortPairList + + log $ "fromFoldable (" <> show (L.length natPairs) <> ")" + benchWith 10 \_ -> M.fromFoldable natPairs diff --git a/bench/Bench/Data/StrMap.purs b/bench/Bench/Data/StrMap.purs new file mode 100644 index 00000000..1c7f419a --- /dev/null +++ b/bench/Bench/Data/StrMap.purs @@ -0,0 +1,27 @@ +module Bench.Data.StrMap where + +import Prelude +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE, log) +import Performance.Minibench (benchWith) + +import Data.Tuple (Tuple(..)) +import Data.List as L +import Data.StrMap as M + +benchStrMap :: Eff (console :: CONSOLE) Unit +benchStrMap = do + log "fromFoldable" + benchFromFoldable + + where + benchFromFoldable = do + let natStrs = show <$> L.range 0 99999 + natPairs = (flip Tuple) unit <$> natStrs + shortPairList = L.take 10000 natPairs + + log $ "fromFoldable (" <> show (L.length shortPairList) <> ")" + benchWith 100 \_ -> M.fromFoldable shortPairList + + log $ "fromFoldable (" <> show (L.length natPairs) <> ")" + benchWith 10 \_ -> M.fromFoldable natPairs diff --git a/bench/Bench/Main.purs b/bench/Bench/Main.purs index be3c4332..f8f641b0 100644 --- a/bench/Bench/Main.purs +++ b/bench/Bench/Main.purs @@ -1,10 +1,21 @@ module Bench.Main where +import Prelude import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (CONSOLE) -import Data.Unit (Unit) +import Control.Monad.Eff.Console (CONSOLE, log) import Bench.Data.Map (benchMap) +import Bench.Data.StrMap (benchStrMap) main :: Eff (console :: CONSOLE) Unit -main = benchMap +main = do + log "Map" + log "===" + benchMap + + log "" + + + log "StrMap" + log "======" + benchStrMap diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index e5c0b798..b5c2727c 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -43,7 +43,7 @@ module Data.StrMap import Prelude -import Control.Monad.Eff (Eff, runPure) +import Control.Monad.Eff (Eff, runPure, foreachE) import Control.Monad.ST as ST import Data.Array as A @@ -204,10 +204,10 @@ update f k m = alter (maybe Nothing f) k m -- | Create a map from a foldable collection of key/value pairs fromFoldable :: forall f a. Foldable f => f (Tuple String a) -> StrMap a -fromFoldable l = pureST (do +fromFoldable l = pureST do s <- SM.new - for_ l (\(Tuple k v) -> SM.poke s k v) - pure s) + foreachE (A.fromFoldable l) \(Tuple k v) -> void (SM.poke s k v) + pure s foreign import _lookupST :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z) From e52b2f111afb3a12135697bd0914d62132aec149 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Fri, 7 Jul 2017 18:25:20 +0100 Subject: [PATCH 117/125] Add `foldSubmap` and `submap` Addresses #71 and #113. --- src/Data/Map.purs | 107 +++++++++++++++++++++++++++++++++++++++- test/Test/Data/Map.purs | 35 ++++++++++++- 2 files changed, 140 insertions(+), 2 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 220441d0..acbd491a 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -16,6 +16,8 @@ module Data.Map , lookupGT , findMin , findMax + , foldSubmap + , submap , fromFoldable , fromFoldableWith , toUnfoldable @@ -44,7 +46,7 @@ import Data.Foldable (foldl, foldMap, foldr, class Foldable) import Data.List (List(..), (:), length, nub) import Data.List.Lazy as LL import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) -import Data.Monoid (class Monoid) +import Data.Monoid (class Monoid, mempty) import Data.Ord (class Ord1) import Data.Traversable (traverse, class Traversable) import Data.Tuple (Tuple(Tuple), snd, uncurry) @@ -254,6 +256,109 @@ findMin Leaf = Nothing findMin (Two left k1 v1 _) = Just $ fromMaybe { key: k1, value: v1 } $ findMin left findMin (Three left k1 v1 _ _ _ _) = Just $ fromMaybe { key: k1, value: v1 } $ findMin left +-- | Fold over the entries of a given map where the key is between a lower and +-- | an upper bound. Passing `Nothing` as either the lower or upper bound +-- | argument means that the fold has no lower or upper bound, i.e. the fold +-- | starts from (or ends with) the smallest (or largest) key in the map. +-- | +-- | ```purescript +-- | foldSubmap (Just 1) (Just 2) (\_ v -> [v]) +-- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) +-- | == ["one", "two"] +-- | +-- | foldSubmap Nothing (Just 2) (\_ v -> [v]) +-- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) +-- | == ["zero", "one", "two"] +-- | ``` +foldSubmap :: forall k v m. Ord k => Monoid m => Maybe k -> Maybe k -> (k -> v -> m) -> Map k v -> m +foldSubmap kmin kmax f = + let + tooSmall = + case kmin of + Just kmin' -> + \k -> k < kmin' + Nothing -> + const false + + tooLarge = + case kmax of + Just kmax' -> + \k -> k > kmax' + Nothing -> + const false + + inBounds = + case kmin, kmax of + Just kmin', Just kmax' -> + \k -> kmin' <= k && k <= kmax' + Just kmin', Nothing -> + \k -> kmin' <= k + Nothing, Just kmax' -> + \k -> k <= kmax' + Nothing, Nothing -> + const true + + -- We can take advantage of the invariants of the tree structure to reduce + -- the amount of work we need to do. For example, in the following tree: + -- + -- [2][4] + -- / | \ + -- / | \ + -- [1] [3] [5] + -- + -- If we are given a lower bound of 3, we do not need to inspect the left + -- subtree, because we know that every entry in it is less than or equal to + -- 2. Similarly, if we are given a lower bound of 5, we do not need to + -- inspect the central subtree, because we know that every entry in it must + -- be less than or equal to 4. + -- + -- Unfortunately we cannot extract `if cond then x else mempty` into a + -- function because of strictness. + go = case _ of + Leaf -> + mempty + Two left k v right -> + (if tooSmall k then mempty else go left) + <> (if inBounds k then f k v else mempty) + <> (if tooLarge k then mempty else go right) + Three left k1 v1 mid k2 v2 right -> + (if tooSmall k1 then mempty else go left) + <> (if inBounds k1 then f k1 v1 else mempty) + <> (if tooSmall k2 || tooLarge k1 then mempty else go mid) + <> (if inBounds k2 then f k2 v2 else mempty) + <> (if tooLarge k2 then mempty else go right) + in + go + +-- | Returns a new map containing all entries of the given map which lie +-- | between a given lower and upper bound, treating `Nothing` as no bound i.e. +-- | including the smallest (or largest) key in the map, no matter how small +-- | (or large) it is. For example: +-- | +-- | ```purescript +-- | submap (Just 1) (Just 2) +-- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) +-- | == fromFoldable [Tuple 1 "one", Tuple 2 "two"] +-- | +-- | submap Nothing (Just 2) +-- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) +-- | == fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two"] +-- | ``` +-- | +-- | The function is entirely specified by the following +-- | property: +-- | +-- | ```purescript +-- | Given any m :: Map k v, mmin :: Maybe k, mmax :: Maybe k, key :: k, +-- | let m' = submap mmin mmax m in +-- | if (maybe true (\min -> min <= key) mmin && +-- | maybe true (\max -> max >= key) mmax) +-- | then lookup key m == lookup key m' +-- | else not (member key m') +-- | ``` +submap :: forall k v. Ord k => Maybe k -> Maybe k -> Map k v -> Map k v +submap kmin kmax = foldSubmap kmin kmax singleton + -- | Test if a key is a member of a map member :: forall k v. Ord k => k -> Map k v -> Boolean member k m = isJust (k `lookup` m) diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs index ee803345..bc38e615 100644 --- a/test/Test/Data/Map.purs +++ b/test/Test/Data/Map.purs @@ -13,7 +13,7 @@ import Data.List (List(Cons), groupBy, length, nubBy, singleton, sort, sortBy) import Data.List.NonEmpty as NEL import Data.Map as M import Data.Map.Gen (genMap) -import Data.Maybe (Maybe(..), fromMaybe) +import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.NonEmpty ((:|)) import Data.Tuple (Tuple(..), fst, uncurry) import Partial.Unsafe (unsafePartial) @@ -300,3 +300,36 @@ mapTests = do log "filter keeps those values for which predicate is true" quickCheck $ \(TestMap s :: TestMap String Int) p -> A.all p (M.values (M.filter p s)) + + log "submap with no bounds = id" + quickCheck \(TestMap m :: TestMap SmallKey Int) -> + M.submap Nothing Nothing m === m + + log "submap with lower bound" + quickCheck' 1 $ + M.submap (Just B) Nothing (M.fromFoldable [Tuple A 0, Tuple B 0]) + == M.fromFoldable [Tuple B 0] + + log "submap with upper bound" + quickCheck' 1 $ + M.submap Nothing (Just A) (M.fromFoldable [Tuple A 0, Tuple B 0]) + == M.fromFoldable [Tuple A 0] + + log "submap with lower & upper bound" + quickCheck' 1 $ + M.submap (Just B) (Just B) (M.fromFoldable [Tuple A 0, Tuple B 0, Tuple C 0]) + == M.fromFoldable [Tuple B 0] + + log "submap" + quickCheck' 1000 \(TestMap m :: TestMap SmallKey Int) mmin mmax key -> + let + m' = M.submap mmin mmax m + in + (if (maybe true (\min -> min <= key) mmin && + maybe true (\max -> max >= key) mmax) + then M.lookup key m == M.lookup key m' + else (not (M.member key m'))) + "m: " <> show m + <> ", mmin: " <> show mmin + <> ", mmax: " <> show mmax + <> ", key: " <> show key From b1f24755cab76ad1388acde48ebc737ae3e57d75 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sun, 9 Jul 2017 21:20:17 +0100 Subject: [PATCH 118/125] v3.4.0 From 9de5651d6319b68d2b2bfacc912a0078524caab6 Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Mon, 31 Jul 2017 02:32:45 -0400 Subject: [PATCH 119/125] Add *WithIndex instances for StrMap --- src/Data/StrMap.purs | 19 +++++++++++++++++-- test/Test/Data/StrMap.purs | 37 ++++++++++++++++++++++++++++++++++--- 2 files changed, 51 insertions(+), 5 deletions(-) diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs index 78d35973..3b57a4a7 100644 --- a/src/Data/StrMap.purs +++ b/src/Data/StrMap.purs @@ -50,12 +50,15 @@ import Control.Monad.ST as ST import Data.Array as A import Data.Eq (class Eq1) import Data.Foldable (class Foldable, foldl, foldr, for_) +import Data.FoldableWithIndex (class FoldableWithIndex) import Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4) +import Data.FunctorWithIndex (class FunctorWithIndex) import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Monoid (class Monoid, mempty) import Data.StrMap.ST as SM import Data.Traversable (class Traversable, traverse) -import Data.Tuple (Tuple(..), fst) +import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) +import Data.Tuple (Tuple(..), fst, uncurry) import Data.Unfoldable (class Unfoldable) -- | `StrMap a` represents a map from `String`s to values of type `a`. @@ -91,6 +94,9 @@ foreign import _fmapStrMap :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b) instance functorStrMap :: Functor StrMap where map f m = runFn2 _fmapStrMap m f +instance functorWithIndexStrMap :: FunctorWithIndex String StrMap where + mapWithIndex = mapWithKey + foreign import _foldM :: forall a m z. (m -> (z -> m) -> m) -> (z -> String -> a -> m) -> m -> StrMap a -> m -- | Fold the keys and values of a map @@ -112,10 +118,19 @@ instance foldableStrMap :: Foldable StrMap where foldr f z m = foldr f z (values m) foldMap f = foldMap (const f) +instance foldableWithIndexStrMap :: FoldableWithIndex String StrMap where + foldlWithIndex f = fold (flip f) + foldrWithIndex f z m = foldr (uncurry f) z (toArrayWithKey Tuple m) + foldMapWithIndex = foldMap + instance traversableStrMap :: Traversable StrMap where - traverse f ms = fold (\acc k v -> insert k <$> f v <*> acc) (pure empty) ms + traverse = traverseWithIndex <<< const sequence = traverse id +instance traversableWithIndexStrMap :: TraversableWithIndex String StrMap where + traverseWithIndex f ms = + fold (\acc k v -> flip (insert k) <$> acc <*> f k v) (pure empty) ms + -- Unfortunately the above are not short-circuitable (consider using purescript-machines) -- so we need special cases: diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs index 54cf3901..ae4ba00d 100644 --- a/test/Test/Data/StrMap.purs +++ b/test/Test/Data/StrMap.purs @@ -6,8 +6,10 @@ import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (log, CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) +import Control.Monad.Writer (runWriter, tell) import Data.Array as A -import Data.Foldable (foldl) +import Data.Foldable (foldl, foldr) +import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex, foldMapWithIndex) import Data.Function (on) import Data.List as L import Data.List.NonEmpty as NEL @@ -15,8 +17,9 @@ import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) import Data.StrMap as M import Data.StrMap.Gen (genStrMap) -import Data.Traversable (sequence) -import Data.Tuple (Tuple(..), fst, uncurry) +import Data.Traversable (sequence, traverse) +import Data.TraversableWithIndex (traverseWithIndex) +import Data.Tuple (Tuple(..), fst, snd, uncurry) import Partial.Unsafe (unsafePartial) import Test.QuickCheck ((), quickCheck, quickCheck', (===)) import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) @@ -198,6 +201,34 @@ strMapTests = do resultViaLists = m # M.toUnfoldable # map (\(Tuple k v) → Tuple k (f k v)) # (M.fromFoldable :: forall a. L.List (Tuple String a) -> M.StrMap a) in resultViaMapWithKey === resultViaLists + log "foldl = foldlWithIndex <<< const" + quickCheck \(TestStrMap m :: TestStrMap String) -> + let f z v = z <> "," <> v + in foldl f "" m === foldlWithIndex (const f) "" m + + log "foldr = foldrWithIndex <<< const" + quickCheck \(TestStrMap m :: TestStrMap String) -> + let f v z = v <> "," <> z + in foldr f "" m === foldrWithIndex (const f) "" m + + log "foldlWithIndex = foldrWithIndex with flipped operation" + quickCheck \(TestStrMap m :: TestStrMap String) -> + let f k z v = z <> "," <> k <> ":" <> v + g k v z = k <> ":" <> v <> "," <> z + in foldlWithIndex f "" m <> "," === "," <> foldrWithIndex g "" m + + log "foldMapWithIndex f ~ traverseWithIndex (\\k v -> tell (f k v))" + quickCheck \(TestStrMap m :: TestStrMap Int) -> + let f k v = "(" <> "k" <> "," <> show v <> ")" + resultA = foldMapWithIndex f m + resultB = snd (runWriter (traverseWithIndex (\k v -> tell (f k v)) m)) + in resultA === resultB + + log "traverse = traverseWithIndex <<< const (for m = Writer)" + quickCheck \(TestStrMap m :: TestStrMap String) -> + runWriter (traverse tell m) === + runWriter (traverseWithIndex (const tell) m) + log "sequence works (for m = Array)" quickCheck \(TestStrMap mOfSmallArrays :: TestStrMap (SmallArray Int)) -> let m = (\(SmallArray a) -> a) <$> mOfSmallArrays From 8161d1c85fd3def03d9fbf6a9045ed53d4d9c8db Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Mon, 31 Jul 2017 20:01:45 +0100 Subject: [PATCH 120/125] v3.5.0 From e6cf057c36078069a7457e8f9a0a78b84a670a0c Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Sat, 5 Aug 2017 14:49:22 -0700 Subject: [PATCH 121/125] Use foldable-traversable^3.4.0 (#120) --- bower.json | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/bower.json b/bower.json index ae41f4ae..9138d9d4 100644 --- a/bower.json +++ b/bower.json @@ -25,7 +25,8 @@ "purescript-functions": "^3.0.0", "purescript-lists": "^4.0.0", "purescript-st": "^3.0.0", - "purescript-gen": "^1.1.0" + "purescript-gen": "^1.1.0", + "purescript-foldable-traversable": "^3.4.0" }, "devDependencies": { "purescript-quickcheck": "^4.0.0", From 0e44e99e74226cd116929808186fd790b76893f0 Mon Sep 17 00:00:00 2001 From: rightfold Date: Thu, 24 Aug 2017 21:54:05 +0200 Subject: [PATCH 122/125] Make findMin and findMax tail-recursive (#122) --- src/Data/Map.purs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/Data/Map.purs b/src/Data/Map.purs index acbd491a..69cec393 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -246,15 +246,19 @@ lookupGT k = go -- | Returns the pair with the greatest key findMax :: forall k v. Map k v -> Maybe { key :: k, value :: v } -findMax Leaf = Nothing -findMax (Two _ k1 v1 right) = Just $ fromMaybe { key: k1, value: v1 } $ findMax right -findMax (Three _ _ _ _ k2 v2 right) = Just $ fromMaybe { key: k2, value: v2 } $ findMax right +findMax = go Nothing + where + go acc Leaf = acc + go _ (Two _ k1 v1 right) = go (Just { key: k1, value: v1 }) right + go _ (Three _ _ _ _ k2 v2 right) = go (Just { key: k2, value: v2 }) right -- | Returns the pair with the least key findMin :: forall k v. Map k v -> Maybe { key :: k, value :: v } -findMin Leaf = Nothing -findMin (Two left k1 v1 _) = Just $ fromMaybe { key: k1, value: v1 } $ findMin left -findMin (Three left k1 v1 _ _ _ _) = Just $ fromMaybe { key: k1, value: v1 } $ findMin left +findMin = go Nothing + where + go acc Leaf = acc + go _ (Two left k1 v1 _) = go (Just { key: k1, value: v1 }) left + go _ (Three left k1 v1 _ _ _ _) = go (Just { key: k1, value: v1 }) left -- | Fold over the entries of a given map where the key is between a lower and -- | an upper bound. Passing `Nothing` as either the lower or upper bound From a4ebe6aed7b2849d14d0f236b5d783896baf2fdc Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 30 Nov 2017 12:30:28 +0000 Subject: [PATCH 123/125] Add Functor/Foldable/TraversableWithIndex for Map (#126) * Add Functor/Foldable/TraversableWithIndex for Map * Don't use unicode --- bower.json | 2 +- src/Data/Map.purs | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 1 deletion(-) diff --git a/bower.json b/bower.json index 9138d9d4..bbcda159 100644 --- a/bower.json +++ b/bower.json @@ -26,7 +26,7 @@ "purescript-lists": "^4.0.0", "purescript-st": "^3.0.0", "purescript-gen": "^1.1.0", - "purescript-foldable-traversable": "^3.4.0" + "purescript-foldable-traversable": "^3.6.1" }, "devDependencies": { "purescript-quickcheck": "^4.0.0", diff --git a/src/Data/Map.purs b/src/Data/Map.purs index 69cec393..e764370b 100644 --- a/src/Data/Map.purs +++ b/src/Data/Map.purs @@ -41,14 +41,18 @@ module Data.Map ) where import Prelude + import Data.Eq (class Eq1) import Data.Foldable (foldl, foldMap, foldr, class Foldable) +import Data.FoldableWithIndex (class FoldableWithIndex) +import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) import Data.List (List(..), (:), length, nub) import Data.List.Lazy as LL import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) import Data.Monoid (class Monoid, mempty) import Data.Ord (class Ord1) import Data.Traversable (traverse, class Traversable) +import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) import Data.Tuple (Tuple(Tuple), snd, uncurry) import Data.Unfoldable (class Unfoldable, unfoldr) import Partial.Unsafe (unsafePartial) @@ -89,11 +93,24 @@ instance functorMap :: Functor (Map k) where map f (Two left k v right) = Two (map f left) k (f v) (map f right) map f (Three left k1 v1 mid k2 v2 right) = Three (map f left) k1 (f v1) (map f mid) k2 (f v2) (map f right) +instance functorWithIndexMap :: FunctorWithIndex k (Map k) where + mapWithIndex _ Leaf = Leaf + mapWithIndex f (Two left k v right) = Two (mapWithIndex f left) k (f k v) (mapWithIndex f right) + mapWithIndex f (Three left k1 v1 mid k2 v2 right) = Three (mapWithIndex f left) k1 (f k1 v1) (mapWithIndex f mid) k2 (f k2 v2) (mapWithIndex f right) + instance foldableMap :: Foldable (Map k) where foldl f z m = foldl f z (values m) foldr f z m = foldr f z (values m) foldMap f m = foldMap f (values m) +instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where + foldlWithIndex f z m = foldl (uncurry <<< (flip f)) z $ asList $ toUnfoldable m + foldrWithIndex f z m = foldr (uncurry f) z $ asList $ toUnfoldable m + foldMapWithIndex f m = foldMap (uncurry f) $ asList $ toUnfoldable m + +asList :: forall k v. List (Tuple k v) -> List (Tuple k v) +asList = id + instance traversableMap :: Traversable (Map k) where traverse f Leaf = pure Leaf traverse f (Two left k v right) = @@ -111,6 +128,22 @@ instance traversableMap :: Traversable (Map k) where <*> traverse f right sequence = traverse id +instance traversableWithIndexMap :: TraversableWithIndex k (Map k) where + traverseWithIndex f Leaf = pure Leaf + traverseWithIndex f (Two left k v right) = + Two <$> traverseWithIndex f left + <*> pure k + <*> f k v + <*> traverseWithIndex f right + traverseWithIndex f (Three left k1 v1 mid k2 v2 right) = + Three <$> traverseWithIndex f left + <*> pure k1 + <*> f k1 v1 + <*> traverseWithIndex f mid + <*> pure k2 + <*> f k2 v2 + <*> traverseWithIndex f right + -- | Render a `Map` as a `String` showTree :: forall k v. Show k => Show v => Map k v -> String showTree Leaf = "Leaf" From e4244946e27c2bb838828b282843ba4e2e3f1690 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 30 Nov 2017 12:30:57 +0000 Subject: [PATCH 124/125] Update .gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 7050558b..709fd096 100644 --- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ !/.gitignore !/.eslintrc.json !/.travis.yml +package-lock.json /bower_components/ /node_modules/ /output/ From fb6d610613e720ea6b05b8d8a27ae5cf210cea08 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 6 Jun 2018 20:38:23 +0100 Subject: [PATCH 125/125] Add deprecation notice --- .eslintrc.json | 28 -- .gitignore | 8 - .travis.yml | 23 -- LICENSE | 21 -- README.md | 17 +- bench/Bench/Data/Map.purs | 55 --- bench/Bench/Data/StrMap.purs | 27 -- bench/Bench/Main.purs | 21 -- bower.json | 35 -- package.json | 18 - src/Data/Map.purs | 642 --------------------------------- src/Data/Map/Gen.purs | 24 -- src/Data/StrMap.js | 125 ------- src/Data/StrMap.purs | 302 ---------------- src/Data/StrMap/Gen.purs | 23 -- src/Data/StrMap/ST.js | 37 -- src/Data/StrMap/ST.purs | 37 -- src/Data/StrMap/ST/Unsafe.js | 7 - src/Data/StrMap/ST/Unsafe.purs | 11 - src/Data/StrMap/Unsafe.js | 7 - src/Data/StrMap/Unsafe.purs | 10 - test/Test/Data/Map.purs | 335 ----------------- test/Test/Data/StrMap.purs | 252 ------------- test/Test/Main.purs | 19 - 24 files changed, 3 insertions(+), 2081 deletions(-) delete mode 100644 .eslintrc.json delete mode 100644 .gitignore delete mode 100644 .travis.yml delete mode 100644 LICENSE delete mode 100644 bench/Bench/Data/Map.purs delete mode 100644 bench/Bench/Data/StrMap.purs delete mode 100644 bench/Bench/Main.purs delete mode 100644 bower.json delete mode 100644 package.json delete mode 100644 src/Data/Map.purs delete mode 100644 src/Data/Map/Gen.purs delete mode 100644 src/Data/StrMap.js delete mode 100644 src/Data/StrMap.purs delete mode 100644 src/Data/StrMap/Gen.purs delete mode 100644 src/Data/StrMap/ST.js delete mode 100644 src/Data/StrMap/ST.purs delete mode 100644 src/Data/StrMap/ST/Unsafe.js delete mode 100644 src/Data/StrMap/ST/Unsafe.purs delete mode 100644 src/Data/StrMap/Unsafe.js delete mode 100644 src/Data/StrMap/Unsafe.purs delete mode 100644 test/Test/Data/Map.purs delete mode 100644 test/Test/Data/StrMap.purs delete mode 100644 test/Test/Main.purs diff --git a/.eslintrc.json b/.eslintrc.json deleted file mode 100644 index 84cef4f0..00000000 --- a/.eslintrc.json +++ /dev/null @@ -1,28 +0,0 @@ -{ - "parserOptions": { - "ecmaVersion": 5 - }, - "extends": "eslint:recommended", - "env": { - "commonjs": true - }, - "rules": { - "strict": [2, "global"], - "block-scoped-var": 2, - "consistent-return": 2, - "eqeqeq": [2, "smart"], - "guard-for-in": 2, - "no-caller": 2, - "no-extend-native": 2, - "no-loop-func": 2, - "no-new": 2, - "no-param-reassign": 2, - "no-return-assign": 2, - "no-unused-expressions": 2, - "no-use-before-define": 2, - "radix": [2, "always"], - "indent": [2, 2], - "quotes": [2, "double"], - "semi": [2, "always"] - } -} diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 709fd096..00000000 --- a/.gitignore +++ /dev/null @@ -1,8 +0,0 @@ -/.* -!/.gitignore -!/.eslintrc.json -!/.travis.yml -package-lock.json -/bower_components/ -/node_modules/ -/output/ diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 4cbd5fde..00000000 --- a/.travis.yml +++ /dev/null @@ -1,23 +0,0 @@ -language: node_js -dist: trusty -sudo: required -node_js: stable -env: - - PATH=$HOME/purescript:$PATH -install: - - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p') - - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz - - tar -xvf $HOME/purescript.tar.gz -C $HOME/ - - chmod a+x $HOME/purescript - - npm install -g bower - - npm install -script: - - bower install --production - - npm run -s build - - bower install - - npm -s test -after_success: -- >- - test $TRAVIS_TAG && - echo $GITHUB_TOKEN | pulp login && - echo y | pulp publish --no-push diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 94158580..00000000 --- a/LICENSE +++ /dev/null @@ -1,21 +0,0 @@ -The MIT License (MIT) - -Copyright (c) 2014 PureScript - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. \ No newline at end of file diff --git a/README.md b/README.md index 1c8d27c5..68b23cff 100644 --- a/README.md +++ b/README.md @@ -1,16 +1,5 @@ -# purescript-maps +# DEPRECATED -[![Latest release](http://img.shields.io/github/release/purescript/purescript-maps.svg)](https://github.com/purescript/purescript-maps/releases) -[![Build status](https://travis-ci.org/purescript/purescript-maps.svg?branch=master)](https://travis-ci.org/purescript/purescript-maps) +The library is no longer maintained under this repository, it has been merged into to [`purescript-ordered-collections`](https://github.com/purescript/purescript-ordered-collections). -Purely-functional map data structures. - -## Installation - -``` -bower install purescript-maps -``` - -## Documentation - -Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-maps). +[The previous releases](https://github.com/purescript-deprecated/purescript-maps/releases) will continue to work for older libraries that still depend on them. diff --git a/bench/Bench/Data/Map.purs b/bench/Bench/Data/Map.purs deleted file mode 100644 index a2197fc7..00000000 --- a/bench/Bench/Data/Map.purs +++ /dev/null @@ -1,55 +0,0 @@ -module Bench.Data.Map where - -import Prelude -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (CONSOLE, log) -import Performance.Minibench (bench, benchWith) - -import Data.Tuple (Tuple(..)) -import Data.List as L -import Data.Map as M - -benchMap :: Eff (console :: CONSOLE) Unit -benchMap = do - log "size" - log "---------------" - benchSize - - log "" - - log "fromFoldable" - log "------------" - benchFromFoldable - - where - - benchSize = do - let nats = L.range 0 999999 - natPairs = (flip Tuple) unit <$> nats - singletonMap = M.singleton 0 unit - smallMap = M.fromFoldable $ L.take 100 natPairs - midMap = M.fromFoldable $ L.take 10000 natPairs - bigMap = M.fromFoldable $ natPairs - - log "size: singleton map" - bench \_ -> M.size singletonMap - - log $ "size: small map (" <> show (M.size smallMap) <> ")" - bench \_ -> M.size smallMap - - log $ "size: midsize map (" <> show (M.size midMap) <> ")" - benchWith 100 \_ -> M.size midMap - - log $ "size: big map (" <> show (M.size bigMap) <> ")" - benchWith 10 \_ -> M.size bigMap - - benchFromFoldable = do - let natStrs = show <$> L.range 0 99999 - natPairs = (flip Tuple) unit <$> natStrs - shortPairList = L.take 10000 natPairs - - log $ "fromFoldable (" <> show (L.length shortPairList) <> ")" - benchWith 100 \_ -> M.fromFoldable shortPairList - - log $ "fromFoldable (" <> show (L.length natPairs) <> ")" - benchWith 10 \_ -> M.fromFoldable natPairs diff --git a/bench/Bench/Data/StrMap.purs b/bench/Bench/Data/StrMap.purs deleted file mode 100644 index 1c7f419a..00000000 --- a/bench/Bench/Data/StrMap.purs +++ /dev/null @@ -1,27 +0,0 @@ -module Bench.Data.StrMap where - -import Prelude -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (CONSOLE, log) -import Performance.Minibench (benchWith) - -import Data.Tuple (Tuple(..)) -import Data.List as L -import Data.StrMap as M - -benchStrMap :: Eff (console :: CONSOLE) Unit -benchStrMap = do - log "fromFoldable" - benchFromFoldable - - where - benchFromFoldable = do - let natStrs = show <$> L.range 0 99999 - natPairs = (flip Tuple) unit <$> natStrs - shortPairList = L.take 10000 natPairs - - log $ "fromFoldable (" <> show (L.length shortPairList) <> ")" - benchWith 100 \_ -> M.fromFoldable shortPairList - - log $ "fromFoldable (" <> show (L.length natPairs) <> ")" - benchWith 10 \_ -> M.fromFoldable natPairs diff --git a/bench/Bench/Main.purs b/bench/Bench/Main.purs deleted file mode 100644 index f8f641b0..00000000 --- a/bench/Bench/Main.purs +++ /dev/null @@ -1,21 +0,0 @@ -module Bench.Main where - -import Prelude -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (CONSOLE, log) - -import Bench.Data.Map (benchMap) -import Bench.Data.StrMap (benchStrMap) - -main :: Eff (console :: CONSOLE) Unit -main = do - log "Map" - log "===" - benchMap - - log "" - - - log "StrMap" - log "======" - benchStrMap diff --git a/bower.json b/bower.json deleted file mode 100644 index bbcda159..00000000 --- a/bower.json +++ /dev/null @@ -1,35 +0,0 @@ -{ - "name": "purescript-maps", - "homepage": "https://github.com/purescript/purescript-maps", - "authors": [ - "Phil Freeman ", - "John A. De Goes " - ], - "description": "Purely functional maps implemented in PureScript", - "repository": { - "type": "git", - "url": "git://github.com/purescript/purescript-maps.git" - }, - "license": "MIT", - "ignore": [ - "**/.*", - "bower_components", - "node_modules", - "output", - "test", - "bower.json", - "package.json" - ], - "dependencies": { - "purescript-arrays": "^4.0.0", - "purescript-functions": "^3.0.0", - "purescript-lists": "^4.0.0", - "purescript-st": "^3.0.0", - "purescript-gen": "^1.1.0", - "purescript-foldable-traversable": "^3.6.1" - }, - "devDependencies": { - "purescript-quickcheck": "^4.0.0", - "purescript-minibench": "^1.0.0" - } -} diff --git a/package.json b/package.json deleted file mode 100644 index 0373d0c9..00000000 --- a/package.json +++ /dev/null @@ -1,18 +0,0 @@ -{ - "private": true, - "scripts": { - "clean": "rimraf output && rimraf .pulp-cache", - "build": "eslint src && pulp build -- --censor-lib --strict", - "test": "pulp test", - - "bench:build": "purs compile 'bench/**/*.purs' 'src/**/*.purs' 'bower_components/*/src/**/*.purs'", - "bench:run": "node -e 'require(\"./output/Bench.Main/index.js\").main()'", - "bench": "npm run bench:build && npm run bench:run" - }, - "devDependencies": { - "eslint": "^3.17.1", - "pulp": "^10.0.4", - "purescript-psa": "^0.5.0-rc.1", - "rimraf": "^2.6.1" - } -} diff --git a/src/Data/Map.purs b/src/Data/Map.purs deleted file mode 100644 index e764370b..00000000 --- a/src/Data/Map.purs +++ /dev/null @@ -1,642 +0,0 @@ --- | This module defines a type of maps as balanced 2-3 trees, based on --- | - -module Data.Map - ( Map - , showTree - , empty - , isEmpty - , singleton - , checkValid - , insert - , lookup - , lookupLE - , lookupLT - , lookupGE - , lookupGT - , findMin - , findMax - , foldSubmap - , submap - , fromFoldable - , fromFoldableWith - , toUnfoldable - , toAscUnfoldable - , delete - , pop - , member - , alter - , update - , keys - , values - , union - , unionWith - , unions - , isSubmap - , size - , mapWithKey - , filterWithKey - , filterKeys - , filter - ) where - -import Prelude - -import Data.Eq (class Eq1) -import Data.Foldable (foldl, foldMap, foldr, class Foldable) -import Data.FoldableWithIndex (class FoldableWithIndex) -import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) -import Data.List (List(..), (:), length, nub) -import Data.List.Lazy as LL -import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) -import Data.Monoid (class Monoid, mempty) -import Data.Ord (class Ord1) -import Data.Traversable (traverse, class Traversable) -import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) -import Data.Tuple (Tuple(Tuple), snd, uncurry) -import Data.Unfoldable (class Unfoldable, unfoldr) -import Partial.Unsafe (unsafePartial) - --- | `Map k v` represents maps from keys of type `k` to values of type `v`. -data Map k v - = Leaf - | Two (Map k v) k v (Map k v) - | Three (Map k v) k v (Map k v) k v (Map k v) - --- Internal use -toAscArray :: forall k v. Map k v -> Array (Tuple k v) -toAscArray = toAscUnfoldable - -instance eq1Map :: Eq k => Eq1 (Map k) where - eq1 = eq - -instance eqMap :: (Eq k, Eq v) => Eq (Map k v) where - eq m1 m2 = toAscArray m1 == toAscArray m2 - -instance ord1Map :: Ord k => Ord1 (Map k) where - compare1 = compare - -instance ordMap :: (Ord k, Ord v) => Ord (Map k v) where - compare m1 m2 = compare (toAscArray m1) (toAscArray m2) - -instance showMap :: (Show k, Show v) => Show (Map k v) where - show m = "(fromFoldable " <> show (toAscArray m) <> ")" - -instance semigroupMap :: Ord k => Semigroup (Map k v) where - append = union - -instance monoidMap :: Ord k => Monoid (Map k v) where - mempty = empty - -instance functorMap :: Functor (Map k) where - map _ Leaf = Leaf - map f (Two left k v right) = Two (map f left) k (f v) (map f right) - map f (Three left k1 v1 mid k2 v2 right) = Three (map f left) k1 (f v1) (map f mid) k2 (f v2) (map f right) - -instance functorWithIndexMap :: FunctorWithIndex k (Map k) where - mapWithIndex _ Leaf = Leaf - mapWithIndex f (Two left k v right) = Two (mapWithIndex f left) k (f k v) (mapWithIndex f right) - mapWithIndex f (Three left k1 v1 mid k2 v2 right) = Three (mapWithIndex f left) k1 (f k1 v1) (mapWithIndex f mid) k2 (f k2 v2) (mapWithIndex f right) - -instance foldableMap :: Foldable (Map k) where - foldl f z m = foldl f z (values m) - foldr f z m = foldr f z (values m) - foldMap f m = foldMap f (values m) - -instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where - foldlWithIndex f z m = foldl (uncurry <<< (flip f)) z $ asList $ toUnfoldable m - foldrWithIndex f z m = foldr (uncurry f) z $ asList $ toUnfoldable m - foldMapWithIndex f m = foldMap (uncurry f) $ asList $ toUnfoldable m - -asList :: forall k v. List (Tuple k v) -> List (Tuple k v) -asList = id - -instance traversableMap :: Traversable (Map k) where - traverse f Leaf = pure Leaf - traverse f (Two left k v right) = - Two <$> traverse f left - <*> pure k - <*> f v - <*> traverse f right - traverse f (Three left k1 v1 mid k2 v2 right) = - Three <$> traverse f left - <*> pure k1 - <*> f v1 - <*> traverse f mid - <*> pure k2 - <*> f v2 - <*> traverse f right - sequence = traverse id - -instance traversableWithIndexMap :: TraversableWithIndex k (Map k) where - traverseWithIndex f Leaf = pure Leaf - traverseWithIndex f (Two left k v right) = - Two <$> traverseWithIndex f left - <*> pure k - <*> f k v - <*> traverseWithIndex f right - traverseWithIndex f (Three left k1 v1 mid k2 v2 right) = - Three <$> traverseWithIndex f left - <*> pure k1 - <*> f k1 v1 - <*> traverseWithIndex f mid - <*> pure k2 - <*> f k2 v2 - <*> traverseWithIndex f right - --- | Render a `Map` as a `String` -showTree :: forall k v. Show k => Show v => Map k v -> String -showTree Leaf = "Leaf" -showTree (Two left k v right) = - "Two (" <> showTree left <> - ") (" <> show k <> - ") (" <> show v <> - ") (" <> showTree right <> ")" -showTree (Three left k1 v1 mid k2 v2 right) = - "Three (" <> showTree left <> - ") (" <> show k1 <> - ") (" <> show v1 <> - ") (" <> showTree mid <> - ") (" <> show k2 <> - ") (" <> show v2 <> - ") (" <> showTree right <> ")" - --- | An empty map -empty :: forall k v. Map k v -empty = Leaf - --- | Test if a map is empty -isEmpty :: forall k v. Map k v -> Boolean -isEmpty Leaf = true -isEmpty _ = false - --- | Create a map with one key/value pair -singleton :: forall k v. k -> v -> Map k v -singleton k v = Two Leaf k v Leaf - --- | Check whether the underlying tree satisfies the 2-3 invariant --- | --- | This function is provided for internal use. -checkValid :: forall k v. Map k v -> Boolean -checkValid tree = length (nub (allHeights tree)) == one - where - allHeights :: Map k v -> List Int - allHeights Leaf = pure zero - allHeights (Two left _ _ right) = map (\n -> n + one) (allHeights left <> allHeights right) - allHeights (Three left _ _ mid _ _ right) = map (\n -> n + one) (allHeights left <> allHeights mid <> allHeights right) - --- | Look up a value for the specified key -lookup :: forall k v. Ord k => k -> Map k v -> Maybe v -lookup k = go - where - comp :: k -> k -> Ordering - comp = compare - - go Leaf = Nothing - go (Two left k1 v right) = - case comp k k1 of - EQ -> Just v - LT -> go left - _ -> go right - go (Three left k1 v1 mid k2 v2 right) = - case comp k k1 of - EQ -> Just v1 - c1 -> - case c1, comp k k2 of - _ , EQ -> Just v2 - LT, _ -> go left - _ , GT -> go right - _ , _ -> go mid - - --- | Look up a value for the specified key, or the greatest one less than it -lookupLE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupLE k = go - where - comp :: k -> k -> Ordering - comp = compare - - go Leaf = Nothing - go (Two left k1 v1 right) = case comp k k1 of - EQ -> Just { key: k1, value: v1 } - GT -> Just $ fromMaybe { key: k1, value: v1 } $ go right - LT -> go left - go (Three left k1 v1 mid k2 v2 right) = case comp k k2 of - EQ -> Just { key: k2, value: v2 } - GT -> Just $ fromMaybe { key: k2, value: v2 } $ go right - LT -> go $ Two left k1 v1 mid - --- | Look up a value for the greatest key less than the specified key -lookupLT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupLT k = go - where - comp :: k -> k -> Ordering - comp = compare - - go Leaf = Nothing - go (Two left k1 v1 right) = case comp k k1 of - EQ -> findMax left - GT -> Just $ fromMaybe { key: k1, value: v1 } $ go right - LT -> go left - go (Three left k1 v1 mid k2 v2 right) = case comp k k2 of - EQ -> findMax $ Two left k1 v1 mid - GT -> Just $ fromMaybe { key: k2, value: v2 } $ go right - LT -> go $ Two left k1 v1 mid - --- | Look up a value for the specified key, or the least one greater than it -lookupGE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupGE k = go - where - comp :: k -> k -> Ordering - comp = compare - - go Leaf = Nothing - go (Two left k1 v1 right) = case comp k k1 of - EQ -> Just { key: k1, value: v1 } - LT -> Just $ fromMaybe { key: k1, value: v1 } $ go left - GT -> go right - go (Three left k1 v1 mid k2 v2 right) = case comp k k1 of - EQ -> Just { key: k1, value: v1 } - LT -> Just $ fromMaybe { key: k1, value: v1 } $ go left - GT -> go $ Two mid k2 v2 right - --- | Look up a value for the least key greater than the specified key -lookupGT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v } -lookupGT k = go - where - comp :: k -> k -> Ordering - comp = compare - - go Leaf = Nothing - go (Two left k1 v1 right) = case comp k k1 of - EQ -> findMin right - LT -> Just $ fromMaybe { key: k1, value: v1 } $ go left - GT -> go right - go (Three left k1 v1 mid k2 v2 right) = case comp k k1 of - EQ -> findMin $ Two mid k2 v2 right - LT -> Just $ fromMaybe { key: k1, value: v1 } $ go left - GT -> go $ Two mid k2 v2 right - --- | Returns the pair with the greatest key -findMax :: forall k v. Map k v -> Maybe { key :: k, value :: v } -findMax = go Nothing - where - go acc Leaf = acc - go _ (Two _ k1 v1 right) = go (Just { key: k1, value: v1 }) right - go _ (Three _ _ _ _ k2 v2 right) = go (Just { key: k2, value: v2 }) right - --- | Returns the pair with the least key -findMin :: forall k v. Map k v -> Maybe { key :: k, value :: v } -findMin = go Nothing - where - go acc Leaf = acc - go _ (Two left k1 v1 _) = go (Just { key: k1, value: v1 }) left - go _ (Three left k1 v1 _ _ _ _) = go (Just { key: k1, value: v1 }) left - --- | Fold over the entries of a given map where the key is between a lower and --- | an upper bound. Passing `Nothing` as either the lower or upper bound --- | argument means that the fold has no lower or upper bound, i.e. the fold --- | starts from (or ends with) the smallest (or largest) key in the map. --- | --- | ```purescript --- | foldSubmap (Just 1) (Just 2) (\_ v -> [v]) --- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) --- | == ["one", "two"] --- | --- | foldSubmap Nothing (Just 2) (\_ v -> [v]) --- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) --- | == ["zero", "one", "two"] --- | ``` -foldSubmap :: forall k v m. Ord k => Monoid m => Maybe k -> Maybe k -> (k -> v -> m) -> Map k v -> m -foldSubmap kmin kmax f = - let - tooSmall = - case kmin of - Just kmin' -> - \k -> k < kmin' - Nothing -> - const false - - tooLarge = - case kmax of - Just kmax' -> - \k -> k > kmax' - Nothing -> - const false - - inBounds = - case kmin, kmax of - Just kmin', Just kmax' -> - \k -> kmin' <= k && k <= kmax' - Just kmin', Nothing -> - \k -> kmin' <= k - Nothing, Just kmax' -> - \k -> k <= kmax' - Nothing, Nothing -> - const true - - -- We can take advantage of the invariants of the tree structure to reduce - -- the amount of work we need to do. For example, in the following tree: - -- - -- [2][4] - -- / | \ - -- / | \ - -- [1] [3] [5] - -- - -- If we are given a lower bound of 3, we do not need to inspect the left - -- subtree, because we know that every entry in it is less than or equal to - -- 2. Similarly, if we are given a lower bound of 5, we do not need to - -- inspect the central subtree, because we know that every entry in it must - -- be less than or equal to 4. - -- - -- Unfortunately we cannot extract `if cond then x else mempty` into a - -- function because of strictness. - go = case _ of - Leaf -> - mempty - Two left k v right -> - (if tooSmall k then mempty else go left) - <> (if inBounds k then f k v else mempty) - <> (if tooLarge k then mempty else go right) - Three left k1 v1 mid k2 v2 right -> - (if tooSmall k1 then mempty else go left) - <> (if inBounds k1 then f k1 v1 else mempty) - <> (if tooSmall k2 || tooLarge k1 then mempty else go mid) - <> (if inBounds k2 then f k2 v2 else mempty) - <> (if tooLarge k2 then mempty else go right) - in - go - --- | Returns a new map containing all entries of the given map which lie --- | between a given lower and upper bound, treating `Nothing` as no bound i.e. --- | including the smallest (or largest) key in the map, no matter how small --- | (or large) it is. For example: --- | --- | ```purescript --- | submap (Just 1) (Just 2) --- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) --- | == fromFoldable [Tuple 1 "one", Tuple 2 "two"] --- | --- | submap Nothing (Just 2) --- | (fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two", Tuple 3 "three"]) --- | == fromFoldable [Tuple 0 "zero", Tuple 1 "one", Tuple 2 "two"] --- | ``` --- | --- | The function is entirely specified by the following --- | property: --- | --- | ```purescript --- | Given any m :: Map k v, mmin :: Maybe k, mmax :: Maybe k, key :: k, --- | let m' = submap mmin mmax m in --- | if (maybe true (\min -> min <= key) mmin && --- | maybe true (\max -> max >= key) mmax) --- | then lookup key m == lookup key m' --- | else not (member key m') --- | ``` -submap :: forall k v. Ord k => Maybe k -> Maybe k -> Map k v -> Map k v -submap kmin kmax = foldSubmap kmin kmax singleton - --- | Test if a key is a member of a map -member :: forall k v. Ord k => k -> Map k v -> Boolean -member k m = isJust (k `lookup` m) - -data TreeContext k v - = TwoLeft k v (Map k v) - | TwoRight (Map k v) k v - | ThreeLeft k v (Map k v) k v (Map k v) - | ThreeMiddle (Map k v) k v k v (Map k v) - | ThreeRight (Map k v) k v (Map k v) k v - -fromZipper :: forall k v. Ord k => List (TreeContext k v) -> Map k v -> Map k v -fromZipper Nil tree = tree -fromZipper (Cons x ctx) tree = - case x of - TwoLeft k1 v1 right -> fromZipper ctx (Two tree k1 v1 right) - TwoRight left k1 v1 -> fromZipper ctx (Two left k1 v1 tree) - ThreeLeft k1 v1 mid k2 v2 right -> fromZipper ctx (Three tree k1 v1 mid k2 v2 right) - ThreeMiddle left k1 v1 k2 v2 right -> fromZipper ctx (Three left k1 v1 tree k2 v2 right) - ThreeRight left k1 v1 mid k2 v2 -> fromZipper ctx (Three left k1 v1 mid k2 v2 tree) - -data KickUp k v = KickUp (Map k v) k v (Map k v) - --- | Insert or replace a key/value pair in a map -insert :: forall k v. Ord k => k -> v -> Map k v -> Map k v -insert k v = down Nil - where - comp :: k -> k -> Ordering - comp = compare - - down :: List (TreeContext k v) -> Map k v -> Map k v - down ctx Leaf = up ctx (KickUp Leaf k v Leaf) - down ctx (Two left k1 v1 right) = - case comp k k1 of - EQ -> fromZipper ctx (Two left k v right) - LT -> down (Cons (TwoLeft k1 v1 right) ctx) left - _ -> down (Cons (TwoRight left k1 v1) ctx) right - down ctx (Three left k1 v1 mid k2 v2 right) = - case comp k k1 of - EQ -> fromZipper ctx (Three left k v mid k2 v2 right) - c1 -> - case c1, comp k k2 of - _ , EQ -> fromZipper ctx (Three left k1 v1 mid k v right) - LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) left - GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) mid - _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right - - up :: List (TreeContext k v) -> KickUp k v -> Map k v - up Nil (KickUp left k' v' right) = Two left k' v' right - up (Cons x ctx) kup = - case x, kup of - TwoLeft k1 v1 right, KickUp left k' v' mid -> fromZipper ctx (Three left k' v' mid k1 v1 right) - TwoRight left k1 v1, KickUp mid k' v' right -> fromZipper ctx (Three left k1 v1 mid k' v' right) - ThreeLeft k1 v1 c k2 v2 d, KickUp a k' v' b -> up ctx (KickUp (Two a k' v' b) k1 v1 (Two c k2 v2 d)) - ThreeMiddle a k1 v1 k2 v2 d, KickUp b k' v' c -> up ctx (KickUp (Two a k1 v1 b) k' v' (Two c k2 v2 d)) - ThreeRight a k1 v1 b k2 v2, KickUp c k' v' d -> up ctx (KickUp (Two a k1 v1 b) k2 v2 (Two c k' v' d)) - --- | Delete a key and its corresponding value from a map. -delete :: forall k v. Ord k => k -> Map k v -> Map k v -delete k m = maybe m snd (pop k m) - --- | Delete a key and its corresponding value from a map, returning the value --- | as well as the subsequent map. -pop :: forall k v. Ord k => k -> Map k v -> Maybe (Tuple v (Map k v)) -pop k = down Nil - where - comp :: k -> k -> Ordering - comp = compare - - down :: List (TreeContext k v) -> Map k v -> Maybe (Tuple v (Map k v)) - down = unsafePartial \ctx m -> case m of - Leaf -> Nothing - Two left k1 v1 right -> - case right, comp k k1 of - Leaf, EQ -> Just (Tuple v1 (up ctx Leaf)) - _ , EQ -> let max = maxNode left - in Just (Tuple v1 (removeMaxNode (Cons (TwoLeft max.key max.value right) ctx) left)) - _ , LT -> down (Cons (TwoLeft k1 v1 right) ctx) left - _ , _ -> down (Cons (TwoRight left k1 v1) ctx) right - Three left k1 v1 mid k2 v2 right -> - let leaves = - case left, mid, right of - Leaf, Leaf, Leaf -> true - _ , _ , _ -> false - in case leaves, comp k k1, comp k k2 of - true, EQ, _ -> Just (Tuple v1 (fromZipper ctx (Two Leaf k2 v2 Leaf))) - true, _ , EQ -> Just (Tuple v2 (fromZipper ctx (Two Leaf k1 v1 Leaf))) - _ , EQ, _ -> let max = maxNode left - in Just (Tuple v1 (removeMaxNode (Cons (ThreeLeft max.key max.value mid k2 v2 right) ctx) left)) - _ , _ , EQ -> let max = maxNode mid - in Just (Tuple v2 (removeMaxNode (Cons (ThreeMiddle left k1 v1 max.key max.value right) ctx) mid)) - _ , LT, _ -> down (Cons (ThreeLeft k1 v1 mid k2 v2 right) ctx) left - _ , GT, LT -> down (Cons (ThreeMiddle left k1 v1 k2 v2 right) ctx) mid - _ , _ , _ -> down (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right - - up :: List (TreeContext k v) -> Map k v -> Map k v - up = unsafePartial \ctxs tree -> - case ctxs of - Nil -> tree - Cons x ctx -> - case x, tree of - TwoLeft k1 v1 Leaf, Leaf -> fromZipper ctx (Two Leaf k1 v1 Leaf) - TwoRight Leaf k1 v1, Leaf -> fromZipper ctx (Two Leaf k1 v1 Leaf) - TwoLeft k1 v1 (Two m k2 v2 r), l -> up ctx (Three l k1 v1 m k2 v2 r) - TwoRight (Two l k1 v1 m) k2 v2, r -> up ctx (Three l k1 v1 m k2 v2 r) - TwoLeft k1 v1 (Three b k2 v2 c k3 v3 d), a -> fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - TwoRight (Three a k1 v1 b k2 v2 c) k3 v3, d -> fromZipper ctx (Two (Two a k1 v1 b) k2 v2 (Two c k3 v3 d)) - ThreeLeft k1 v1 Leaf k2 v2 Leaf, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - ThreeMiddle Leaf k1 v1 k2 v2 Leaf, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - ThreeRight Leaf k1 v1 Leaf k2 v2, Leaf -> fromZipper ctx (Three Leaf k1 v1 Leaf k2 v2 Leaf) - ThreeLeft k1 v1 (Two b k2 v2 c) k3 v3 d, a -> fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - ThreeMiddle (Two a k1 v1 b) k2 v2 k3 v3 d, c -> fromZipper ctx (Two (Three a k1 v1 b k2 v2 c) k3 v3 d) - ThreeMiddle a k1 v1 k2 v2 (Two c k3 v3 d), b -> fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - ThreeRight a k1 v1 (Two b k2 v2 c) k3 v3, d -> fromZipper ctx (Two a k1 v1 (Three b k2 v2 c k3 v3 d)) - ThreeLeft k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4 e, a -> fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - ThreeMiddle (Three a k1 v1 b k2 v2 c) k3 v3 k4 v4 e, d -> fromZipper ctx (Three (Two a k1 v1 b) k2 v2 (Two c k3 v3 d) k4 v4 e) - ThreeMiddle a k1 v1 k2 v2 (Three c k3 v3 d k4 v4 e), b -> fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - ThreeRight a k1 v1 (Three b k2 v2 c k3 v3 d) k4 v4, e -> fromZipper ctx (Three a k1 v1 (Two b k2 v2 c) k3 v3 (Two d k4 v4 e)) - - maxNode :: Map k v -> { key :: k, value :: v } - maxNode = unsafePartial \m -> case m of - Two _ k' v Leaf -> { key: k', value: v } - Two _ _ _ right -> maxNode right - Three _ _ _ _ k' v Leaf -> { key: k', value: v } - Three _ _ _ _ _ _ right -> maxNode right - - - removeMaxNode :: List (TreeContext k v) -> Map k v -> Map k v - removeMaxNode = unsafePartial \ctx m -> - case m of - Two Leaf _ _ Leaf -> up ctx Leaf - Two left k' v right -> removeMaxNode (Cons (TwoRight left k' v) ctx) right - Three Leaf k1 v1 Leaf _ _ Leaf -> up (Cons (TwoRight Leaf k1 v1) ctx) Leaf - Three left k1 v1 mid k2 v2 right -> removeMaxNode (Cons (ThreeRight left k1 v1 mid k2 v2) ctx) right - - --- | Insert the value, delete a value, or update a value for a key in a map -alter :: forall k v. Ord k => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v -alter f k m = case f (k `lookup` m) of - Nothing -> delete k m - Just v -> insert k v m - --- | Update or delete the value for a key in a map -update :: forall k v. Ord k => (v -> Maybe v) -> k -> Map k v -> Map k v -update f k m = alter (maybe Nothing f) k m - --- | Convert any foldable collection of key/value pairs to a map. --- | On key collision, later values take precedence over earlier ones. -fromFoldable :: forall f k v. Ord k => Foldable f => f (Tuple k v) -> Map k v -fromFoldable = foldl (\m (Tuple k v) -> insert k v m) empty - --- | Convert any foldable collection of key/value pairs to a map. --- | On key collision, the values are configurably combined. -fromFoldableWith :: forall f k v. Ord k => Foldable f => (v -> v -> v) -> f (Tuple k v) -> Map k v -fromFoldableWith f = foldl (\m (Tuple k v) -> alter (combine v) k m) empty where - combine v (Just v') = Just $ f v v' - combine v Nothing = Just v - --- | Convert a map to an unfoldable structure of key/value pairs -toUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) -toUnfoldable m = unfoldr go (m : Nil) where - go Nil = Nothing - go (hd : tl) = case hd of - Leaf -> go tl - Two left k v right -> - Just $ Tuple (Tuple k v) (left : right : tl) - Three left k1 v1 mid k2 v2 right -> - Just $ Tuple (Tuple k1 v1) (singleton k2 v2 : left : mid : right : tl) - --- | Convert a map to an unfoldable structure of key/value pairs where the keys are in ascending order -toAscUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v) -toAscUnfoldable m = unfoldr go (m : Nil) where - go Nil = Nothing - go (hd : tl) = case hd of - Leaf -> go tl - Two Leaf k v Leaf -> - Just $ Tuple (Tuple k v) tl - Two Leaf k v right -> - Just $ Tuple (Tuple k v) (right : tl) - Two left k v right -> - go $ left : singleton k v : right : tl - Three left k1 v1 mid k2 v2 right -> - go $ left : singleton k1 v1 : mid : singleton k2 v2 : right : tl - --- | Get a list of the keys contained in a map -keys :: forall k v. Map k v -> List k -keys Leaf = Nil -keys (Two left k _ right) = keys left <> pure k <> keys right -keys (Three left k1 _ mid k2 _ right) = keys left <> pure k1 <> keys mid <> pure k2 <> keys right - --- | Get a list of the values contained in a map -values :: forall k v. Map k v -> List v -values Leaf = Nil -values (Two left _ v right) = values left <> pure v <> values right -values (Three left _ v1 mid _ v2 right) = values left <> pure v1 <> values mid <> pure v2 <> values right - --- | Compute the union of two maps, using the specified function --- | to combine values for duplicate keys. -unionWith :: forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v -unionWith f m1 m2 = foldl go m2 (toUnfoldable m1 :: List (Tuple k v)) - where - go m (Tuple k v) = alter (Just <<< maybe v (f v)) k m - --- | Compute the union of two maps, preferring values from the first map in the case --- | of duplicate keys -union :: forall k v. Ord k => Map k v -> Map k v -> Map k v -union = unionWith const - --- | Compute the union of a collection of maps -unions :: forall k v f. Ord k => Foldable f => f (Map k v) -> Map k v -unions = foldl union empty - --- | Test whether one map contains all of the keys and values contained in another map -isSubmap :: forall k v. Ord k => Eq v => Map k v -> Map k v -> Boolean -isSubmap m1 m2 = LL.all f $ (toUnfoldable m1 :: LL.List (Tuple k v)) - where f (Tuple k v) = lookup k m2 == Just v - --- | Calculate the number of key/value pairs in a map -size :: forall k v. Map k v -> Int -size Leaf = 0 -size (Two m1 _ _ m2) = 1 + size m1 + size m2 -size (Three m1 _ _ m2 _ _ m3) = 2 + size m1 + size m2 + size m3 - --- | Apply a function of two arguments to each key/value pair, producing a new map -mapWithKey :: forall k v v'. (k -> v -> v') -> Map k v -> Map k v' -mapWithKey _ Leaf = Leaf -mapWithKey f (Two left k v right) = Two (mapWithKey f left) k (f k v) (mapWithKey f right) -mapWithKey f (Three left k1 v1 mid k2 v2 right) = Three (mapWithKey f left) k1 (f k1 v1) (mapWithKey f mid) k2 (f k2 v2) (mapWithKey f right) - --- | Filter out those key/value pairs of a map for which a predicate --- | fails to hold. -filterWithKey :: forall k v. Ord k => (k -> v -> Boolean) -> Map k v -> Map k v -filterWithKey predicate = - fromFoldable <<< LL.filter (uncurry predicate) <<< toUnfoldable - --- | Filter out those key/value pairs of a map for which a predicate --- | on the key fails to hold. -filterKeys :: forall k. Ord k => (k -> Boolean) -> Map k ~> Map k -filterKeys predicate = filterWithKey $ const <<< predicate - --- | Filter out those key/value pairs of a map for which a predicate --- | on the value fails to hold. -filter :: forall k v. Ord k => (v -> Boolean) -> Map k v -> Map k v -filter predicate = filterWithKey $ const predicate diff --git a/src/Data/Map/Gen.purs b/src/Data/Map/Gen.purs deleted file mode 100644 index 6398a2db..00000000 --- a/src/Data/Map/Gen.purs +++ /dev/null @@ -1,24 +0,0 @@ -module Data.Map.Gen where - -import Prelude - -import Control.Monad.Gen (class MonadGen, chooseInt, resize, sized, unfoldable) -import Control.Monad.Rec.Class (class MonadRec) -import Data.Map (Map, fromFoldable) -import Data.Tuple (Tuple(..)) -import Data.List (List) - --- | Generates a `Map` using the specified key and value generators. -genMap - :: forall m a b - . MonadRec m - => MonadGen m - => Ord a - => m a - -> m b - -> m (Map a b) -genMap genKey genValue = sized \size -> do - newSize <- chooseInt 0 size - resize (const newSize) $ - (fromFoldable :: List (Tuple a b) -> Map a b) - <$> unfoldable (Tuple <$> genKey <*> genValue) diff --git a/src/Data/StrMap.js b/src/Data/StrMap.js deleted file mode 100644 index ab82f990..00000000 --- a/src/Data/StrMap.js +++ /dev/null @@ -1,125 +0,0 @@ -"use strict"; - -exports._copyEff = function (m) { - return function () { - var r = {}; - for (var k in m) { - if (hasOwnProperty.call(m, k)) { - r[k] = m[k]; - } - } - return r; - }; -}; - -exports.empty = {}; - -exports.runST = function (f) { - return f; -}; - -exports._fmapStrMap = function (m0, f) { - var m = {}; - for (var k in m0) { - if (hasOwnProperty.call(m0, k)) { - m[k] = f(m0[k]); - } - } - return m; -}; - -exports._mapWithKey = function (m0, f) { - var m = {}; - for (var k in m0) { - if (hasOwnProperty.call(m0, k)) { - m[k] = f(k)(m0[k]); - } - } - return m; -}; - -exports._foldM = function (bind) { - return function (f) { - return function (mz) { - return function (m) { - var acc = mz; - function g(k) { - return function (z) { - return f(z)(k)(m[k]); - }; - } - for (var k in m) { - if (hasOwnProperty.call(m, k)) { - acc = bind(acc)(g(k)); - } - } - return acc; - }; - }; - }; -}; - -exports._foldSCStrMap = function (m, z, f, fromMaybe) { - var acc = z; - for (var k in m) { - if (hasOwnProperty.call(m, k)) { - var maybeR = f(acc)(k)(m[k]); - var r = fromMaybe(null)(maybeR); - if (r === null) return acc; - else acc = r; - } - } - return acc; -}; - -exports.all = function (f) { - return function (m) { - for (var k in m) { - if (hasOwnProperty.call(m, k) && !f(k)(m[k])) return false; - } - return true; - }; -}; - -exports.size = function (m) { - var s = 0; - for (var k in m) { - if (hasOwnProperty.call(m, k)) { - ++s; - } - } - return s; -}; - -exports._lookup = function (no, yes, k, m) { - return k in m ? yes(m[k]) : no; -}; - -exports._unsafeDeleteStrMap = function (m, k) { - delete m[k]; - return m; -}; - -exports._lookupST = function (no, yes, k, m) { - return function () { - return k in m ? yes(m[k]) : no; - }; -}; - -function toArrayWithKey(f) { - return function (m) { - var r = []; - for (var k in m) { - if (hasOwnProperty.call(m, k)) { - r.push(f(k)(m[k])); - } - } - return r; - }; -} - -exports.toArrayWithKey = toArrayWithKey; - -exports.keys = Object.keys || toArrayWithKey(function (k) { - return function () { return k; }; -}); diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs deleted file mode 100644 index 3b57a4a7..00000000 --- a/src/Data/StrMap.purs +++ /dev/null @@ -1,302 +0,0 @@ --- | This module defines a type of native Javascript maps which --- | require the keys to be strings. --- | --- | To maximize performance, Javascript objects are not wrapped, --- | and some native code is used even when it's not necessary. - -module Data.StrMap - ( StrMap - , empty - , isEmpty - , size - , singleton - , insert - , lookup - , toUnfoldable - , toAscUnfoldable - , fromFoldable - , fromFoldableWith - , delete - , pop - , member - , alter - , update - , mapWithKey - , filterWithKey - , filterKeys - , filter - , keys - , values - , union - , unions - , isSubmap - , fold - , foldMap - , foldM - , foldMaybe - , all - , thawST - , freezeST - , runST - , pureST - , toArrayWithKey - ) where - -import Prelude - -import Control.Monad.Eff (Eff, runPure, foreachE) -import Control.Monad.ST as ST - -import Data.Array as A -import Data.Eq (class Eq1) -import Data.Foldable (class Foldable, foldl, foldr, for_) -import Data.FoldableWithIndex (class FoldableWithIndex) -import Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4) -import Data.FunctorWithIndex (class FunctorWithIndex) -import Data.Maybe (Maybe(..), maybe, fromMaybe) -import Data.Monoid (class Monoid, mempty) -import Data.StrMap.ST as SM -import Data.Traversable (class Traversable, traverse) -import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex) -import Data.Tuple (Tuple(..), fst, uncurry) -import Data.Unfoldable (class Unfoldable) - --- | `StrMap a` represents a map from `String`s to values of type `a`. -foreign import data StrMap :: Type -> Type - -foreign import _copyEff :: forall a b h r. a -> Eff (st :: ST.ST h | r) b - --- | Convert an immutable map into a mutable map -thawST :: forall a h r. StrMap a -> Eff (st :: ST.ST h | r) (SM.STStrMap h a) -thawST = _copyEff - --- | Convert a mutable map into an immutable map -freezeST :: forall a h r. SM.STStrMap h a -> Eff (st :: ST.ST h | r) (StrMap a) -freezeST = _copyEff - --- | Freeze a mutable map, creating an immutable map. Use this function as you would use --- | `Prelude.runST` to freeze a mutable reference. --- | --- | The rank-2 type prevents the map from escaping the scope of `runST`. -foreign import runST :: forall a r. (forall h. Eff (st :: ST.ST h | r) (SM.STStrMap h a)) -> Eff r (StrMap a) - -pureST :: forall a. (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 - pure s - -foreign import _fmapStrMap :: forall a b. Fn2 (StrMap a) (a -> b) (StrMap b) - -instance functorStrMap :: Functor StrMap where - map f m = runFn2 _fmapStrMap m f - -instance functorWithIndexStrMap :: FunctorWithIndex String StrMap where - mapWithIndex = mapWithKey - -foreign import _foldM :: forall a m z. (m -> (z -> m) -> m) -> (z -> String -> a -> m) -> m -> StrMap a -> m - --- | Fold the keys and values of a map -fold :: forall a z. (z -> String -> a -> z) -> z -> StrMap a -> z -fold = _foldM ((#)) - --- | Fold the keys and values of a map, accumulating values using --- | some `Monoid`. -foldMap :: forall a m. Monoid m => (String -> a -> m) -> StrMap a -> m -foldMap f = fold (\acc k v -> acc <> f k v) mempty - --- | Fold the keys and values of a map, accumulating values and effects in --- | some `Monad`. -foldM :: forall a m z. Monad m => (z -> String -> a -> m z) -> z -> StrMap a -> m z -foldM f z = _foldM bind f (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 (const f) - -instance foldableWithIndexStrMap :: FoldableWithIndex String StrMap where - foldlWithIndex f = fold (flip f) - foldrWithIndex f z m = foldr (uncurry f) z (toArrayWithKey Tuple m) - foldMapWithIndex = foldMap - -instance traversableStrMap :: Traversable StrMap where - traverse = traverseWithIndex <<< const - sequence = traverse id - -instance traversableWithIndexStrMap :: TraversableWithIndex String StrMap where - traverseWithIndex f ms = - fold (\acc k v -> flip (insert k) <$> acc <*> f k v) (pure empty) ms - --- Unfortunately the above are not short-circuitable (consider using purescript-machines) --- so we need special cases: - -foreign import _foldSCStrMap :: forall a z. Fn4 (StrMap a) z (z -> String -> a -> Maybe z) (forall b. b -> Maybe b -> b) z - --- | Fold the keys and values of a map. --- | --- | This function allows the folding function to terminate the fold early, --- | using `Maybe`. -foldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> StrMap a -> z -foldMaybe f z m = runFn4 _foldSCStrMap m z f fromMaybe - --- | Test whether all key/value pairs in a `StrMap` satisfy a predicate. -foreign import all :: forall a. (String -> a -> Boolean) -> StrMap a -> Boolean - -instance eqStrMap :: Eq a => Eq (StrMap a) where - eq m1 m2 = (isSubmap m1 m2) && (isSubmap m2 m1) - -instance eq1StrMap :: Eq1 StrMap where - eq1 = eq - --- Internal use -toAscArray :: forall v. StrMap v -> Array (Tuple String v) -toAscArray = toAscUnfoldable - -instance ordStrMap :: Ord a => Ord (StrMap a) where - compare m1 m2 = compare (toAscArray m1) (toAscArray m2) - -instance showStrMap :: Show a => Show (StrMap a) where - show m = "(fromFoldable " <> show (toArray m) <> ")" - --- | An empty map -foreign import empty :: forall a. StrMap a - --- | Test whether one map contains all of the keys and values contained in another map -isSubmap :: forall a. Eq a => StrMap a -> StrMap a -> Boolean -isSubmap m1 m2 = all f m1 where - f k v = runFn4 _lookup false ((==) v) k m2 - --- | Test whether a map is empty -isEmpty :: forall a. StrMap a -> Boolean -isEmpty = all (\_ _ -> false) - --- | Calculate the number of key/value pairs in a map -foreign import size :: forall a. StrMap a -> Int - --- | Create a map with one key/value pair -singleton :: forall a. String -> a -> StrMap a -singleton k v = pureST do - s <- SM.new - SM.poke s k v - -foreign import _lookup :: forall a z. Fn4 z (a -> z) String (StrMap a) z - --- | Lookup the value for a key in a map -lookup :: forall a. String -> StrMap a -> Maybe a -lookup = runFn4 _lookup Nothing Just - --- | Test whether a `String` appears as a key in a map -member :: forall a. String -> StrMap a -> Boolean -member = runFn4 _lookup false (const true) - --- | Insert or replace a key/value pair in a map -insert :: forall a. String -> a -> StrMap a -> StrMap a -insert k v = mutate (\s -> void $ SM.poke s k v) - -foreign import _unsafeDeleteStrMap :: forall a. Fn2 (StrMap a) String (StrMap a) - --- | Delete a key and value from a map -delete :: forall a. String -> StrMap a -> StrMap a -delete k = mutate (\s -> void $ SM.delete s k) - --- | Delete a key and value from a map, returning the value --- | as well as the subsequent map -pop :: forall a. String -> StrMap a -> Maybe (Tuple a (StrMap a)) -pop k m = lookup k m <#> \a -> Tuple a (delete k m) - --- | Insert, remove or update a value for a key in a map -alter :: forall a. (Maybe a -> Maybe a) -> String -> StrMap a -> StrMap a -alter f k m = case f (k `lookup` m) of - Nothing -> delete k m - Just v -> insert k v m - --- | Remove or update a value for a key in a map -update :: forall a. (a -> Maybe a) -> String -> StrMap a -> StrMap a -update f k m = alter (maybe Nothing f) k m - --- | Create a map from a foldable collection of key/value pairs -fromFoldable :: forall f a. Foldable f => f (Tuple String a) -> StrMap a -fromFoldable l = pureST do - s <- SM.new - foreachE (A.fromFoldable l) \(Tuple k v) -> void (SM.poke s k v) - pure s - -foreign import _lookupST :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z) - --- | Create a map from a foldable collection of key/value pairs, using the --- | specified function to combine values for duplicate keys. -fromFoldableWith :: forall f a. Foldable f => (a -> a -> a) -> f (Tuple String a) -> StrMap a -fromFoldableWith f l = pureST (do - s <- SM.new - for_ l (\(Tuple k v) -> runFn4 _lookupST v (f v) k s >>= SM.poke s k) - pure s) - -foreign import toArrayWithKey :: forall a b . (String -> a -> b) -> StrMap a -> Array b - --- | Unfolds a map into a list of key/value pairs -toUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a) -toUnfoldable = A.toUnfoldable <<< toArrayWithKey Tuple - --- | Unfolds a map into a list of key/value pairs which is guaranteed to be --- | sorted by key -toAscUnfoldable :: forall f a. Unfoldable f => StrMap a -> f (Tuple String a) -toAscUnfoldable = A.toUnfoldable <<< A.sortWith fst <<< toArrayWithKey Tuple - --- Internal -toArray :: forall a. StrMap a -> Array (Tuple String a) -toArray = toArrayWithKey Tuple - --- | Get an array of the keys in a map -foreign import keys :: forall a. StrMap a -> Array String - --- | Get a list of the values in a map -values :: forall a. StrMap a -> Array a -values = toArrayWithKey (\_ v -> v) - --- | Compute the union of two maps, preferring the first map in the case of --- | duplicate keys. -union :: forall a. StrMap a -> StrMap a -> StrMap a -union m = mutate (\s -> void $ foldM SM.poke s m) - --- | Compute the union of a collection of maps -unions :: forall f a. Foldable f => f (StrMap a) -> StrMap a -unions = foldl union empty - -foreign import _mapWithKey :: forall a b. Fn2 (StrMap a) (String -> a -> b) (StrMap b) - --- | Apply a function of two arguments to each key/value pair, producing a new map -mapWithKey :: forall a b. (String -> a -> b) -> StrMap a -> StrMap b -mapWithKey f m = runFn2 _mapWithKey m f - -instance semigroupStrMap :: (Semigroup a) => Semigroup (StrMap a) where - append m1 m2 = mutate (\s1 -> void $ foldM (\s2 k v2 -> SM.poke s2 k (runFn4 _lookup v2 (\v1 -> v1 <> v2) k m2)) s1 m1) m2 - -instance monoidStrMap :: (Semigroup a) => Monoid (StrMap a) where - mempty = empty - --- | Filter out those key/value pairs of a map for which a predicate --- | fails to hold. -filterWithKey :: forall a. (String -> a -> Boolean) -> StrMap a -> StrMap a -filterWithKey predicate m = pureST go - where - go :: forall h e. Eff (st :: ST.ST h | e) (SM.STStrMap h a) - go = do - m' <- SM.new - foldM step m' m - - where - step acc k v = if predicate k v then SM.poke acc k v else pure acc - --- | Filter out those key/value pairs of a map for which a predicate --- | on the key fails to hold. -filterKeys :: (String -> Boolean) -> StrMap ~> StrMap -filterKeys predicate = filterWithKey $ const <<< predicate - --- | Filter out those key/value pairs of a map for which a predicate --- | on the value fails to hold. -filter :: forall a. (a -> Boolean) -> StrMap a -> StrMap a -filter predicate = filterWithKey $ const predicate diff --git a/src/Data/StrMap/Gen.purs b/src/Data/StrMap/Gen.purs deleted file mode 100644 index f44385d2..00000000 --- a/src/Data/StrMap/Gen.purs +++ /dev/null @@ -1,23 +0,0 @@ -module Data.StrMap.Gen where - -import Prelude - -import Control.Monad.Gen (class MonadGen, chooseInt, resize, sized, unfoldable) -import Control.Monad.Rec.Class (class MonadRec) -import Data.StrMap (StrMap, fromFoldable) -import Data.Tuple (Tuple(..)) -import Data.List (List) - --- | Generates a `StrMap` using the specified key and value generators. -genStrMap - :: forall m a - . MonadRec m - => MonadGen m - => m String - -> m a - -> m (StrMap a) -genStrMap genKey genValue = sized \size -> do - newSize <- chooseInt 0 size - resize (const newSize) $ - (fromFoldable :: List (Tuple String a) -> StrMap a) - <$> unfoldable (Tuple <$> genKey <*> genValue) diff --git a/src/Data/StrMap/ST.js b/src/Data/StrMap/ST.js deleted file mode 100644 index 7baf2f84..00000000 --- a/src/Data/StrMap/ST.js +++ /dev/null @@ -1,37 +0,0 @@ -"use strict"; - -exports["new"] = function () { - return {}; -}; - -exports.peekImpl = function (just) { - return function (nothing) { - return function (m) { - return function (k) { - return function () { - return {}.hasOwnProperty.call(m, k) ? just(m[k]) : nothing; - }; - }; - }; - }; -}; - -exports.poke = function (m) { - return function (k) { - return function (v) { - return function () { - m[k] = v; - return m; - }; - }; - }; -}; - -exports["delete"] = function (m) { - return function (k) { - return function () { - delete m[k]; - return m; - }; - }; -}; diff --git a/src/Data/StrMap/ST.purs b/src/Data/StrMap/ST.purs deleted file mode 100644 index ccf56105..00000000 --- a/src/Data/StrMap/ST.purs +++ /dev/null @@ -1,37 +0,0 @@ --- | Helper functions for working with mutable maps using the `ST` effect. --- | --- | This module can be used when performance is important and mutation is a local effect. - -module Data.StrMap.ST - ( STStrMap - , new - , peek - , poke - , delete - ) where - -import Control.Monad.Eff (Eff) -import Control.Monad.ST (ST) -import Data.Maybe (Maybe(..)) - --- | A reference to a mutable map --- | --- | The first type parameter represents the memory region which the map belongs to. The second type parameter defines the type of elements of the mutable array. --- | --- | The runtime representation of a value of type `STStrMap h a` is the same as that of `StrMap a`, except that mutation is allowed. -foreign import data STStrMap :: Type -> Type -> Type - --- | Create a new, empty mutable map -foreign import new :: forall a h r. Eff (st :: ST h | r) (STStrMap h a) - --- | Get the value for a key in a mutable map -peek :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (Maybe a) -peek = peekImpl Just Nothing - -foreign import peekImpl :: forall a b h r. (a -> b) -> b -> STStrMap h a -> String -> Eff (st :: ST h | r) b - --- | Update the value for a key in a mutable map -foreign import poke :: forall a h r. STStrMap h a -> String -> a -> Eff (st :: ST h | r) (STStrMap h a) - --- | Remove a key and the corresponding value from a mutable map -foreign import delete :: forall a h r. STStrMap h a -> String -> Eff (st :: ST h | r) (STStrMap h a) diff --git a/src/Data/StrMap/ST/Unsafe.js b/src/Data/StrMap/ST/Unsafe.js deleted file mode 100644 index 83807658..00000000 --- a/src/Data/StrMap/ST/Unsafe.js +++ /dev/null @@ -1,7 +0,0 @@ -"use strict"; - -exports.unsafeFreeze = function (m) { - return function () { - return m; - }; -}; diff --git a/src/Data/StrMap/ST/Unsafe.purs b/src/Data/StrMap/ST/Unsafe.purs deleted file mode 100644 index 19c36d39..00000000 --- a/src/Data/StrMap/ST/Unsafe.purs +++ /dev/null @@ -1,11 +0,0 @@ -module Data.StrMap.ST.Unsafe where - -import Control.Monad.Eff (Eff) -import Control.Monad.ST (ST) -import Data.StrMap (StrMap) -import Data.StrMap.ST (STStrMap) - --- | Unsafely get the map out of ST without copying it --- | --- | If you later change the ST version of the map the pure value will also change. -foreign import unsafeFreeze :: forall a h r. STStrMap h a -> Eff (st :: ST h | r) (StrMap a) diff --git a/src/Data/StrMap/Unsafe.js b/src/Data/StrMap/Unsafe.js deleted file mode 100644 index 1cec670e..00000000 --- a/src/Data/StrMap/Unsafe.js +++ /dev/null @@ -1,7 +0,0 @@ -"use strict"; - -exports.unsafeIndex = function (m) { - return function (k) { - return m[k]; - }; -}; diff --git a/src/Data/StrMap/Unsafe.purs b/src/Data/StrMap/Unsafe.purs deleted file mode 100644 index 002df475..00000000 --- a/src/Data/StrMap/Unsafe.purs +++ /dev/null @@ -1,10 +0,0 @@ -module Data.StrMap.Unsafe - ( unsafeIndex - ) where - -import Data.StrMap (StrMap) - --- | Unsafely get the value for a key in a map. --- | --- | This function does not check whether the key exists in the map. -foreign import unsafeIndex :: forall a. StrMap a -> String -> a diff --git a/test/Test/Data/Map.purs b/test/Test/Data/Map.purs deleted file mode 100644 index bc38e615..00000000 --- a/test/Test/Data/Map.purs +++ /dev/null @@ -1,335 +0,0 @@ -module Test.Data.Map where - -import Prelude -import Control.Alt ((<|>)) -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (log, CONSOLE) -import Control.Monad.Eff.Exception (EXCEPTION) -import Control.Monad.Eff.Random (RANDOM) -import Data.Array as A -import Data.Foldable (foldl, for_, all) -import Data.Function (on) -import Data.List (List(Cons), groupBy, length, nubBy, singleton, sort, sortBy) -import Data.List.NonEmpty as NEL -import Data.Map as M -import Data.Map.Gen (genMap) -import Data.Maybe (Maybe(..), fromMaybe, maybe) -import Data.NonEmpty ((:|)) -import Data.Tuple (Tuple(..), fst, uncurry) -import Partial.Unsafe (unsafePartial) -import Test.QuickCheck ((), (===), quickCheck, quickCheck') -import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) -import Test.QuickCheck.Gen (elements, oneOf) - -newtype TestMap k v = TestMap (M.Map k v) - -instance arbTestMap :: (Eq k, Ord k, Arbitrary k, Arbitrary v) => Arbitrary (TestMap k v) where - arbitrary = TestMap <$> genMap arbitrary arbitrary - -data SmallKey = A | B | C | D | E | F | G | H | I | J -derive instance eqSmallKey :: Eq SmallKey -derive instance ordSmallKey :: Ord SmallKey - -instance showSmallKey :: Show SmallKey where - show A = "A" - show B = "B" - show C = "C" - show D = "D" - show E = "E" - show F = "F" - show G = "G" - show H = "H" - show I = "I" - show J = "J" - -instance arbSmallKey :: Arbitrary SmallKey where - arbitrary = elements $ A :| [B, C, D, E, F, G, H, I, J] - -data Instruction k v = Insert k v | Delete k - -instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where - show (Insert k v) = "Insert (" <> show k <> ") (" <> show v <> ")" - show (Delete k) = "Delete (" <> show k <> ")" - -instance arbInstruction :: (Arbitrary k, Arbitrary v) => Arbitrary (Instruction k v) where - arbitrary = oneOf $ (Insert <$> arbitrary <*> arbitrary) :| [Delete <$> arbitrary] - -runInstructions :: forall k v. Ord k => List (Instruction k v) -> M.Map k v -> M.Map k v -runInstructions instrs t0 = foldl step t0 instrs - where - step tree (Insert k v) = M.insert k v tree - step tree (Delete k) = M.delete k tree - -smallKey :: SmallKey -> SmallKey -smallKey k = k - -number :: Int -> Int -number n = n - -smallKeyToNumberMap :: M.Map SmallKey Int -> M.Map SmallKey Int -smallKeyToNumberMap m = m - -mapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) Unit -mapTests = do - - -- Data.Map - - log "Test inserting into empty tree" - quickCheck $ \k v -> M.lookup (smallKey k) (M.insert k v M.empty) == Just (number v) - ("k: " <> show k <> ", v: " <> show v) - - log "Test inserting two values with same key" - quickCheck $ \k v1 v2 -> - M.lookup (smallKey k) (M.insert k v2 (M.insert k v1 M.empty)) == Just (number v2) - - log "Test delete after inserting" - quickCheck $ \k v -> M.isEmpty (M.delete (smallKey k) (M.insert k (number v) M.empty)) - ("k: " <> show k <> ", v: " <> show v) - - log "Test pop after inserting" - quickCheck $ \k v -> M.pop (smallKey k) (M.insert k (number v) M.empty) == Just (Tuple v M.empty) - ("k: " <> show k <> ", v: " <> show v) - - log "Pop non-existent key" - quickCheck $ \k1 k2 v -> k1 == k2 || M.pop (smallKey k2) (M.insert k1 (number v) M.empty) == Nothing - ("k1: " <> show k1 <> ", k2: " <> show k2 <> ", v: " <> show v) - - log "Insert two, lookup first" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v1 - ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) - - log "Insert two, lookup second" - quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty)) == Just v2 - ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) - - log "Insert two, delete one" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert (smallKey k2) (number v2) (M.insert (smallKey k1) (number v1) M.empty))) == Just v2 - ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) - - log "Check balance property" - quickCheck' 1000 $ \instrs -> - let - tree :: M.Map SmallKey Int - tree = runInstructions instrs M.empty - in M.checkValid tree ("Map not balanced:\n " <> show tree <> "\nGenerated by:\n " <> show instrs) - - log "Lookup from empty" - quickCheck $ \k -> M.lookup k (M.empty :: M.Map SmallKey Int) == Nothing - - log "Lookup from singleton" - quickCheck $ \k v -> M.lookup (k :: SmallKey) (M.singleton k (v :: Int)) == Just v - - log "Random lookup" - quickCheck' 1000 $ \instrs k v -> - let - tree :: M.Map SmallKey Int - tree = M.insert k v (runInstructions instrs M.empty) - in M.lookup k tree == Just v ("instrs:\n " <> show instrs <> "\nk:\n " <> show k <> "\nv:\n " <> show v) - - log "Singleton to list" - quickCheck $ \k v -> M.toUnfoldable (M.singleton k v :: M.Map SmallKey Int) == singleton (Tuple k v) - - log "fromFoldable [] = empty" - quickCheck (M.fromFoldable [] == (M.empty :: M.Map Unit Unit) - "was not empty") - - log "fromFoldable & key collision" - do - let nums = M.fromFoldable [Tuple 0 "zero", Tuple 1 "what", Tuple 1 "one"] - quickCheck (M.lookup 0 nums == Just "zero" "invalid lookup - 0") - quickCheck (M.lookup 1 nums == Just "one" "invalid lookup - 1") - quickCheck (M.lookup 2 nums == Nothing "invalid lookup - 2") - - log "fromFoldableWith const [] = empty" - quickCheck (M.fromFoldableWith const [] == (M.empty :: M.Map Unit Unit) - "was not empty") - - log "fromFoldableWith (+) & key collision" - do - let nums = M.fromFoldableWith (+) [Tuple 0 1, Tuple 1 1, Tuple 1 1] - quickCheck (M.lookup 0 nums == Just 1 "invalid lookup - 0") - quickCheck (M.lookup 1 nums == Just 2 "invalid lookup - 1") - quickCheck (M.lookup 2 nums == Nothing "invalid lookup - 2") - - log "sort . toUnfoldable . fromFoldable = sort (on lists without key-duplicates)" - quickCheck $ \(list :: List (Tuple SmallKey Int)) -> - let nubbedList = nubBy ((==) `on` fst) list - f x = M.toUnfoldable (M.fromFoldable x) - in sort (f nubbedList) == sort nubbedList show nubbedList - - log "fromFoldable . toUnfoldable = id" - quickCheck $ \(TestMap (m :: M.Map SmallKey Int)) -> - let f m' = M.fromFoldable (M.toUnfoldable m' :: List (Tuple SmallKey Int)) - in f m == m show m - - log "fromFoldableWith const = fromFoldable" - quickCheck $ \arr -> - M.fromFoldableWith const arr == - M.fromFoldable (arr :: List (Tuple SmallKey Int)) show arr - - log "fromFoldableWith (<>) = fromFoldable . collapse with (<>) . group on fst" - quickCheck $ \arr -> - let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) - foldl1 g = unsafePartial \(Cons x xs) -> foldl g x xs - f = M.fromFoldable <<< map (foldl1 combine <<< NEL.toList) <<< - groupBy ((==) `on` fst) <<< sortBy (compare `on` fst) in - M.fromFoldableWith (<>) arr === f (arr :: List (Tuple String String)) - - log "toAscUnfoldable is sorted version of toUnfoldable" - quickCheck $ \(TestMap m) -> - let list = M.toUnfoldable (m :: M.Map SmallKey Int) - ascList = M.toAscUnfoldable m - in ascList === sortBy (compare `on` fst) list - - log "Lookup from union" - quickCheck $ \(TestMap m1) (TestMap m2) k -> - M.lookup (smallKey k) (M.union m1 m2) == (case M.lookup k m1 of - Nothing -> M.lookup k m2 - Just v -> Just (number v)) ("m1: " <> show m1 <> ", m2: " <> show m2 <> ", k: " <> show k <> ", v1: " <> show (M.lookup k m1) <> ", v2: " <> show (M.lookup k m2) <> ", union: " <> show (M.union m1 m2)) - - log "Union is idempotent" - quickCheck $ \(TestMap m1) (TestMap m2) -> (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.Map SmallKey Int)) - - log "Union prefers left" - quickCheck $ \(TestMap m1) (TestMap m2) k -> M.lookup k (M.union m1 (m2 :: M.Map SmallKey Int)) == (M.lookup k m1 <|> M.lookup k m2) - - log "unionWith" - for_ [Tuple (+) 0, Tuple (*) 1] $ \(Tuple op ident) -> - quickCheck $ \(TestMap m1) (TestMap m2) k -> - let u = M.unionWith op m1 m2 :: M.Map SmallKey Int - in case M.lookup k u of - Nothing -> not (M.member k m1 || M.member k m2) - Just v -> v == op (fromMaybe ident (M.lookup k m1)) (fromMaybe ident (M.lookup k m2)) - - log "unionWith argument order" - quickCheck $ \(TestMap m1) (TestMap m2) k -> - let u = M.unionWith (-) m1 m2 :: M.Map SmallKey Int - in1 = M.member k m1 - v1 = M.lookup k m1 - in2 = M.member k m2 - v2 = M.lookup k m2 - in case M.lookup k u of - Just v | in1 && in2 -> Just v == ((-) <$> v1 <*> v2) - Just v | in1 -> Just v == v1 - Just v -> Just v == v2 - Nothing -> not (in1 || in2) - - log "size" - quickCheck $ \xs -> - let xs' = nubBy ((==) `on` fst) xs - in M.size (M.fromFoldable xs') == length (xs' :: List (Tuple SmallKey Int)) - - log "lookupLE result is correct" - quickCheck $ \k (TestMap m) -> case M.lookupLE k (smallKeyToNumberMap m) of - Nothing -> all (_ > k) $ M.keys m - Just { key: k1, value: v } -> let - isCloserKey k2 = k1 < k2 && k2 < k - isLTwhenEQexists = k1 < k && M.member k m - in k1 <= k - && all (not <<< isCloserKey) (M.keys m) - && not isLTwhenEQexists - && M.lookup k1 m == Just v - - log "lookupGE result is correct" - quickCheck $ \k (TestMap m) -> case M.lookupGE k (smallKeyToNumberMap m) of - Nothing -> all (_ < k) $ M.keys m - Just { key: k1, value: v } -> let - isCloserKey k2 = k < k2 && k2 < k1 - isGTwhenEQexists = k < k1 && M.member k m - in k1 >= k - && all (not <<< isCloserKey) (M.keys m) - && not isGTwhenEQexists - && M.lookup k1 m == Just v - - log "lookupLT result is correct" - quickCheck $ \k (TestMap m) -> case M.lookupLT k (smallKeyToNumberMap m) of - Nothing -> all (_ >= k) $ M.keys m - Just { key: k1, value: v } -> let - isCloserKey k2 = k1 < k2 && k2 < k - in k1 < k - && all (not <<< isCloserKey) (M.keys m) - && M.lookup k1 m == Just v - - log "lookupGT result is correct" - quickCheck $ \k (TestMap m) -> case M.lookupGT k (smallKeyToNumberMap m) of - Nothing -> all (_ <= k) $ M.keys m - Just { key: k1, value: v } -> let - isCloserKey k2 = k < k2 && k2 < k1 - in k1 > k - && all (not <<< isCloserKey) (M.keys m) - && M.lookup k1 m == Just v - - log "findMin result is correct" - quickCheck $ \(TestMap m) -> case M.findMin (smallKeyToNumberMap m) of - Nothing -> M.isEmpty m - Just { key: k, value: v } -> M.lookup k m == Just v && all (_ >= k) (M.keys m) - - log "findMax result is correct" - quickCheck $ \(TestMap m) -> case M.findMax (smallKeyToNumberMap m) of - Nothing -> M.isEmpty m - Just { key: k, value: v } -> M.lookup k m == Just v && all (_ <= k) (M.keys m) - - log "mapWithKey is correct" - quickCheck $ \(TestMap m :: TestMap String Int) -> let - f k v = k <> show v - resultViaMapWithKey = m # M.mapWithKey f - toList = M.toUnfoldable :: forall k v. M.Map k v -> List (Tuple k v) - resultViaLists = m # toList # map (\(Tuple k v) → Tuple k (f k v)) # M.fromFoldable - in resultViaMapWithKey === resultViaLists - - log "filterWithKey gives submap" - quickCheck $ \(TestMap s :: TestMap String Int) p -> - M.isSubmap (M.filterWithKey p s) s - - log "filterWithKey keeps those keys for which predicate is true" - quickCheck $ \(TestMap s :: TestMap String Int) p -> - A.all (uncurry p) (M.toAscUnfoldable (M.filterWithKey p s) :: Array (Tuple String Int)) - - log "filterKeys gives submap" - quickCheck $ \(TestMap s :: TestMap String Int) p -> - M.isSubmap (M.filterKeys p s) s - - log "filterKeys keeps those keys for which predicate is true" - quickCheck $ \(TestMap s :: TestMap String Int) p -> - A.all p (M.keys (M.filterKeys p s)) - - log "filter gives submap" - quickCheck $ \(TestMap s :: TestMap String Int) p -> - M.isSubmap (M.filter p s) s - - log "filter keeps those values for which predicate is true" - quickCheck $ \(TestMap s :: TestMap String Int) p -> - A.all p (M.values (M.filter p s)) - - log "submap with no bounds = id" - quickCheck \(TestMap m :: TestMap SmallKey Int) -> - M.submap Nothing Nothing m === m - - log "submap with lower bound" - quickCheck' 1 $ - M.submap (Just B) Nothing (M.fromFoldable [Tuple A 0, Tuple B 0]) - == M.fromFoldable [Tuple B 0] - - log "submap with upper bound" - quickCheck' 1 $ - M.submap Nothing (Just A) (M.fromFoldable [Tuple A 0, Tuple B 0]) - == M.fromFoldable [Tuple A 0] - - log "submap with lower & upper bound" - quickCheck' 1 $ - M.submap (Just B) (Just B) (M.fromFoldable [Tuple A 0, Tuple B 0, Tuple C 0]) - == M.fromFoldable [Tuple B 0] - - log "submap" - quickCheck' 1000 \(TestMap m :: TestMap SmallKey Int) mmin mmax key -> - let - m' = M.submap mmin mmax m - in - (if (maybe true (\min -> min <= key) mmin && - maybe true (\max -> max >= key) mmax) - then M.lookup key m == M.lookup key m' - else (not (M.member key m'))) - "m: " <> show m - <> ", mmin: " <> show mmin - <> ", mmax: " <> show mmax - <> ", key: " <> show key diff --git a/test/Test/Data/StrMap.purs b/test/Test/Data/StrMap.purs deleted file mode 100644 index ae4ba00d..00000000 --- a/test/Test/Data/StrMap.purs +++ /dev/null @@ -1,252 +0,0 @@ -module Test.Data.StrMap where - -import Prelude - -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (log, CONSOLE) -import Control.Monad.Eff.Exception (EXCEPTION) -import Control.Monad.Eff.Random (RANDOM) -import Control.Monad.Writer (runWriter, tell) -import Data.Array as A -import Data.Foldable (foldl, foldr) -import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex, foldMapWithIndex) -import Data.Function (on) -import Data.List as L -import Data.List.NonEmpty as NEL -import Data.Maybe (Maybe(..)) -import Data.NonEmpty ((:|)) -import Data.StrMap as M -import Data.StrMap.Gen (genStrMap) -import Data.Traversable (sequence, traverse) -import Data.TraversableWithIndex (traverseWithIndex) -import Data.Tuple (Tuple(..), fst, snd, uncurry) -import Partial.Unsafe (unsafePartial) -import Test.QuickCheck ((), quickCheck, quickCheck', (===)) -import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) -import Test.QuickCheck.Gen as Gen - -newtype TestStrMap v = TestStrMap (M.StrMap v) - -instance arbTestStrMap :: (Arbitrary v) => Arbitrary (TestStrMap v) where - arbitrary = TestStrMap <$> genStrMap arbitrary arbitrary - -newtype SmallArray v = SmallArray (Array v) - -instance arbSmallArray :: (Arbitrary v) => Arbitrary (SmallArray v) where - arbitrary = SmallArray <$> Gen.resize 3 arbitrary - -data Instruction k v = Insert k v | Delete k - -instance showInstruction :: (Show k, Show v) => Show (Instruction k v) where - show (Insert k v) = "Insert (" <> show k <> ") (" <> show v <> ")" - show (Delete k) = "Delete (" <> show k <> ")" - -instance arbInstruction :: (Arbitrary v) => Arbitrary (Instruction String v) where - arbitrary = do - b <- arbitrary - k <- Gen.frequency $ Tuple 10.0 (pure "hasOwnProperty") :| pure (Tuple 50.0 arbitrary) - case b of - true -> do - v <- arbitrary - pure (Insert k v) - false -> do - pure (Delete k) - -runInstructions :: forall v. L.List (Instruction String v) -> M.StrMap v -> M.StrMap v -runInstructions instrs t0 = foldl step t0 instrs - where - step tree (Insert k v) = M.insert k v tree - step tree (Delete k) = M.delete k tree - -number :: Int -> Int -number n = n - -toAscArray :: forall a. M.StrMap a -> Array (Tuple String a) -toAscArray = M.toAscUnfoldable - -strMapTests :: forall eff. Eff (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) Unit -strMapTests = do - log "Test inserting into empty tree" - quickCheck $ \k v -> M.lookup k (M.insert k v M.empty) == Just (number v) - ("k: " <> show k <> ", v: " <> show v) - - log "Test inserting two values with same key" - quickCheck $ \k v1 v2 -> - M.lookup k (M.insert k v2 (M.insert k v1 M.empty)) == Just (number v2) - - log "Test delete after inserting" - quickCheck $ \k v -> M.isEmpty (M.delete k (M.insert k (number v) M.empty)) - ("k: " <> show k <> ", v: " <> show v) - - log "Test pop after inserting" - quickCheck $ \k v -> M.pop k (M.insert k (number v) M.empty) == Just (Tuple v M.empty) - ("k: " <> show k <> ", v: " <> show v) - - log "Pop non-existent key" - quickCheck $ \k1 k2 v -> k1 == k2 || M.pop k2 (M.insert k1 (number v) M.empty) == Nothing - ("k1: " <> show k1 <> ", k2: " <> show k2 <> ", v: " <> show v) - - log "Insert two, lookup first" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v1 - ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) - - log "Insert two, lookup second" - quickCheck $ \k1 v1 k2 v2 -> M.lookup k2 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty)) == Just v2 - ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) - - log "Insert two, delete one" - quickCheck $ \k1 v1 k2 v2 -> k1 == k2 || M.lookup k2 (M.delete k1 (M.insert k2 (number v2) (M.insert k1 (number v1) M.empty))) == Just v2 - ("k1: " <> show k1 <> ", v1: " <> show v1 <> ", k2: " <> show k2 <> ", v2: " <> show v2) - - log "Lookup from empty" - quickCheck $ \k -> M.lookup k (M.empty :: M.StrMap Int) == Nothing - - log "Lookup from singleton" - quickCheck $ \k v -> M.lookup k (M.singleton k (v :: Int)) == Just v - - log "Random lookup" - quickCheck' 1000 $ \instrs k v -> - let - tree :: M.StrMap Int - tree = M.insert k v (runInstructions instrs M.empty) - in M.lookup k tree == Just v ("instrs:\n " <> show instrs <> "\nk:\n " <> show k <> "\nv:\n " <> show v) - - log "Singleton to list" - quickCheck $ \k v -> M.toUnfoldable (M.singleton k v :: M.StrMap Int) == L.singleton (Tuple k v) - - log "filterWithKey gives submap" - quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> - M.isSubmap (M.filterWithKey p s) s - - log "filterWithKey keeps those keys for which predicate is true" - quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> - A.all (uncurry p) (M.toAscUnfoldable (M.filterWithKey p s) :: Array (Tuple String Int)) - - log "filterKeys gives submap" - quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> - M.isSubmap (M.filterKeys p s) s - - log "filterKeys keeps those keys for which predicate is true" - quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> - A.all p (M.keys (M.filterKeys p s)) - - log "filter gives submap" - quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> - M.isSubmap (M.filter p s) s - - log "filter keeps those values for which predicate is true" - quickCheck $ \(TestStrMap (s :: M.StrMap Int)) p -> - A.all p (M.values (M.filter p s)) - - log "fromFoldable [] = empty" - quickCheck (M.fromFoldable [] == (M.empty :: M.StrMap Unit) - "was not empty") - - log "fromFoldable & key collision" - do - let nums = M.fromFoldable [Tuple "0" "zero", Tuple "1" "what", Tuple "1" "one"] - quickCheck (M.lookup "0" nums == Just "zero" "invalid lookup - 0") - quickCheck (M.lookup "1" nums == Just "one" "invalid lookup - 1") - quickCheck (M.lookup "2" nums == Nothing "invalid lookup - 2") - - log "fromFoldableWith const [] = empty" - quickCheck (M.fromFoldableWith const [] == (M.empty :: M.StrMap Unit) - "was not empty") - - log "fromFoldableWith (+) & key collision" - do - let nums = M.fromFoldableWith (+) [Tuple "0" 1, Tuple "1" 1, Tuple "1" 1] - quickCheck (M.lookup "0" nums == Just 1 "invalid lookup - 0") - quickCheck (M.lookup "1" nums == Just 2 "invalid lookup - 1") - quickCheck (M.lookup "2" nums == Nothing "invalid lookup - 2") - - log "toUnfoldable . fromFoldable = id" - quickCheck $ \arr -> let f x = M.toUnfoldable (M.fromFoldable x) - in f (f arr) == f (arr :: L.List (Tuple String Int)) show arr - - log "fromFoldable . toUnfoldable = id" - quickCheck $ \(TestStrMap m) -> - let f m1 = M.fromFoldable ((M.toUnfoldable m1) :: L.List (Tuple String Int)) in - M.toUnfoldable (f m) == (M.toUnfoldable m :: L.List (Tuple String Int)) show m - - log "fromFoldableWith const = fromFoldable" - quickCheck $ \arr -> M.fromFoldableWith const arr == - M.fromFoldable (arr :: L.List (Tuple String Int)) show arr - - log "fromFoldableWith (<>) = fromFoldable . collapse with (<>) . group on fst" - quickCheck $ \arr -> - let combine (Tuple s a) (Tuple t b) = (Tuple s $ b <> a) - foldl1 g = unsafePartial \(L.Cons x xs) -> foldl g x xs - f = M.fromFoldable <<< map (foldl1 combine <<< NEL.toList) <<< - L.groupBy ((==) `on` fst) <<< L.sortBy (compare `on` fst) in - M.fromFoldableWith (<>) arr == f (arr :: L.List (Tuple String String)) show arr - - log "Lookup from union" - quickCheck $ \(TestStrMap m1) (TestStrMap m2) k -> - M.lookup k (M.union m1 m2) == (case M.lookup k m1 of - Nothing -> M.lookup k m2 - Just v -> Just (number v)) ("m1: " <> show m1 <> ", m2: " <> show m2 <> ", k: " <> show k <> ", v1: " <> show (M.lookup k m1) <> ", v2: " <> show (M.lookup k m2) <> ", union: " <> show (M.union m1 m2)) - - log "Union is idempotent" - quickCheck $ \(TestStrMap m1) (TestStrMap m2) -> - (m1 `M.union` m2) == ((m1 `M.union` m2) `M.union` (m2 :: M.StrMap Int)) (show (M.size (m1 `M.union` m2)) <> " != " <> show (M.size ((m1 `M.union` m2) `M.union` m2))) - - log "fromFoldable = zip keys values" - quickCheck $ \(TestStrMap m) -> M.toUnfoldable m == A.zipWith Tuple (M.keys m) (M.values m :: Array Int) - - log "mapWithKey is correct" - quickCheck $ \(TestStrMap m :: TestStrMap Int) -> let - f k v = k <> show v - resultViaMapWithKey = m # M.mapWithKey f - resultViaLists = m # M.toUnfoldable # map (\(Tuple k v) → Tuple k (f k v)) # (M.fromFoldable :: forall a. L.List (Tuple String a) -> M.StrMap a) - in resultViaMapWithKey === resultViaLists - - log "foldl = foldlWithIndex <<< const" - quickCheck \(TestStrMap m :: TestStrMap String) -> - let f z v = z <> "," <> v - in foldl f "" m === foldlWithIndex (const f) "" m - - log "foldr = foldrWithIndex <<< const" - quickCheck \(TestStrMap m :: TestStrMap String) -> - let f v z = v <> "," <> z - in foldr f "" m === foldrWithIndex (const f) "" m - - log "foldlWithIndex = foldrWithIndex with flipped operation" - quickCheck \(TestStrMap m :: TestStrMap String) -> - let f k z v = z <> "," <> k <> ":" <> v - g k v z = k <> ":" <> v <> "," <> z - in foldlWithIndex f "" m <> "," === "," <> foldrWithIndex g "" m - - log "foldMapWithIndex f ~ traverseWithIndex (\\k v -> tell (f k v))" - quickCheck \(TestStrMap m :: TestStrMap Int) -> - let f k v = "(" <> "k" <> "," <> show v <> ")" - resultA = foldMapWithIndex f m - resultB = snd (runWriter (traverseWithIndex (\k v -> tell (f k v)) m)) - in resultA === resultB - - log "traverse = traverseWithIndex <<< const (for m = Writer)" - quickCheck \(TestStrMap m :: TestStrMap String) -> - runWriter (traverse tell m) === - runWriter (traverseWithIndex (const tell) m) - - log "sequence works (for m = Array)" - quickCheck \(TestStrMap mOfSmallArrays :: TestStrMap (SmallArray Int)) -> - let m = (\(SmallArray a) -> a) <$> mOfSmallArrays - Tuple keys values = A.unzip (toAscArray m) - resultViaArrays = (M.fromFoldable <<< A.zip keys) <$> sequence values - in A.sort (sequence m) === A.sort (resultViaArrays) - - log "sequence works (for m = Maybe)" - quickCheck \(TestStrMap m :: TestStrMap (Maybe Int)) -> - let Tuple keys values = A.unzip (toAscArray m) - resultViaArrays = (M.fromFoldable <<< A.zip keys) <$> sequence values - in sequence m === resultViaArrays - - log "Bug #63: accidental observable mutation in foldMap" - quickCheck \(TestStrMap m) -> - let lhs = go m - rhs = go m - in lhs == rhs ("lhs: " <> show lhs <> ", rhs: " <> show rhs) - where - go :: M.StrMap (Array Ordering) -> Array Ordering - go = M.foldMap \_ v -> v diff --git a/test/Test/Main.purs b/test/Test/Main.purs deleted file mode 100644 index 232714d2..00000000 --- a/test/Test/Main.purs +++ /dev/null @@ -1,19 +0,0 @@ -module Test.Main where - -import Prelude - -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (log, CONSOLE) -import Control.Monad.Eff.Exception (EXCEPTION) -import Control.Monad.Eff.Random (RANDOM) - -import Test.Data.Map (mapTests) -import Test.Data.StrMap (strMapTests) - -main :: Eff (console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION) Unit -main = do - log "Running Map tests" - mapTests - - log "Running StrMap tests" - strMapTests