From b8a898860c913fb8631763793f931e21dc9224e7 Mon Sep 17 00:00:00 2001
From: Nicolas Godbout <nicolas.godbout@gmail.com>
Date: Mon, 27 Jun 2016 15:24:33 -0400
Subject: [PATCH] Add 'lookup' function to Data.Set
* WHAT?
This commit contains the implementation of a proposal to add a 'lookup'
function on 'Set' in the "containers" package.
The function
> lookup :: Ord a => a -> Set a -> Maybe a
is almost indentical to the 'member' function but, in addition, returns the value
stored in the set.
* WHY?
The point of this proposal is to facilitate program-wide data sharing. The 'lookup'
function gives access to a pointer to an object already stored in a Set and equal
to a given argument. The 'lookup' function is a natural extension to the current
'lookupLT', 'lookupGT', 'lookupLE' and 'lookupGE' functions, with obvious semantics.
Example use case: In a parser, the memory footprint can be reduced by collapsing
all equal strings to a single instance of each string. To achieve this, one needs
a way to get a previously seen string (internally, a pointer) equal to a newly
parsed string. Amazingly, this is very difficult with the current "containers" library interface. One current option is to use a Map instead, e.g., 'Map String String'
which stores twice as many pointers as necessary.
* HOW?
The git commit contains the straight-forward implementation of the 'lookup' function
on 'Set', with test cases.
---
Data/Set.hs | 2 ++
Data/Set/Base.hs | 18 +++++++++++++++++-
tests/set-properties.hs | 12 +++++++++++-
3 files changed, 30 insertions(+), 2 deletions(-)
diff --git a/Data/Set.hs b/Data/Set.hs
index fd8c8b96e..f2cf1ea49 100644
--- a/Data/Set.hs
+++ b/Data/Set.hs
@@ -63,6 +63,7 @@ module Data.Set (
, size
, member
, notMember
+ , lookup
, lookupLT
, lookupGT
, lookupLE
@@ -146,6 +147,7 @@ module Data.Set (
) where
import Data.Set.Base as S
+import Prelude ()
-- $strictness
--
diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs
index 92bfc1dcc..fc1bc5ff3 100644
--- a/Data/Set/Base.hs
+++ b/Data/Set/Base.hs
@@ -114,6 +114,7 @@ module Data.Set.Base (
, size
, member
, notMember
+ , lookup
, lookupLT
, lookupGT
, lookupLE
@@ -194,7 +195,7 @@ module Data.Set.Base (
, merge
) where
-import Prelude hiding (filter,foldl,foldr,null,map)
+import Prelude hiding (filter,foldl,foldr,null,map,lookup)
import qualified Data.List as List
import Data.Bits (shiftL, shiftR)
#if !MIN_VERSION_base(4,8,0)
@@ -370,6 +371,21 @@ notMember a t = not $ member a t
{-# INLINE notMember #-}
#endif
+-- | /O(log n)/. Find the given element and return the copy contained in the set.
+lookup :: Ord a => a -> Set a -> Maybe a
+lookup = go
+ where
+ go !_ Tip = Nothing
+ go x (Bin _ y l r) = case compare x y of
+ LT -> go x l
+ GT -> go x r
+ EQ -> Just y
+#if __GLASGOW_HASKELL__
+{-# INLINABLE lookup #-}
+#else
+{-# INLINE lookup #-}
+#endif
+
-- | /O(log n)/. Find largest element smaller than the given one.
--
-- > lookupLT 3 (fromList [3, 5]) == Nothing
diff --git a/tests/set-properties.hs b/tests/set-properties.hs
index 694437c0f..5a083d496 100644
--- a/tests/set-properties.hs
+++ b/tests/set-properties.hs
@@ -12,7 +12,8 @@ import Test.HUnit hiding (Test, Testable)
import Test.QuickCheck
main :: IO ()
-main = defaultMain [ testCase "lookupLT" test_lookupLT
+main = defaultMain [ testCase "lookup" test_lookup
+ , testCase "lookupLT" test_lookupLT
, testCase "lookupGT" test_lookupGT
, testCase "lookupLE" test_lookupLE
, testCase "lookupGE" test_lookupGE
@@ -24,6 +25,7 @@ main = defaultMain [ testCase "lookupLT" test_lookupLT
, testProperty "prop_Single" prop_Single
, testProperty "prop_Member" prop_Member
, testProperty "prop_NotMember" prop_NotMember
+ , testProperty "prop_Lookup" prop_Lookup
, testProperty "prop_LookupLT" prop_LookupLT
, testProperty "prop_LookupGT" prop_LookupGT
, testProperty "prop_LookupLE" prop_LookupLE
@@ -73,6 +75,11 @@ main = defaultMain [ testCase "lookupLT" test_lookupLT
-- Unit tests
----------------------------------------------------------------
+test_lookup :: Assertion
+test_lookup = do
+ lookup 3 (fromList [3, 5]) @?= Just 3
+ lookup 4 (fromList [3, 5]) @?= Nothing
+
test_lookupLT :: Assertion
test_lookupLT = do
lookupLT 3 (fromList [3, 5]) @?= Nothing
@@ -192,6 +199,9 @@ test_LookupSomething lookup' cmp xs =
filter_odd [_] = []
filter_odd (_ : o : xs) = o : filter_odd xs
+prop_Lookup :: [Int] -> Bool
+prop_Lookup = test_LookupSomething lookup (==)
+
prop_LookupLT :: [Int] -> Bool
prop_LookupLT = test_LookupSomething lookupLT (<)