Adding HasCallStack to Partial functions

containers/changelog.md

@@ -13,6 +13,9 @@
 * Add `fromSetA` for `Map` and `IntMap`. (L0neGamer)
   ([#1163](https://github.com/haskell/containers/pull/1163))
 
+* Added `HasCallStack` to many partial functions when compiling for GHC. (L0neGamer & dwincort)
+  ([#1160](https://github.com/haskell/containers/pull/1160))
+
 ### Performance improvements
 
 * Improved performance for `Data.IntMap.restrictKeys` and

containers/src/Data/IntMap/Internal.hs

@@ -357,6 +357,7 @@ import Data.Data (Data(..), Constr, mkConstr, constrIndex,
 import qualified Data.Data as Data
 import GHC.Exts (build)
 import qualified GHC.Exts as GHCExts
+import GHC.Stack (HasCallStack)
 #  if __GLASGOW_HASKELL__ >= 914
 import Language.Haskell.TH.Lift (Lift)
 #  else
@@ -370,7 +371,6 @@ import Text.Read
 #endif
 import qualified Control.Category as Category
 
-
 {--------------------------------------------------------------------
   Types
 --------------------------------------------------------------------}
@@ -435,8 +435,20 @@ deriving instance Lift a => Lift (IntMap a)
 -- > fromList [(5,'a'), (3,'b')] ! 1    Error: element not in the map
 -- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'
 
+#ifdef __GLASGOW_HASKELL__
+(!) :: HasCallStack => IntMap a -> Key -> a
+#else
 (!) :: IntMap a -> Key -> a
-(!) m k = find k m
+#endif
+(!) m0 !k = go m0
+  where
+    go (Bin p l r) | left k p  = go l
+                   | otherwise = go r
+    go (Tip kx x) | k == kx   = x
+                  | otherwise = not_found
+    go Nil = not_found
+
+    not_found = error ("IntMap.!: key " ++ show k ++ " is not an element of the map")
 
 -- | \(O(\min(n,W))\). Find the value at a key.
 -- Returns 'Nothing' when the element can not be found.
@@ -654,18 +666,6 @@ lookup !k = go
                   | otherwise = Nothing
     go Nil = Nothing
 
--- See Note: Local 'go' functions and capturing]
-find :: Key -> IntMap a -> a
-find !k = go
-  where
-    go (Bin p l r) | left k p  = go l
-                   | otherwise = go r
-    go (Tip kx x) | k == kx   = x
-                  | otherwise = not_found
-    go Nil = not_found
-
-    not_found = error ("IntMap.!: key " ++ show k ++ " is not an element of the map")
-
 -- | \(O(\min(n,W))\). The expression @('findWithDefault' def k map)@
 -- returns the value at key @k@ or returns @def@ when the key is not an
 -- element of the map.
@@ -2384,15 +2384,23 @@ minView t = fmap (\((_, x), t') -> (x, t')) (minViewWithKey t)
 -- Calls 'error' if the map is empty.
 --
 -- __Note__: This function is partial. Prefer 'maxViewWithKey'.
+#ifdef __GLASGOW_HASKELL__
+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.
 --
 -- Calls 'error' if the map is empty.
 --
 -- __Note__: This function is partial. Prefer 'minViewWithKey'.
+#ifdef __GLASGOW_HASKELL__
+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
 
 -- The KeyValue type is used when returning a key-value pair and helps with
@@ -2427,7 +2435,11 @@ lookupMin (Bin p l r) =
 -- | \(O(\min(n,W))\). The minimal key of the map. Calls 'error' if the map is empty.
 --
 -- __Note__: This function is partial. Prefer 'lookupMin'.
+#ifdef __GLASGOW_HASKELL__
+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"
@@ -2448,7 +2460,11 @@ lookupMax (Bin p l r) =
 -- | \(O(\min(n,W))\). The maximal key of the map. Calls 'error' if the map is empty.
 --
 -- __Note__: This function is partial. Prefer 'lookupMax'.
+#ifdef __GLASGOW_HASKELL__
+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"

containers/src/Data/IntSet/Internal.hs

@@ -226,6 +226,7 @@ import Data.Data (Data(..), Constr, mkConstr, constrIndex, DataType, mkDataType)
 import qualified Data.Data
 import Text.Read
 import Data.Coerce (coerce)
+import GHC.Stack (HasCallStack)
 #endif
 
 #if __GLASGOW_HASKELL__
@@ -1153,15 +1154,23 @@ minView t =
 -- Calls 'error' if the set is empty.
 --
 -- __Note__: This function is partial. Prefer 'minView'.
+#ifdef __GLASGOW_HASKELL__
+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.
 --
 -- Calls 'error' if the set is empty.
 --
 -- __Note__: This function is partial. Prefer 'maxView'.
+#ifdef __GLASGOW_HASKELL__
+deleteFindMax :: HasCallStack => IntSet -> (Key, IntSet)
+#else
 deleteFindMax :: IntSet -> (Key, IntSet)
+#endif
 deleteFindMax = fromMaybe (error "deleteFindMax: empty set has no maximal element") . maxView
 
 lookupMinSure :: IntSet -> Key
@@ -1183,7 +1192,11 @@ lookupMin (Bin p l r) = Just $! lookupMinSure (if signBranch p then r else l)
 -- is empty.
 --
 -- __Note__: This function is partial. Prefer 'lookupMin'.
+#ifdef __GLASGOW_HASKELL__
+findMin :: HasCallStack => IntSet -> Key
+#else
 findMin :: IntSet -> Key
+#endif
 findMin t
   | Just r <- lookupMin t = r
   | otherwise = error "findMin: empty set has no minimal element"
@@ -1207,7 +1220,11 @@ lookupMax (Bin p l r) = Just $! lookupMaxSure (if signBranch p then l else r)
 -- is empty.
 --
 -- __Note__: This function is partial. Prefer 'lookupMax'.
+#ifdef __GLASGOW_HASKELL__
+findMax :: HasCallStack => IntSet -> Key
+#else
 findMax :: IntSet -> Key
+#endif
 findMax t
   | Just r <- lookupMax t = r
   | otherwise = error "findMax: empty set has no maximal element"

containers/src/Data/Map/Internal.hs

@@ -410,6 +410,7 @@ import Utils.Containers.Internal.BitUtil (wordSize)
 
 #if __GLASGOW_HASKELL__
 import GHC.Exts (build, lazy)
+import GHC.Stack (HasCallStack)
 #  if __GLASGOW_HASKELL__ >= 914
 import Language.Haskell.TH.Lift (Lift)
 #  else
@@ -442,9 +443,19 @@ infixl 9 !,!?,\\ --
 -- > fromList [(5,'a'), (3,'b')] ! 1    Error: element not in the map
 -- > fromList [(5,'a'), (3,'b')] ! 5 == 'a'
 
+#ifdef __GLASGOW_HASKELL__
+(!) :: (HasCallStack, Ord k) => Map k a -> k -> a
+#else
 (!) :: Ord k => Map k a -> k -> a
-(!) m k = find k m
-{-# INLINE (!) #-}
+#endif
+(!) m !k = go m
+  where
+    go Tip = error "Map.!: given key is not an element in the map"
+    go (Bin _ kx x l r) = case compare k kx of
+      LT -> go l
+      GT -> go r
+      EQ -> x
+{-# INLINABLE (!) #-}
 
 -- | \(O(\log n)\). Find the value at a key.
 -- Returns 'Nothing' when the element can not be found.
@@ -610,16 +621,6 @@ notMember :: Ord k => k -> Map k a -> Bool
 notMember k m = not $ member k m
 {-# INLINABLE notMember #-}
 
-find :: Ord k => k -> Map k a -> a
-find = go
-  where
-    go !_ Tip = error "Map.!: given key is not an element in the map"
-    go k (Bin _ kx x l r) = case compare k kx of
-      LT -> go k l
-      GT -> go k r
-      EQ -> x
-{-# INLINABLE find #-}
-
 -- | \(O(\log n)\). The expression @('findWithDefault' def k map)@ returns
 -- the value at key @k@ or returns default value @def@
 -- when the key is not in the map.
@@ -1431,7 +1432,11 @@ alterFYoneda = go
 -- > findIndex 6 (fromList [(5,"a"), (3,"b")])    Error: element is not in the map
 
 -- See Note: Type of local 'go' function
+#ifdef __GLASGOW_HASKELL__
+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
@@ -1473,15 +1478,20 @@ lookupIndex = go 0
 -- > elemAt 1 (fromList [(5,"a"), (3,"b")]) == (5, "a")
 -- > elemAt 2 (fromList [(5,"a"), (3,"b")])    Error: index out of range
 
+#ifdef __GLASGOW_HASKELL__
+elemAt :: HasCallStack => Int -> Map k a -> (k,a)
+#else
 elemAt :: Int -> Map k a -> (k,a)
-elemAt !_ Tip = error "Map.elemAt: index out of range"
-elemAt i (Bin _ kx x l r)
-  = case compare i sizeL of
-      LT -> elemAt i l
-      GT -> elemAt (i-sizeL-1) r
-      EQ -> (kx,x)
-  where
-    sizeL = size l
+#endif
+elemAt = go where
+  go !_ Tip = error "Map.elemAt: index out of range"
+  go i (Bin _ kx x l r)
+    = case compare i sizeL of
+        LT -> go i l
+        GT -> go (i-sizeL-1) r
+        EQ -> (kx,x)
+    where
+      sizeL = size l
 
 -- | \(O(\log n)\). Take a given number of entries in key order, beginning
 -- with the smallest keys.
@@ -1564,18 +1574,23 @@ 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
 
+#ifdef __GLASGOW_HASKELL__
+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
-updateAt f !i t =
-  case t of
-    Tip -> error "Map.updateAt: index out of range"
-    Bin sx kx x l r -> case compare i sizeL of
-      LT -> balanceR kx x (updateAt f i l) r
-      GT -> balanceL kx x l (updateAt f (i-sizeL-1) r)
-      EQ -> case f kx x of
-              Just x' -> Bin sx kx x' l r
-              Nothing -> glue l r
-      where
-        sizeL = size l
+#endif
+updateAt = go where
+  go f !i t =
+    case t of
+      Tip -> error "Map.updateAt: index out of range"
+      Bin sx kx x l r -> case compare i sizeL of
+        LT -> balanceR kx x (go f i l) r
+        GT -> balanceL kx x l (go f (i-sizeL-1) r)
+        EQ -> case f kx x of
+                Just x' -> Bin sx kx x' l r
+                Nothing -> glue l r
+        where
+          sizeL = size l
 
 -- | \(O(\log n)\). Delete the element at /index/, i.e. by its zero-based index in
 -- the sequence sorted by keys. If the /index/ is out of range (less than zero,
@@ -1588,16 +1603,21 @@ 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
 
+#ifdef __GLASGOW_HASKELL__
+deleteAt :: HasCallStack => Int -> Map k a -> Map k a
+#else
 deleteAt :: Int -> Map k a -> Map k a
-deleteAt !i t =
-  case t of
-    Tip -> error "Map.deleteAt: index out of range"
-    Bin _ kx x l r -> case compare i sizeL of
-      LT -> balanceR kx x (deleteAt i l) r
-      GT -> balanceL kx x l (deleteAt (i-sizeL-1) r)
-      EQ -> glue l r
-      where
-        sizeL = size l
+#endif
+deleteAt = go where
+  go !i t =
+    case t of
+      Tip -> error "Map.deleteAt: index out of range"
+      Bin _ kx x l r -> case compare i sizeL of
+        LT -> balanceR kx x (go i l) r
+        GT -> balanceL kx x l (go (i-sizeL-1) r)
+        EQ -> glue l r
+        where
+          sizeL = size l
 
 
 {--------------------------------------------------------------------
@@ -1645,7 +1665,11 @@ lookupMin (Bin _ k x l _) = Just $! kvToTuple (lookupMinSure k x l)
 -- > findMin (fromList [(5,"a"), (3,"b")]) == (3,"b")
 -- > findMin empty                            Error: empty map has no minimal element
 
+#ifdef __GLASGOW_HASKELL__
+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"
@@ -1673,7 +1697,11 @@ lookupMax (Bin _ k x _ r) = Just $! kvToTuple (lookupMaxSure k x r)
 -- > findMax (fromList [(5,"a"), (3,"b")]) == (5,"a")
 -- > findMax empty                            Error: empty map has no maximal element
 
+#ifdef __GLASGOW_HASKELL__
+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"
@@ -4071,7 +4099,11 @@ maxViewSure !k x !l r = case r of
 -- Calls 'error' if the map is empty.
 --
 -- __Note__: This function is partial. Prefer 'minViewWithKey'.
+#ifdef __GLASGOW_HASKELL__
+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
@@ -4081,7 +4113,11 @@ deleteFindMin t = case minViewWithKey t of
 -- Calls 'error' if the map is empty.
 --
 -- __Note__: This function is partial. Prefer 'maxViewWithKey'.
+#ifdef __GLASGOW_HASKELL__
+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