diff options
48 files changed, 465 insertions, 229 deletions
diff --git a/libraries/array b/libraries/array -Subproject dd75c73d191b3f07209c38f78ebe9dcc26fc5ed +Subproject 4b43c95af80ed7e1567244527e5e459912d3e50 diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs index 20b487cc9c..c31a203f9b 100644 --- a/libraries/base/GHC/Exception.hs +++ b/libraries/base/GHC/Exception.hs @@ -38,6 +38,9 @@ import Data.Typeable (Typeable, cast) import GHC.Base import GHC.Show import GHC.Stack.Types +import GHC.OldList +import GHC.IO.Unsafe +import {-# SOURCE #-} GHC.Stack.CCS {- | The @SomeException@ type is the root of the exception type hierarchy. @@ -180,9 +183,17 @@ errorCallException :: String -> SomeException errorCallException s = toException (ErrorCall s) errorCallWithCallStackException :: String -> CallStack -> SomeException -errorCallWithCallStackException s stk - = toException (ErrorCallWithLocation s (showCallStack (popCallStack stk))) - +errorCallWithCallStackException s stk = unsafeDupablePerformIO $ do + ccsStack <- currentCallStack + let + implicitParamCallStack = showCallStackLines (popCallStack stk) + ccsCallStack = showCCSStack ccsStack + stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack + return $ toException (ErrorCallWithLocation s stack) + +showCCSStack :: [String] -> [String] +showCCSStack [] = [] +showCCSStack stk = "CallStack (from -prof):" : map (" " ++) (reverse stk) -- | Pretty print 'SrcLoc' -- @@ -200,17 +211,13 @@ showSrcLoc SrcLoc {..} -- -- @since 4.9.0.0 showCallStack :: CallStack -> String -showCallStack (CallStack stk@(_:_)) - = unlines ("CallStack:" : map (indent . showCallSite) stk) - where - -- Data.OldList isn't available yet, so we repeat the definition here - unlines [] = [] - unlines [l] = l - unlines (l:ls) = l ++ '\n' : unlines ls - indent l = " " ++ l - showCallSite (f, loc) = f ++ ", called at " ++ showSrcLoc loc -showCallStack _ = error "CallStack cannot be empty!" +showCallStack = intercalate "\n" . showCallStackLines +showCallStackLines :: CallStack -> [String] +showCallStackLines (CallStack stk) = + "CallStack (from ImplicitParams):" : map ((" " ++) . showCallSite) stk + where + showCallSite (f, loc) = f ++ ", called at " ++ showSrcLoc loc -- | Remove the most recent callsite from the 'CallStack' -- diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs index f38c88f009..186f6c65c5 100644 --- a/libraries/base/GHC/IO.hs +++ b/libraries/base/GHC/IO.hs @@ -44,6 +44,7 @@ import GHC.Base import GHC.ST import GHC.Exception import GHC.Show +import GHC.IO.Unsafe import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError ) @@ -101,160 +102,6 @@ unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s unsafeSTToIO :: ST s a -> IO a unsafeSTToIO (ST m) = IO (unsafeCoerce# m) --- --------------------------------------------------------------------------- --- Unsafe IO operations - -{-| -This is the \"back door\" into the 'IO' monad, allowing -'IO' computation to be performed at any time. For -this to be safe, the 'IO' computation should be -free of side effects and independent of its environment. - -If the I\/O computation wrapped in 'unsafePerformIO' performs side -effects, then the relative order in which those side effects take -place (relative to the main I\/O trunk, or other calls to -'unsafePerformIO') is indeterminate. Furthermore, when using -'unsafePerformIO' to cause side-effects, you should take the following -precautions to ensure the side effects are performed as many times as -you expect them to be. Note that these precautions are necessary for -GHC, but may not be sufficient, and other compilers may require -different precautions: - - * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@ - that calls 'unsafePerformIO'. If the call is inlined, - the I\/O may be performed more than once. - - * Use the compiler flag @-fno-cse@ to prevent common sub-expression - elimination being performed on the module, which might combine - two side effects that were meant to be separate. A good example - is using multiple global variables (like @test@ in the example below). - - * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the - call to 'unsafePerformIO' cannot float outside a lambda. For example, - if you say: - @ - f x = unsafePerformIO (newIORef []) - @ - you may get only one reference cell shared between all calls to @f@. - Better would be - @ - f x = unsafePerformIO (newIORef [x]) - @ - because now it can't float outside the lambda. - -It is less well known that -'unsafePerformIO' is not type safe. For example: - -> test :: IORef [a] -> test = unsafePerformIO $ newIORef [] -> -> main = do -> writeIORef test [42] -> bang <- readIORef test -> print (bang :: [Char]) - -This program will core dump. This problem with polymorphic references -is well known in the ML community, and does not arise with normal -monadic use of references. There is no easy way to make it impossible -once you use 'unsafePerformIO'. Indeed, it is -possible to write @coerce :: a -> b@ with the -help of 'unsafePerformIO'. So be careful! --} -unsafePerformIO :: IO a -> a -unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m) - -{-| -This version of 'unsafePerformIO' is more efficient -because it omits the check that the IO is only being performed by a -single thread. Hence, when you use 'unsafeDupablePerformIO', -there is a possibility that the IO action may be performed multiple -times (on a multiprocessor), and you should therefore ensure that -it gives the same results each time. It may even happen that one -of the duplicated IO actions is only run partially, and then interrupted -in the middle without an exception being raised. Therefore, functions -like 'bracket' cannot be used safely within 'unsafeDupablePerformIO'. - -@since 4.4.0.0 --} -unsafeDupablePerformIO :: IO a -> a -unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a - --- Note [unsafeDupablePerformIO is NOINLINE] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Why do we NOINLINE unsafeDupablePerformIO? See the comment with --- GHC.ST.runST. Essentially the issue is that the IO computation --- inside unsafePerformIO must be atomic: it must either all run, or --- not at all. If we let the compiler see the application of the IO --- to realWorld#, it might float out part of the IO. - --- Note [unsafeDupablePerformIO has a lazy RHS] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Why is there a call to 'lazy' in unsafeDupablePerformIO? --- If we don't have it, the demand analyser discovers the following strictness --- for unsafeDupablePerformIO: C(U(AV)) --- But then consider --- unsafeDupablePerformIO (\s -> let r = f x in --- case writeIORef v r s of (# s1, _ #) -> --- (# s1, r #) ) --- The strictness analyser will find that the binding for r is strict, --- (because of uPIO's strictness sig), and so it'll evaluate it before --- doing the writeIORef. This actually makes libraries/base/tests/memo002 --- get a deadlock, where we specifically wanted to write a lazy thunk --- into the ref cell. --- --- Solution: don't expose the strictness of unsafeDupablePerformIO, --- by hiding it with 'lazy' --- But see discussion in Trac #9390 (comment:33) - -{-| -'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily. -When passed a value of type @IO a@, the 'IO' will only be performed -when the value of the @a@ is demanded. This is used to implement lazy -file reading, see 'System.IO.hGetContents'. --} -{-# INLINE unsafeInterleaveIO #-} -unsafeInterleaveIO :: IO a -> IO a -unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m) - --- We used to believe that INLINE on unsafeInterleaveIO was safe, --- because the state from this IO thread is passed explicitly to the --- interleaved IO, so it cannot be floated out and shared. --- --- HOWEVER, if the compiler figures out that r is used strictly here, --- then it will eliminate the thunk and the side effects in m will no --- longer be shared in the way the programmer was probably expecting, --- but can be performed many times. In #5943, this broke our --- definition of fixIO, which contains --- --- ans <- unsafeInterleaveIO (takeMVar m) --- --- after inlining, we lose the sharing of the takeMVar, so the second --- time 'ans' was demanded we got a deadlock. We could fix this with --- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes --- share and sometimes not (plus it probably breaks the noDuplicate). --- So now, we do not inline unsafeDupableInterleaveIO. - -{-# NOINLINE unsafeDupableInterleaveIO #-} -unsafeDupableInterleaveIO :: IO a -> IO a -unsafeDupableInterleaveIO (IO m) - = IO ( \ s -> let - r = case m s of (# _, res #) -> res - in - (# s, r #)) - -{-| -Ensures that the suspensions under evaluation by the current thread -are unique; that is, the current thread is not evaluating anything -that is also under evaluation by another thread that has also executed -'noDuplicate'. - -This operation is used in the definition of 'unsafePerformIO' to -prevent the IO action from being executed multiple times, which is usually -undesirable. --} -noDuplicate :: IO () -noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #) - -- ----------------------------------------------------------------------------- -- | File and directory names are values of type 'String', whose precise -- meaning is operating system dependent. Files can be opened, yielding a diff --git a/libraries/base/GHC/IO/Unsafe.hs b/libraries/base/GHC/IO/Unsafe.hs new file mode 100644 index 0000000000..5bb982421b --- /dev/null +++ b/libraries/base/GHC/IO/Unsafe.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE Unsafe #-} +{-# LANGUAGE NoImplicitPrelude + , MagicHash + , UnboxedTuples + #-} +{-# OPTIONS_HADDOCK hide #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.IO.Unsafe +-- Copyright : (c) The University of Glasgow 1994-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- Unsafe IO operations +-- +----------------------------------------------------------------------------- + +module GHC.IO.Unsafe ( + unsafePerformIO, unsafeInterleaveIO, + unsafeDupablePerformIO, unsafeDupableInterleaveIO, + noDuplicate, + ) where + +import GHC.Base + + +{-| +This is the \"back door\" into the 'IO' monad, allowing +'IO' computation to be performed at any time. For +this to be safe, the 'IO' computation should be +free of side effects and independent of its environment. + +If the I\/O computation wrapped in 'unsafePerformIO' performs side +effects, then the relative order in which those side effects take +place (relative to the main I\/O trunk, or other calls to +'unsafePerformIO') is indeterminate. Furthermore, when using +'unsafePerformIO' to cause side-effects, you should take the following +precautions to ensure the side effects are performed as many times as +you expect them to be. Note that these precautions are necessary for +GHC, but may not be sufficient, and other compilers may require +different precautions: + + * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@ + that calls 'unsafePerformIO'. If the call is inlined, + the I\/O may be performed more than once. + + * Use the compiler flag @-fno-cse@ to prevent common sub-expression + elimination being performed on the module, which might combine + two side effects that were meant to be separate. A good example + is using multiple global variables (like @test@ in the example below). + + * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the + call to 'unsafePerformIO' cannot float outside a lambda. For example, + if you say: + @ + f x = unsafePerformIO (newIORef []) + @ + you may get only one reference cell shared between all calls to @f@. + Better would be + @ + f x = unsafePerformIO (newIORef [x]) + @ + because now it can't float outside the lambda. + +It is less well known that +'unsafePerformIO' is not type safe. For example: + +> test :: IORef [a] +> test = unsafePerformIO $ newIORef [] +> +> main = do +> writeIORef test [42] +> bang <- readIORef test +> print (bang :: [Char]) + +This program will core dump. This problem with polymorphic references +is well known in the ML community, and does not arise with normal +monadic use of references. There is no easy way to make it impossible +once you use 'unsafePerformIO'. Indeed, it is +possible to write @coerce :: a -> b@ with the +help of 'unsafePerformIO'. So be careful! +-} +unsafePerformIO :: IO a -> a +unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m) + +{-| +This version of 'unsafePerformIO' is more efficient +because it omits the check that the IO is only being performed by a +single thread. Hence, when you use 'unsafeDupablePerformIO', +there is a possibility that the IO action may be performed multiple +times (on a multiprocessor), and you should therefore ensure that +it gives the same results each time. It may even happen that one +of the duplicated IO actions is only run partially, and then interrupted +in the middle without an exception being raised. Therefore, functions +like 'bracket' cannot be used safely within 'unsafeDupablePerformIO'. + +@since 4.4.0.0 +-} +unsafeDupablePerformIO :: IO a -> a +unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a + +-- Note [unsafeDupablePerformIO is NOINLINE] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Why do we NOINLINE unsafeDupablePerformIO? See the comment with +-- GHC.ST.runST. Essentially the issue is that the IO computation +-- inside unsafePerformIO must be atomic: it must either all run, or +-- not at all. If we let the compiler see the application of the IO +-- to realWorld#, it might float out part of the IO. + +-- Note [unsafeDupablePerformIO has a lazy RHS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Why is there a call to 'lazy' in unsafeDupablePerformIO? +-- If we don't have it, the demand analyser discovers the following strictness +-- for unsafeDupablePerformIO: C(U(AV)) +-- But then consider +-- unsafeDupablePerformIO (\s -> let r = f x in +-- case writeIORef v r s of (# s1, _ #) -> +-- (# s1, r #) ) +-- The strictness analyser will find that the binding for r is strict, +-- (because of uPIO's strictness sig), and so it'll evaluate it before +-- doing the writeIORef. This actually makes libraries/base/tests/memo002 +-- get a deadlock, where we specifically wanted to write a lazy thunk +-- into the ref cell. +-- +-- Solution: don't expose the strictness of unsafeDupablePerformIO, +-- by hiding it with 'lazy' +-- But see discussion in Trac #9390 (comment:33) + +{-| +'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily. +When passed a value of type @IO a@, the 'IO' will only be performed +when the value of the @a@ is demanded. This is used to implement lazy +file reading, see 'System.IO.hGetContents'. +-} +{-# INLINE unsafeInterleaveIO #-} +unsafeInterleaveIO :: IO a -> IO a +unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m) + +-- We used to believe that INLINE on unsafeInterleaveIO was safe, +-- because the state from this IO thread is passed explicitly to the +-- interleaved IO, so it cannot be floated out and shared. +-- +-- HOWEVER, if the compiler figures out that r is used strictly here, +-- then it will eliminate the thunk and the side effects in m will no +-- longer be shared in the way the programmer was probably expecting, +-- but can be performed many times. In #5943, this broke our +-- definition of fixIO, which contains +-- +-- ans <- unsafeInterleaveIO (takeMVar m) +-- +-- after inlining, we lose the sharing of the takeMVar, so the second +-- time 'ans' was demanded we got a deadlock. We could fix this with +-- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes +-- share and sometimes not (plus it probably breaks the noDuplicate). +-- So now, we do not inline unsafeDupableInterleaveIO. + +{-# NOINLINE unsafeDupableInterleaveIO #-} +unsafeDupableInterleaveIO :: IO a -> IO a +unsafeDupableInterleaveIO (IO m) + = IO ( \ s -> let + r = case m s of (# _, res #) -> res + in + (# s, r #)) + +{-| +Ensures that the suspensions under evaluation by the current thread +are unique; that is, the current thread is not evaluating anything +that is also under evaluation by another thread that has also executed +'noDuplicate'. + +This operation is used in the definition of 'unsafePerformIO' to +prevent the IO action from being executed multiple times, which is usually +undesirable. +-} +noDuplicate :: IO () +noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #) diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs new file mode 100644 index 0000000000..d1dd596ca6 --- /dev/null +++ b/libraries/base/GHC/Stack.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE Trustworthy #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Stack +-- Copyright : (c) The University of Glasgow 2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- Access to GHC's call-stack simulation +-- +-- @since 4.5.0.0 +----------------------------------------------------------------------------- + +{-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-} +module GHC.Stack ( + -- * Call stacks + currentCallStack, + whoCreated, + errorWithStackTrace, + + -- * Implicit parameter call stacks + SrcLoc(..), CallStack(..), + + -- * Internals + CostCentreStack, + CostCentre, + getCurrentCCS, + getCCSOf, + ccsCC, + ccsParent, + ccLabel, + ccModule, + ccSrcSpan, + ccsToStrings, + renderStack + ) where + +import GHC.Stack.CCS +import GHC.IO +import GHC.Base +import GHC.List +import GHC.Exception + +-- | Like the function 'error', but appends a stack trace to the error +-- message if one is available. +-- +-- @since 4.7.0.0 +{-# DEPRECATED errorWithStackTrace "'error' appends the call stack now" #-} + -- DEPRECATED in 8.0.1 +errorWithStackTrace :: String -> a +errorWithStackTrace x = unsafeDupablePerformIO $ do + stack <- ccsToStrings =<< getCurrentCCS x + if null stack + then throwIO (ErrorCall x) + else throwIO (ErrorCallWithLocation x (renderStack stack)) diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc index 6ef1fa5d25..c544721e63 100644 --- a/libraries/base/GHC/Stack.hsc +++ b/libraries/base/GHC/Stack.hsc @@ -47,7 +47,6 @@ import GHC.Base import GHC.Ptr import GHC.Foreign as GHC import GHC.IO.Encoding -import GHC.Exception import GHC.List ( concatMap, null, reverse ) #define PROFILING diff --git a/libraries/base/GHC/Stack/CCS.hs-boot b/libraries/base/GHC/Stack/CCS.hs-boot new file mode 100644 index 0000000000..1ac7876921 --- /dev/null +++ b/libraries/base/GHC/Stack/CCS.hs-boot @@ -0,0 +1,16 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module GHC.Stack.CCS where + +{- Cuts the following loop: + + GHC.Exception.errorCallWithCallStackException requires + GHC.Stack.CCS.currentCallStack, which requires + Foreign.C (for peeking CostCentres) + GHC.Foreign, GHC.IO.Encoding (for decoding UTF-8 strings) + .. lots of stuff ... + GHC.Exception +-} + +import GHC.Base + +currentCallStack :: IO [String] diff --git a/libraries/base/GHC/Stack/CCS.hsc b/libraries/base/GHC/Stack/CCS.hsc new file mode 100644 index 0000000000..6d62a1e235 --- /dev/null +++ b/libraries/base/GHC/Stack/CCS.hsc @@ -0,0 +1,116 @@ +{-# LANGUAGE Trustworthy #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Stack.CCS +-- Copyright : (c) The University of Glasgow 2011 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- Access to GHC's call-stack simulation +-- +-- @since 4.5.0.0 +----------------------------------------------------------------------------- + +{-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-} +module GHC.Stack.CCS ( + -- * Call stacks + currentCallStack, + whoCreated, + + -- * Internals + CostCentreStack, + CostCentre, + getCurrentCCS, + getCCSOf, + ccsCC, + ccsParent, + ccLabel, + ccModule, + ccSrcSpan, + ccsToStrings, + renderStack + ) where + +import Foreign +import Foreign.C + +import GHC.Base +import GHC.Ptr +import GHC.Foreign as GHC +import GHC.IO.Encoding +import GHC.List ( concatMap, reverse ) + +#define PROFILING +#include "Rts.h" + +data CostCentreStack +data CostCentre + +getCurrentCCS :: dummy -> IO (Ptr CostCentreStack) +getCurrentCCS dummy = IO $ \s -> + case getCurrentCCS## dummy s of + (## s', addr ##) -> (## s', Ptr addr ##) + +getCCSOf :: a -> IO (Ptr CostCentreStack) +getCCSOf obj = IO $ \s -> + case getCCSOf## obj s of + (## s', addr ##) -> (## s', Ptr addr ##) + +ccsCC :: Ptr CostCentreStack -> IO (Ptr CostCentre) +ccsCC p = (# peek CostCentreStack, cc) p + +ccsParent :: Ptr CostCentreStack -> IO (Ptr CostCentreStack) +ccsParent p = (# peek CostCentreStack, prevStack) p + +ccLabel :: Ptr CostCentre -> IO CString +ccLabel p = (# peek CostCentre, label) p + +ccModule :: Ptr CostCentre -> IO CString +ccModule p = (# peek CostCentre, module) p + +ccSrcSpan :: Ptr CostCentre -> IO CString +ccSrcSpan p = (# peek CostCentre, srcloc) p + +-- | returns a '[String]' representing the current call stack. This +-- can be useful for debugging. +-- +-- The implementation uses the call-stack simulation maintined by the +-- profiler, so it only works if the program was compiled with @-prof@ +-- and contains suitable SCC annotations (e.g. by using @-fprof-auto@). +-- Otherwise, the list returned is likely to be empty or +-- uninformative. +-- +-- @since 4.5.0.0 + +currentCallStack :: IO [String] +currentCallStack = ccsToStrings =<< getCurrentCCS () + +ccsToStrings :: Ptr CostCentreStack -> IO [String] +ccsToStrings ccs0 = go ccs0 [] + where + go ccs acc + | ccs == nullPtr = return acc + | otherwise = do + cc <- ccsCC ccs + lbl <- GHC.peekCString utf8 =<< ccLabel cc + mdl <- GHC.peekCString utf8 =<< ccModule cc + loc <- GHC.peekCString utf8 =<< ccSrcSpan cc + parent <- ccsParent ccs + if (mdl == "MAIN" && lbl == "MAIN") + then return acc + else go parent ((mdl ++ '.':lbl ++ ' ':'(':loc ++ ")") : acc) + +-- | Get the stack trace attached to an object. +-- +-- @since 4.5.0.0 +whoCreated :: a -> IO [String] +whoCreated obj = do + ccs <- getCCSOf obj + ccsToStrings ccs + +renderStack :: [String] -> String +renderStack strs = "Stack trace:" ++ concatMap ("\n "++) (reverse strs) diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index e94d38949a..7c89be4cfa 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -238,6 +238,7 @@ Library GHC.IO.Handle.Text GHC.IO.Handle.Types GHC.IO.IOMode + GHC.IO.Unsafe GHC.IOArray GHC.IORef GHC.Int @@ -259,6 +260,7 @@ Library GHC.Show GHC.Stable GHC.Stack + GHC.Stack.CCS GHC.Stack.Types GHC.Stats GHC.Storable diff --git a/libraries/base/tests/assert.stderr b/libraries/base/tests/assert.stderr index 7183f1e763..2f809bd466 100644 --- a/libraries/base/tests/assert.stderr +++ b/libraries/base/tests/assert.stderr @@ -1,4 +1,3 @@ assert: Assertion failed -CallStack: +CallStack (from ImplicitParams): assert, called at assert.hs:9:11 in main:Main - diff --git a/libraries/base/tests/readFloat.stderr b/libraries/base/tests/readFloat.stderr index 99049a35b7..a3a84648f0 100644 --- a/libraries/base/tests/readFloat.stderr +++ b/libraries/base/tests/readFloat.stderr @@ -1,3 +1,3 @@ readFloat: Prelude.read: no parse -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/Text/Read.hs:90:17 in base:Text.Read diff --git a/libraries/hpc b/libraries/hpc -Subproject e20c61c358e749ea62f6687089ad2a878d5d1a6 +Subproject 5123582f48b46efc3d27424bc475125a1de78e2 diff --git a/libraries/stm b/libraries/stm -Subproject e917b5944ce0a5b4e32dcc8f00eaddbec1256e9 +Subproject 9870cf156e5e7e21785b236da41f2466bf9f4b2 diff --git a/testsuite/tests/annotations/should_fail/annfail12.stderr b/testsuite/tests/annotations/should_fail/annfail12.stderr index 37e8378a7e..303645914e 100644 --- a/testsuite/tests/annotations/should_fail/annfail12.stderr +++ b/testsuite/tests/annotations/should_fail/annfail12.stderr @@ -2,7 +2,7 @@ annfail12.hs:5:1: error: Exception when trying to run compile-time code: You were meant to see this error! -CallStack: +CallStack (from ImplicitParams): error, called at annfail12.hs:5:12 in main:Annfail12 In the annotation: {-# ANN f (error "You were meant to see this error!" :: Int) #-} diff --git a/testsuite/tests/array/should_run/arr003.stderr b/testsuite/tests/array/should_run/arr003.stderr index bffb356a6d..a0d56ed0a6 100644 --- a/testsuite/tests/array/should_run/arr003.stderr +++ b/testsuite/tests/array/should_run/arr003.stderr @@ -1,3 +1,3 @@ arr003: Ix{Int}.index: Index (4) out of range ((1,3)) -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/GHC/Arr.hs:176:5 in base:GHC.Arr diff --git a/testsuite/tests/array/should_run/arr004.stderr b/testsuite/tests/array/should_run/arr004.stderr index b053770e1a..e109855a71 100644 --- a/testsuite/tests/array/should_run/arr004.stderr +++ b/testsuite/tests/array/should_run/arr004.stderr @@ -1,3 +1,3 @@ arr004: (Array.!): undefined array element -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/GHC/Arr.hs:402:16 in base:GHC.Arr diff --git a/testsuite/tests/array/should_run/arr007.stderr b/testsuite/tests/array/should_run/arr007.stderr index f23cb319d9..4c02cecf6e 100644 --- a/testsuite/tests/array/should_run/arr007.stderr +++ b/testsuite/tests/array/should_run/arr007.stderr @@ -1,3 +1,3 @@ arr007: Ix{Int}.index: Index (1) out of range ((1,0)) -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/GHC/Arr.hs:176:5 in base:GHC.Arr diff --git a/testsuite/tests/array/should_run/arr008.stderr b/testsuite/tests/array/should_run/arr008.stderr index b3cf392eb3..5355a07162 100644 --- a/testsuite/tests/array/should_run/arr008.stderr +++ b/testsuite/tests/array/should_run/arr008.stderr @@ -1,3 +1,3 @@ arr008: Ix{Int}.index: Index (2) out of range ((0,1)) -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/GHC/Arr.hs:176:5 in base:GHC.Arr diff --git a/testsuite/tests/codeGen/should_run/T5626.stderr b/testsuite/tests/codeGen/should_run/T5626.stderr index a97f66c30e..2c02bb0a5c 100644 --- a/testsuite/tests/codeGen/should_run/T5626.stderr +++ b/testsuite/tests/codeGen/should_run/T5626.stderr @@ -1,4 +1,4 @@ T5626: Prelude.undefined -CallStack: - error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err undefined, called at T5626.hs:6:30 in main:Main diff --git a/testsuite/tests/codeGen/should_run/cgrun016.stderr b/testsuite/tests/codeGen/should_run/cgrun016.stderr index dba44be468..33cd2bdbdf 100644 --- a/testsuite/tests/codeGen/should_run/cgrun016.stderr +++ b/testsuite/tests/codeGen/should_run/cgrun016.stderr @@ -1,3 +1,3 @@ cgrun016: 6th call to error -CallStack: +CallStack (from ImplicitParams): error, called at cgrun016.hs:8:8 in main:Main diff --git a/testsuite/tests/codeGen/should_run/cgrun045.stderr b/testsuite/tests/codeGen/should_run/cgrun045.stderr index 4c7719b1c8..d7f8188c8b 100644 --- a/testsuite/tests/codeGen/should_run/cgrun045.stderr +++ b/testsuite/tests/codeGen/should_run/cgrun045.stderr @@ -1,3 +1,3 @@ cgrun045: hello world! -CallStack: +CallStack (from ImplicitParams): error, called at cgrun045.hs:6:13 in main:Main diff --git a/testsuite/tests/codeGen/should_run/cgrun051.stderr b/testsuite/tests/codeGen/should_run/cgrun051.stderr index 0a96a43628..432dd5649b 100644 --- a/testsuite/tests/codeGen/should_run/cgrun051.stderr +++ b/testsuite/tests/codeGen/should_run/cgrun051.stderr @@ -1,3 +1,3 @@ cgrun051: OK -CallStack: +CallStack (from ImplicitParams): error, called at cgrun051.hs:7:25 in main:Main diff --git a/testsuite/tests/codeGen/should_run/cgrun059.stderr b/testsuite/tests/codeGen/should_run/cgrun059.stderr index 15000537aa..2365a03ee5 100644 --- a/testsuite/tests/codeGen/should_run/cgrun059.stderr +++ b/testsuite/tests/codeGen/should_run/cgrun059.stderr @@ -1,3 +1,3 @@ cgrun059: Error: File not found -CallStack: +CallStack (from ImplicitParams): error, called at cgrun059.hs:12:28 in main:Main diff --git a/testsuite/tests/concurrent/should_run/conc021.stderr b/testsuite/tests/concurrent/should_run/conc021.stderr index c7348b77bd..b48a068ba7 100644 --- a/testsuite/tests/concurrent/should_run/conc021.stderr +++ b/testsuite/tests/concurrent/should_run/conc021.stderr @@ -1,3 +1,3 @@ conc021: wurble -CallStack: +CallStack (from ImplicitParams): error, called at conc021.hs:9:9 in main:Main diff --git a/testsuite/tests/deriving/should_run/T5628.stderr b/testsuite/tests/deriving/should_run/T5628.stderr index edc44bd3b1..e203374673 100644 --- a/testsuite/tests/deriving/should_run/T5628.stderr +++ b/testsuite/tests/deriving/should_run/T5628.stderr @@ -1,3 +1,3 @@ T5628: Void == -CallStack: +CallStack (from ImplicitParams): error, called at T5628.hs:5:1 in main:Main diff --git a/testsuite/tests/driver/sigof02/sigof02.stderr b/testsuite/tests/driver/sigof02/sigof02.stderr index 1dc1beb935..0fb77f6f9b 100644 --- a/testsuite/tests/driver/sigof02/sigof02.stderr +++ b/testsuite/tests/driver/sigof02/sigof02.stderr @@ -1,4 +1,4 @@ StrictMain: Prelude.undefined -CallStack: - error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err undefined, called at Main.hs:6:22 in main:Main diff --git a/testsuite/tests/driver/sigof02/sigof02m.stderr b/testsuite/tests/driver/sigof02/sigof02m.stderr index 1dc1beb935..0fb77f6f9b 100644 --- a/testsuite/tests/driver/sigof02/sigof02m.stderr +++ b/testsuite/tests/driver/sigof02/sigof02m.stderr @@ -1,4 +1,4 @@ StrictMain: Prelude.undefined -CallStack: - error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err undefined, called at Main.hs:6:22 in main:Main diff --git a/testsuite/tests/ffi/should_run/ffi008.stderr b/testsuite/tests/ffi/should_run/ffi008.stderr index 78605178a6..83999ed16e 100644 --- a/testsuite/tests/ffi/should_run/ffi008.stderr +++ b/testsuite/tests/ffi/should_run/ffi008.stderr @@ -1,3 +1,3 @@ ffi008: this is an error -CallStack: +CallStack (from ImplicitParams): error, called at ffi008.hs:12:12 in main:Main diff --git a/testsuite/tests/ffi/should_run/fptrfail01.stderr b/testsuite/tests/ffi/should_run/fptrfail01.stderr index 5193181ea9..cf29208275 100644 --- a/testsuite/tests/ffi/should_run/fptrfail01.stderr +++ b/testsuite/tests/ffi/should_run/fptrfail01.stderr @@ -1,3 +1,3 @@ fptrfail01: GHC.ForeignPtr: attempt to mix Haskell and C finalizers in the same ForeignPtr -CallStack: - error, called at libraries/base/GHC/ForeignPtr.hs:352:17 in base:GHC.ForeignPtr +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/ForeignPtr.hs:361:17 in base:GHC.ForeignPtr diff --git a/testsuite/tests/ghc-e/should_run/ghc-e005.stderr b/testsuite/tests/ghc-e/should_run/ghc-e005.stderr index 5836586c79..31194ee1a6 100644 --- a/testsuite/tests/ghc-e/should_run/ghc-e005.stderr +++ b/testsuite/tests/ghc-e/should_run/ghc-e005.stderr @@ -1,3 +1,3 @@ ghc-e005-prog: foo -CallStack: +CallStack (from ImplicitParams): error, called at ghc-e005.hs:12:10 in main:Main diff --git a/testsuite/tests/ghci.debugger/scripts/break009.stdout b/testsuite/tests/ghci.debugger/scripts/break009.stdout index 14543668a1..9a4fa56446 100644 --- a/testsuite/tests/ghci.debugger/scripts/break009.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break009.stdout @@ -2,5 +2,5 @@ Breakpoint 0 activated at ../Test6.hs:5:8-11 Stopped at ../Test6.hs:5:8-11 _result :: a2 = _ *** Exception: Prelude.head: empty list -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout index 67bbec7ce1..69cbcc4373 100644 --- a/testsuite/tests/ghci.debugger/scripts/break011.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout @@ -1,5 +1,5 @@ *** Exception: foo -CallStack: +CallStack (from ImplicitParams): error, called at <interactive>:2:1 in interactive:Ghci1 Stopped at <exception thrown> _exception :: e = _ @@ -21,17 +21,17 @@ already at the beginning of the history _exception = SomeException (ErrorCallWithLocation "foo" - "CallStack: + "CallStack (from ImplicitParams): error, called at ../Test7.hs:2:18 in main:Main") _result :: a14 = _ _exception :: SomeException = SomeException (ErrorCallWithLocation "foo" - "CallStack: + "CallStack (from ImplicitParams): error, called at ../Test7.hs:2:18 in main:Main") *** Exception: foo -CallStack: +CallStack (from ImplicitParams): error, called at ../Test7.hs:2:18 in main:Main *** Exception: foo -CallStack: +CallStack (from ImplicitParams): error, called at ../Test7.hs:2:18 in main:Main diff --git a/testsuite/tests/ghci.debugger/scripts/break017.stdout b/testsuite/tests/ghci.debugger/scripts/break017.stdout index 4825e435bb..2bc2c23837 100644 --- a/testsuite/tests/ghci.debugger/scripts/break017.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break017.stdout @@ -8,7 +8,7 @@ Printing 1 as = 'b' : 'c' : (_t1::[Char]) Forcing *** Exception: Prelude.undefined -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err undefined, called at <interactive>:3:17 in interactive:Ghci1 Printing 2 diff --git a/testsuite/tests/ghci/scripts/T10501.stderr b/testsuite/tests/ghci/scripts/T10501.stderr index b9e45ccc66..7fffbe8231 100644 --- a/testsuite/tests/ghci/scripts/T10501.stderr +++ b/testsuite/tests/ghci/scripts/T10501.stderr @@ -1,7 +1,7 @@ *** Exception: Prelude.head: empty list -CallStack: - error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List *** Exception: Prelude.undefined -CallStack: - error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err undefined, called at <interactive>:1:17 in interactive:Ghci1 diff --git a/testsuite/tests/ghci/scripts/T5557.stdout b/testsuite/tests/ghci/scripts/T5557.stdout index aa3a83242e..86df6ab67c 100644 --- a/testsuite/tests/ghci/scripts/T5557.stdout +++ b/testsuite/tests/ghci/scripts/T5557.stdout @@ -1,8 +1,8 @@ *** Exception: Prelude.undefined -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err undefined, called at <interactive>:2:12 in interactive:Ghci1 *** Exception: Prelude.undefined -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err undefined, called at <interactive>:3:12 in interactive:Ghci1 diff --git a/testsuite/tests/ghci/scripts/ghci055.stdout b/testsuite/tests/ghci/scripts/ghci055.stdout index 03245e2097..d57430bb8c 100644 --- a/testsuite/tests/ghci/scripts/ghci055.stdout +++ b/testsuite/tests/ghci/scripts/ghci055.stdout @@ -1,5 +1,5 @@ *** Exception: Prelude.undefined -CallStack: +CallStack (from ImplicitParams): error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err undefined, called at <interactive>:1:7 in interactive:Ghci1 x :: t = _ diff --git a/testsuite/tests/profiling/should_run/ioprof.stderr b/testsuite/tests/profiling/should_run/ioprof.stderr index 3910245347..db9c36bbe3 100644 --- a/testsuite/tests/profiling/should_run/ioprof.stderr +++ b/testsuite/tests/profiling/should_run/ioprof.stderr @@ -1,3 +1,14 @@ ioprof: a -CallStack: +CallStack (from ImplicitParams): error, called at ioprof.hs:23:22 in main:Main +CallStack (from -prof): + Main.errorM.\ (ioprof.hs:23:22-28) + Main.errorM (ioprof.hs:23:1-28) + Main.foo (ioprof.hs:34:1-16) + Main.>>=.\ (ioprof.hs:(11,27)-(12,50)) + Main.>>= (ioprof.hs:(11,3)-(12,50)) + Main.<*> (ioprof.hs:20:5-14) + Main.bar (ioprof.hs:31:1-20) + Main.runM (ioprof.hs:26:1-37) + Main.main (ioprof.hs:28:1-43) + Main.CAF (<entire-module>) diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr index f752129770..974af21631 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang09.stderr @@ -1,3 +1,3 @@ SafeLang09: This curry is poisoned! -CallStack: +CallStack (from ImplicitParams): error, called at ./SafeLang09_B.hs:14:13 in main:SafeLang09_B diff --git a/testsuite/tests/simplCore/should_fail/T7411.stderr b/testsuite/tests/simplCore/should_fail/T7411.stderr index 59c0617e9b..6fc6a22560 100644 --- a/testsuite/tests/simplCore/should_fail/T7411.stderr +++ b/testsuite/tests/simplCore/should_fail/T7411.stderr @@ -1,4 +1,4 @@ T7411: Prelude.undefined -CallStack: - error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err undefined, called at T7411.hs:3:25 in main:Main diff --git a/testsuite/tests/simplCore/should_run/T457.stderr b/testsuite/tests/simplCore/should_run/T457.stderr index 983c8dba39..c84855e500 100644 --- a/testsuite/tests/simplCore/should_run/T457.stderr +++ b/testsuite/tests/simplCore/should_run/T457.stderr @@ -1,3 +1,3 @@ T457: Correct -CallStack: +CallStack (from ImplicitParams): error, called at T457.hs:5:22 in main:Main diff --git a/testsuite/tests/simplCore/should_run/T5587.stderr b/testsuite/tests/simplCore/should_run/T5587.stderr index d98a36d986..069d08d055 100644 --- a/testsuite/tests/simplCore/should_run/T5587.stderr +++ b/testsuite/tests/simplCore/should_run/T5587.stderr @@ -1,3 +1,3 @@ T5587: hidden error -CallStack: +CallStack (from ImplicitParams): error, called at T5587.hs:7:15 in main:Main diff --git a/testsuite/tests/simplCore/should_run/T5625.stderr b/testsuite/tests/simplCore/should_run/T5625.stderr index f272d99787..fe02e7e6a8 100644 --- a/testsuite/tests/simplCore/should_run/T5625.stderr +++ b/testsuite/tests/simplCore/should_run/T5625.stderr @@ -1,4 +1,4 @@ T5625: Prelude.undefined -CallStack: - error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err undefined, called at T5625.hs:3:31 in main:Main diff --git a/testsuite/tests/stranal/should_run/strun002.stderr b/testsuite/tests/stranal/should_run/strun002.stderr index 2e2f85b780..735b981a88 100644 --- a/testsuite/tests/stranal/should_run/strun002.stderr +++ b/testsuite/tests/stranal/should_run/strun002.stderr @@ -1,3 +1,3 @@ strun002: Variable not found: (2) hello -CallStack: +CallStack (from ImplicitParams): error, called at strun002.hs:7:11 in main:Main diff --git a/testsuite/tests/th/T5358.stderr b/testsuite/tests/th/T5358.stderr index 695c69e3d9..4a17272310 100644 --- a/testsuite/tests/th/T5358.stderr +++ b/testsuite/tests/th/T5358.stderr @@ -2,7 +2,7 @@ T5358.hs:14:12: error: Exception when trying to run compile-time code: runTest called error: forall (t_0 :: *) . t_0 -> GHC.Types.Bool -CallStack: +CallStack (from ImplicitParams): error, called at T5358.hs:15:18 in main:T5358 Code: do { VarI _ t _ <- reify (mkName "prop_x1"); ($) error ((++) "runTest called error: " pprint t) } diff --git a/testsuite/tests/th/T5976.stderr b/testsuite/tests/th/T5976.stderr index f434458a01..507d9d8b8d 100644 --- a/testsuite/tests/th/T5976.stderr +++ b/testsuite/tests/th/T5976.stderr @@ -2,6 +2,6 @@ T5976.hs:1:1: error: Exception when trying to run compile-time code: bar -CallStack: +CallStack (from ImplicitParams): error, called at T5976.hs:3:21 in main:Main Code: error ((++) "foo " error "bar") diff --git a/testsuite/tests/th/T8987.stderr b/testsuite/tests/th/T8987.stderr index 6df4f7d4ec..1af2e29b7f 100644 --- a/testsuite/tests/th/T8987.stderr +++ b/testsuite/tests/th/T8987.stderr @@ -2,7 +2,7 @@ T8987.hs:1:1: error: Exception when trying to run compile-time code: Prelude.undefined -CallStack: - error, called at libraries/base/GHC/Err.hs:42:14 in base:GHC.Err +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/Err.hs:43:14 in base:GHC.Err undefined, called at T8987.hs:6:23 in main:T8987 Code: (>>) reportWarning ['1', undefined] return [] diff --git a/testsuite/tests/th/TH_exn2.stderr b/testsuite/tests/th/TH_exn2.stderr index fb914289a3..b4d5b8df84 100644 --- a/testsuite/tests/th/TH_exn2.stderr +++ b/testsuite/tests/th/TH_exn2.stderr @@ -2,7 +2,7 @@ TH_exn2.hs:1:1: error: Exception when trying to run compile-time code: Prelude.tail: empty list -CallStack: - error, called at libraries/base/GHC/List.hs:1009:3 in base:GHC.List +CallStack (from ImplicitParams): + error, called at libraries/base/GHC/List.hs:999:3 in base:GHC.List Code: do { ds <- [d| |]; return (tail ds) } diff --git a/testsuite/tests/typecheck/should_run/IPLocation.stdout b/testsuite/tests/typecheck/should_run/IPLocation.stdout index 47de194981..d02250f8de 100644 --- a/testsuite/tests/typecheck/should_run/IPLocation.stdout +++ b/testsuite/tests/typecheck/should_run/IPLocation.stdout @@ -1,24 +1,24 @@ -CallStack: +CallStack (from ImplicitParams): ?loc, called at IPLocation.hs:8:31 in main:Main -CallStack: +CallStack (from ImplicitParams): ?loc, called at IPLocation.hs:12:31 in main:Main f1, called at IPLocation.hs:40:11 in main:Main -CallStack: +CallStack (from ImplicitParams): ?loc, called at IPLocation.hs:16:34 in main:Main f2, called at IPLocation.hs:41:11 in main:Main -CallStack: +CallStack (from ImplicitParams): ?loc, called at IPLocation.hs:17:34 in main:Main f2, called at IPLocation.hs:41:11 in main:Main -CallStack: +CallStack (from ImplicitParams): ?loc, called at IPLocation.hs:42:48 in main:Main x, called at IPLocation.hs:22:8 in main:Main -CallStack: +CallStack (from ImplicitParams): ?loc, called at IPLocation.hs:43:48 in main:Main x, called at IPLocation.hs:27:8 in main:Main f4, called at IPLocation.hs:43:11 in main:Main -CallStack: +CallStack (from ImplicitParams): ?loc3, called at IPLocation.hs:44:48 in main:Main -CallStack: +CallStack (from ImplicitParams): ?loc, called at IPLocation.hs:35:33 in main:Main f6, called at IPLocation.hs:36:8 in main:Main f6, called at IPLocation.hs:36:8 in main:Main |