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

Commits:

1 changed file:

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.