Matthew Pickering pushed to branch wip/t26751 at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • libraries/ghc-internal/src/GHC/Internal/Err.hs
    1 1
     {-# LANGUAGE Trustworthy #-}
    
    2 2
     {-# LANGUAGE NoImplicitPrelude, MagicHash, ImplicitParams #-}
    
    3 3
     {-# LANGUAGE RankNTypes, PolyKinds, DataKinds #-}
    
    4
    +{-# LANGUAGE BangPatterns #-}
    
    4 5
     {-# OPTIONS_HADDOCK not-home #-}
    
    5 6
     
    
    6 7
     -----------------------------------------------------------------------------
    
    ... ... @@ -25,6 +26,7 @@
    25 26
     module GHC.Internal.Err( absentErr, error, errorWithoutStackTrace, undefined ) where
    
    26 27
     import GHC.Internal.Types (Char, RuntimeRep)
    
    27 28
     import GHC.Internal.Stack.Types
    
    29
    +import GHC.Internal.Magic
    
    28 30
     import GHC.Internal.Prim
    
    29 31
     import {-# SOURCE #-} GHC.Internal.Exception
    
    30 32
       ( errorCallWithCallStackException
    
    ... ... @@ -33,7 +35,10 @@ import {-# SOURCE #-} GHC.Internal.Exception
    33 35
     -- | 'error' stops execution and displays an error message.
    
    34 36
     error :: forall (r :: RuntimeRep). forall (a :: TYPE r).
    
    35 37
              HasCallStack => [Char] -> a
    
    36
    -error s = raise# (errorCallWithCallStackException s ?callStack)
    
    38
    +error s =
    
    39
    +  -- Evaluate SomeException before to get accurate callstacks (like throw)
    
    40
    +  let !se = noinline (errorCallWithCallStackException s ?callStack)
    
    41
    +  in raise# se
    
    37 42
               -- Bleh, we should be using 'GHC.Internal.Stack.callStack' instead of
    
    38 43
               -- '?callStack' here, but 'GHC.Internal.Stack.callStack' depends on
    
    39 44
               -- 'GHC.Internal.Stack.popCallStack', which is partial and depends on
    
    ... ... @@ -73,7 +78,9 @@ undefined :: forall (r :: RuntimeRep). forall (a :: TYPE r).
    73 78
     -- nor wanted (see #19886). We’d like to use withFrozenCallStack, but that
    
    74 79
     -- is not available in this module yet, and making it so is hard. So let’s just
    
    75 80
     -- use raise# directly.
    
    76
    -undefined = raise# (errorCallWithCallStackException "Prelude.undefined" ?callStack)
    
    81
    +undefined =
    
    82
    +    let !se = noinline (errorCallWithCallStackException "Prelude.undefined" ?callStack)
    
    83
    +    in raise# se
    
    77 84
     
    
    78 85
     -- | Used for compiler-generated error message;
    
    79 86
     -- encoding saves bytes of string junk.
    

  • testsuite/tests/ghci.debugger/scripts/T8487.stdout
    1 1
     Breakpoint 0 activated at T8487.hs:(5,8)-(7,53)
    
    2 2
     Stopped in Main.f, T8487.hs:(5,8)-(7,53)
    
    3 3
     _result :: IO String = _
    
    4
    -ma :: Either SomeException String = Left _
    4
    +ma :: Either SomeException String = Left
    
    5
    +                                      (SomeException (ErrorCall ...))

  • testsuite/tests/ghci.debugger/scripts/break011.stdout
    ... ... @@ -4,9 +4,10 @@ HasCallStack backtrace:
    4 4
       error, called at <interactive>:2:1 in interactive:Ghci1
    
    5 5
     
    
    6 6
     Stopped in <exception thrown>, <unknown>
    
    7
    -_exception :: e = _
    
    7
    +_exception :: e = GHC.Internal.Exception.Type.SomeException
    
    8
    +                    (GHC.Internal.Exception.ErrorCall _)
    
    8 9
     Stopped in <exception thrown>, <unknown>
    
    9
    -_exception :: e = _
    
    10
    +_exception :: e = SomeException (ErrorCall _)
    
    10 11
     -1  : main (Test7.hs:2:18-28)
    
    11 12
     -2  : main (Test7.hs:2:8-29)
    
    12 13
     <end of history>
    
    ... ... @@ -26,7 +27,7 @@ _exception :: SomeException = SomeException (ErrorCall "foo")
    26 27
     *** Exception: foo
    
    27 28
     
    
    28 29
     HasCallStack backtrace:
    
    29
    -  error, called at Test7.hs:2:18 in main:Main
    
    30
    +  error, called at Test7.hs:2:18 in interactive-session:Main
    
    30 31
     
    
    31 32
     Stopped in <exception thrown>, <unknown>
    
    32 33
     _exception :: e = _
    
    ... ... @@ -35,5 +36,5 @@ _exception :: e = _
    35 36
     *** Exception: foo
    
    36 37
     
    
    37 38
     HasCallStack backtrace:
    
    38
    -  error, called at Test7.hs:2:18 in main:Main
    
    39
    +  error, called at Test7.hs:2:18 in interactive-session:Main
    
    39 40
     

  • testsuite/tests/ghci.debugger/scripts/break017.stdout
    1 1
     "Stopped in <exception thrown>, <unknown>
    
    2
    -_exception :: e = _
    
    2
    +_exception :: e = GHC.Internal.Exception.Type.SomeException
    
    3
    +                    (GHC.Internal.Exception.ErrorCall _)
    
    3 4
     Logged breakpoint at QSort.hs:6:32-34
    
    4 5
     _result :: Char -> Bool
    
    5 6
     a :: Char
    

  • testsuite/tests/ghci.debugger/scripts/break025.stdout
    1 1
     Stopped in <exception thrown>, <unknown>
    
    2
    -_exception :: e = _
    
    2
    +_exception :: e = GHC.Internal.Exception.Type.SomeException
    
    3
    +                    (GHC.Internal.Exception.ErrorCall _)
    
    3 4
     ()