Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Added HasCallStack to partial functions #493

Open
wants to merge 5 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
24 changes: 24 additions & 0 deletions Data/IntMap/Internal.hs
Expand Up @@ -331,6 +331,10 @@ import qualified Control.Category as Category
import Data.Coerce
#endif

#if __GLASGOW_HASKELL__ >= 800
import GHC.Stack (HasCallStack)
#endif


-- A "Nat" is a natural machine word (an unsigned Int)
type Nat = Word
Expand Down Expand Up @@ -390,7 +394,11 @@ bitmapOf x = shiftLL 1 (x .&. IntSet.suffixBitMask)
-- > fromList [(5,'a'), (3,'b')] ! 1 Error: element not in the map
-- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'

#if __GLASGOW_HASKELL__ >= 800
(!) :: HasCallStack => IntMap a -> Key -> a
#else
(!) :: IntMap a -> Key -> a
#endif
(!) m k = find k m

-- | /O(min(n,W))/. Find the value at a key.
Expand Down Expand Up @@ -2169,11 +2177,19 @@ minView :: IntMap a -> Maybe (a, IntMap a)
minView t = liftM (first snd) (minViewWithKey t)

-- | /O(min(n,W))/. Delete and find the maximal element.
#if __GLASGOW_HASKELL__ >= 800
deleteFindMax :: HasCallStack => IntMap a -> ((Key, a), IntMap a)
#else
deleteFindMax :: IntMap a -> ((Key, a), IntMap a)
#endif
deleteFindMax = fromMaybe (error "deleteFindMax: empty map has no maximal element") . maxViewWithKey

-- | /O(min(n,W))/. Delete and find the minimal element.
#if __GLASGOW_HASKELL__ >= 800
deleteFindMin :: HasCallStack => IntMap a -> ((Key, a), IntMap a)
#else
deleteFindMin :: IntMap a -> ((Key, a), IntMap a)
#endif
deleteFindMin = fromMaybe (error "deleteFindMin: empty map has no minimal element") . minViewWithKey

-- | /O(min(n,W))/. The minimal key of the map. Returns 'Nothing' if the map is empty.
Expand All @@ -2188,7 +2204,11 @@ lookupMin (Bin _ m l r)
go Nil = Nothing

-- | /O(min(n,W))/. The minimal key of the map. Calls 'error' if the map is empty.
#if __GLASGOW_HASKELL__ >= 800
findMin :: HasCallStack => IntMap a -> (Key, a)
#else
findMin :: IntMap a -> (Key, a)
#endif
findMin t
| Just r <- lookupMin t = r
| otherwise = error "findMin: empty map has no minimal element"
Expand All @@ -2205,7 +2225,11 @@ lookupMax (Bin _ m l r)
go Nil = Nothing

