Ensure that GHC.Stack.callStack doesn't fail

Test Plan: Validate, ensure the `f7` program of `IPLocation` doesn't
crash.

Reviewers: gridaphobe, austin, hvr

Reviewed By: gridaphobe

Subscribers: rwbarton, thomie

GHC Trac Issues: #14028

Differential Revision: https://phabricator.haskell.org/D3795

libraries/base/GHC/Stack.hs

@@ -85,7 +85,10 @@ popCallStack stk = case stk of
 --
 -- @since 4.9.0.0
 callStack :: HasCallStack => CallStack
-callStack = popCallStack ?callStack
+callStack =
+  case ?callStack of
+    EmptyCallStack -> EmptyCallStack
+    _              -> popCallStack ?callStack
 {-# INLINE callStack #-}
 
 -- | Perform some computation without adding new entries to the 'CallStack'.

testsuite/tests/typecheck/should_run/IPLocation.hs

@@ -29,9 +29,15 @@ f6 0 = putStrLn $ prettyCallStack ?loc
 f6 n = f6 (n-1)
        -- recursive functions add a SrcLoc for each recursive call
 
+f7 :: IO ()
+f7 = putStrLn (prettyCallStack $ id (\_ -> callStack) ())
+       -- shouldn't crash. See #14043.
+
+main :: IO ()
 main = do f0
           f1
           f3 (\ () -> putStrLn $ prettyCallStack ?loc)
           f4 (\ () -> putStrLn $ prettyCallStack ?loc)
           f5 (\ () -> putStrLn $ prettyCallStack ?loc3)
           f6 5
+          f7