-- | /O(min(n,W))/. The maximal key of the map. Calls 'error' if the map is empty.
#if __GLASGOW_HASKELL__ >= 800
findMax :: HasCallStack => IntMap a -> (Key, a)
#else
findMax :: IntMap a -> (Key, a)
#endif
findMax t
| Just r <- lookupMax t = r
| otherwise = error "findMax: empty map has no maximal element"
Expand Down
19 changes: 19 additions & 0 deletions Data/IntSet/Internal.hs
Expand Up @@ -216,6 +216,9 @@ import qualified GHC.Exts as GHCExts
import GHC.Prim (indexInt8OffAddr#)
#endif

#if __GLASGOW_HASKELL__ >= 800
import GHC.Stack (HasCallStack)
#endif

infixl 9 \\{-This comment teaches CPP correct behaviour -}

Expand Down Expand Up @@ -793,18 +796,30 @@ minView t =
-- | /O(min(n,W))/. Delete and find the minimal element.
--
-- > deleteFindMin set = (findMin set, deleteMin set)
#if __GLASGOW_HASKELL__ >= 800
deleteFindMin :: HasCallStack => IntSet -> (Key, IntSet)
#else
deleteFindMin :: IntSet -> (Key, IntSet)
#endif
deleteFindMin = fromMaybe (error "deleteFindMin: empty set has no minimal element") . minView

-- | /O(min(n,W))/. Delete and find the maximal element.
--
-- > deleteFindMax set = (findMax set, deleteMax set)
#if __GLASGOW_HASKELL__ >= 800
deleteFindMax :: HasCallStack => IntSet -> (Key, IntSet)
#else
deleteFindMax :: IntSet -> (Key, IntSet)
#endif
deleteFindMax = fromMaybe (error "deleteFindMax: empty set has no maximal element") . maxView


-- | /O(min(n,W))/. The minimal element of the set.
#if __GLASGOW_HASKELL__ >= 800
findMin :: HasCallStack => IntSet -> Key
#else
findMin :: IntSet -> Key
#endif
findMin Nil = error "findMin: empty set has no minimal element"
Copy link
Contributor

Choose a reason for hiding this comment

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

Does the call stack grow through the recursion here or elsewhere? If so, that's a big problem. You can check the Core to be sure. We know there are no Nils except at the root, but GHC does not! If the stacks build, you'll need to restructure the functions to fix that. Watch out for performance. If the times for the current benchmarks exercising these functions are too short to trust, consider adding more benchmarks.

Copy link
Author

Choose a reason for hiding this comment

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

Wow, yes it does. I didn't realize it would do that. The fix is to use an internal go function. I'll update the PR with that in a moment.

On a related note, I realized that my HasCallStack for Map.! was wrong because Map.! calls find which actually throws the error. Is there a reason it uses find rather than lookup? My inclination is to remove find altogether (it's only used by ! and looks identical other than the Maybe wrapper) and replace with lookup---then ! can call error itself, which should then make HasCallStack work the way we want.

Copy link
Author

Choose a reason for hiding this comment

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

Oh, I just noticed the [Note: Local 'go' functions and capturing] -- I'll read that and try to make sure I'm not doing anything stupid.

findMin (Tip kx bm) = kx + lowestBitSet bm
findMin (Bin _ m l r)
Expand All @@ -815,7 +830,11 @@ findMin (Bin _ m l r)
find Nil = error "findMin Nil"

-- | /O(min(n,W))/. The maximal element of a set.
#if __GLASGOW_HASKELL__ >= 800
findMax :: HasCallStack => IntSet -> Key
#else
findMax :: IntSet -> Key
#endif
findMax Nil = error "findMax: empty set has no maximal element"
findMax (Tip kx bm) = kx + highestBitSet bm
findMax (Bin _ m l r)
Expand Down
43 changes: 43 additions & 0 deletions Data/Map/Internal.hs
Expand Up @@ -411,6 +411,9 @@ import qualified Control.Category as Category
import Data.Coerce
#endif

#if __GLASGOW_HASKELL__ >= 800
import GHC.Stack (HasCallStack)
#endif

{--------------------------------------------------------------------
Operators
Expand All @@ -423,7 +426,11 @@ infixl 9 !,!?,\\ --
-- > fromList [(5,'a'), (3,'b')] ! 1 Error: element not in the map
-- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'

#if __GLASGOW_HASKELL__ >= 800
(!) :: (HasCallStack, Ord k) => Map k a -> k -> a
#else
(!) :: Ord k => Map k a -> k -> a
#endif
(!) m k = find k m
#if __GLASGOW_HASKELL__
{-# INLINE (!) #-}
Expand Down Expand Up @@ -1433,7 +1440,11 @@ alterFYoneda = go
-- > findIndex 6 (fromList [(5,"a"), (3,"b")]) Error: element is not in the map

-- See Note: Type of local 'go' function
#if __GLASGOW_HASKELL__ >= 800
findIndex :: (HasCallStack, Ord k) => k -> Map k a -> Int
#else
findIndex :: Ord k => k -> Map k a -> Int
#endif
findIndex = go 0
where
go :: Ord k => Int -> k -> Map k a -> Int
Expand Down Expand Up @@ -1477,7 +1488,11 @@ lookupIndex = go 0
-- > elemAt 1 (fromList [(5,"a"), (3,"b")]) == (5, "a")
-- > elemAt 2 (fromList [(5,"a"), (3,"b")]) Error: index out of range

#if __GLASGOW_HASKELL__ >= 800
elemAt :: HasCallStack => Int -> Map k a -> (k,a)
#else
elemAt :: Int -> Map k a -> (k,a)
#endif
elemAt !_ Tip = error "Map.elemAt: index out of range"
elemAt i (Bin _ kx x l r)
= case compare i sizeL of
Expand Down Expand Up @@ -1566,7 +1581,11 @@ splitAt i0 m0
-- > updateAt (\_ _ -> Nothing) 2 (fromList [(5,"a"), (3,"b")]) Error: index out of range
-- > updateAt (\_ _ -> Nothing) (-1) (fromList [(5,"a"), (3,"b")]) Error: index out of range

#if __GLASGOW_HASKELL__ >= 800
updateAt :: HasCallStack => (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
#else
updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
#endif
Copy link
Contributor

Choose a reason for hiding this comment

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

Would it be better to just make this function total by making an update at a bad index do nothing?

Copy link
Author

Choose a reason for hiding this comment

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

This is definitely a more interesting question than just where to add HasCallStack and might make more sense for a different issue/PR. Personally, I'm not sure I've ever used the ***At functions, so I'm not really the target audience to be weighing in on this decision. Is there a way you could get community feedback about such a change? Maybe Haskell-cafe?

updateAt f !i t =
case t of
Tip -> error "Map.updateAt: index out of range"
Expand All @@ -1588,7 +1607,11 @@ updateAt f !i t =
-- > deleteAt 2 (fromList [(5,"a"), (3,"b")]) Error: index out of range
-- > deleteAt (-1) (fromList [(5,"a"), (3,"b")]) Error: index out of range

#if __GLASGOW_HASKELL__ >= 800
deleteAt :: HasCallStack => Int -> Map k a -> Map k a
#else
Copy link
Contributor

Choose a reason for hiding this comment

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

Same question here.

deleteAt :: Int -> Map k a -> Map k a
#endif
deleteAt !i t =
case t of
Tip -> error "Map.deleteAt: index out of range"
Expand Down Expand Up @@ -1624,7 +1647,11 @@ lookupMin (Bin _ k x l _) = Just $! lookupMinSure k x l
-- > findMin (fromList [(5,"a"), (3,"b")]) == (3,"b")
-- > findMin empty Error: empty map has no minimal element

#if __GLASGOW_HASKELL__ >= 800
findMin :: HasCallStack => Map k a -> (k,a)
#else
findMin :: Map k a -> (k,a)
#endif
findMin t
| Just r <- lookupMin t = r
| otherwise = error "Map.findMin: empty map has no minimal element"
Expand All @@ -1649,7 +1676,11 @@ lookupMax :: Map k a -> Maybe (k, a)
lookupMax Tip = Nothing
lookupMax (Bin _ k x _ r) = Just $! lookupMaxSure k x r

#if __GLASGOW_HASKELL__ >= 800
findMax :: HasCallStack => Map k a -> (k,a)
#else
findMax :: Map k a -> (k,a)
#endif
findMax t
| Just r <- lookupMax t = r
| otherwise = error "Map.findMax: empty map has no maximal element"
Expand Down Expand Up @@ -2661,7 +2692,11 @@ mergeA
-- @only2@ are 'id' and @'const' 'empty'@, but for example @'map' f@,
-- @'filterWithKey' f@, or @'mapMaybeWithKey' f@ could be used for any @f@.

#if __GLASGOW_HASKELL__ >= 800
mergeWithKey :: (HasCallStack, Ord k)
Copy link
Contributor

Choose a reason for hiding this comment

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

Ehhhhh... Not sure we should bother with this one. mergeWithKey is for users who don't mind the risk of being shot in the foot.

#else
mergeWithKey :: Ord k
#endif
=> (k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
Expand Down Expand Up @@ -3866,7 +3901,11 @@ maxViewSure = go
-- > deleteFindMin (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((3,"b"), fromList[(5,"a"), (10,"c")])
-- > deleteFindMin Error: can not return the minimal element of an empty map

#if __GLASGOW_HASKELL__ >= 800
deleteFindMin :: HasCallStack => Map k a -> ((k,a),Map k a)
#else
deleteFindMin :: Map k a -> ((k,a),Map k a)
#endif
deleteFindMin t = case minViewWithKey t of
Nothing -> (error "Map.deleteFindMin: can not return the minimal element of an empty map", Tip)
Just res -> res
Expand All @@ -3876,7 +3915,11 @@ deleteFindMin t = case minViewWithKey t of
-- > deleteFindMax (fromList [(5,"a"), (3,"b"), (10,"c")]) == ((10,"c"), fromList [(3,"b"), (5,"a")])
-- > deleteFindMax empty Error: can not return the maximal element of an empty map

#if __GLASGOW_HASKELL__ >= 800
deleteFindMax :: HasCallStack => Map k a -> ((k,a),Map k a)
#else
deleteFindMax :: Map k a -> ((k,a),Map k a)
#endif
deleteFindMax t = case maxViewWithKey t of
Nothing -> (error "Map.deleteFindMax: can not return the maximal element of an empty map", Tip)
Just res -> res
Expand Down
8 changes: 8 additions & 0 deletions Data/Map/Strict/Internal.hs
Expand Up @@ -418,6 +418,10 @@ import Data.Coerce
import Data.Functor.Identity (Identity (..))
#endif

#if __GLASGOW_HASKELL__ >= 800
import GHC.Stack (HasCallStack)
#endif


-- $strictness
--
Expand Down Expand Up @@ -881,7 +885,11 @@ atKeyIdentity k f t = Identity $ atKeyPlain Strict k (coerce f) t
-- > updateAt (\_ _ -> Nothing) 2 (fromList [(5,"a"), (3,"b")]) Error: index out of range
-- > updateAt (\_ _ -> Nothing) (-1) (fromList [(5,"a"), (3,"b")]) Error: index out of range

#if __GLASGOW_HASKELL__ >= 800
updateAt :: HasCallStack => (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
#else
updateAt :: (k -> a -> Maybe a) -> Int -> Map k a -> Map k a
#endif
updateAt f i t = i `seq`
case t of
Tip -> error "Map.updateAt: index out of range"
Expand Down