Commit df3f5880 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files

Remove unsafeGlobalDynFlags (#17957, #14597)

There are still global variables but only 3 booleans instead of a single
DynFlags.
parent 6527fc57
......@@ -1156,7 +1156,8 @@ tryUnfolding dflags id lone_variable
, extra_doc
, text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"]
str = "Considering inlining: " ++ showSDocDump dflags (ppr id)
ctx = initSDocContext dflags defaultDumpStyle
str = "Considering inlining: " ++ showSDocDump ctx (ppr id)
n_val_args = length arg_infos
-- some_benefit is used when the RHS is small enough
......
......@@ -29,6 +29,7 @@ import GHC.Utils.Exception
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.GlobalVars
import GHC.Utils.Ppr ( Mode(..) )
import {-# SOURCE #-} GHC.Unit.State
......@@ -43,7 +44,7 @@ showPpr :: Outputable a => DynFlags -> a -> String
showPpr dflags thing = showSDoc dflags (ppr thing)
showPprUnsafe :: Outputable a => a -> String
showPprUnsafe a = showPpr unsafeGlobalDynFlags a
showPprUnsafe a = renderWithContext defaultSDocContext (ppr a)
-- | Allows caller to specify the PrintUnqualified to use
showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
......@@ -53,8 +54,8 @@ showSDocForUser dflags unqual doc = renderWithContext (initSDocContext dflags st
unit_state = unitState dflags
doc' = pprWithUnitState unit_state doc
showSDocDump :: DynFlags -> SDoc -> String
showSDocDump dflags d = renderWithContext (initSDocContext dflags defaultDumpStyle) d
showSDocDump :: SDocContext -> SDoc -> String
showSDocDump ctx d = renderWithContext ctx (withPprStyle defaultDumpStyle d)
showSDocDebug :: DynFlags -> SDoc -> String
showSDocDebug dflags d = renderWithContext ctx d
......@@ -75,9 +76,9 @@ printForC dflags handle doc =
printSDocLn ctx LeftMode handle doc
where ctx = initSDocContext dflags (PprCode CStyle)
pprDebugAndThen :: DynFlags -> (String -> a) -> SDoc -> SDoc -> a
pprDebugAndThen dflags cont heading pretty_msg
= cont (showSDocDump dflags doc)
pprDebugAndThen :: SDocContext -> (String -> a) -> SDoc -> SDoc -> a
pprDebugAndThen ctx cont heading pretty_msg
= cont (showSDocDump ctx doc)
where
doc = sep [heading, nest 2 pretty_msg]
......@@ -85,19 +86,22 @@ pprDebugAndThen dflags cont heading pretty_msg
pprTraceWithFlags :: DynFlags -> String -> SDoc -> a -> a
pprTraceWithFlags dflags str doc x
| hasNoDebugOutput dflags = x
| otherwise = pprDebugAndThen dflags trace (text str) doc x
| otherwise = pprDebugAndThen (initSDocContext dflags defaultDumpStyle)
trace (text str) doc x
-- | If debug output is on, show some 'SDoc' on the screen
pprTrace :: String -> SDoc -> a -> a
pprTrace str doc x = pprTraceWithFlags unsafeGlobalDynFlags str doc x
pprTrace str doc x
| unsafeHasNoDebugOutput = x
| otherwise = pprDebugAndThen defaultSDocContext trace (text str) doc x
pprTraceM :: Applicative f => String -> SDoc -> f ()
pprTraceM str doc = pprTrace str doc (pure ())
pprTraceDebug :: String -> SDoc -> a -> a
pprTraceDebug str doc x
| debugIsOn && hasPprDebug unsafeGlobalDynFlags = pprTrace str doc x
| otherwise = x
| debugIsOn && unsafeHasPprDebug = pprTrace str doc x
| otherwise = x
-- | @pprTraceWith desc f x@ is equivalent to @pprTrace desc (f x) x@.
-- This allows you to print details from the returned value as well as from
......@@ -114,7 +118,7 @@ pprTraceIt desc x = pprTraceWith desc ppr x
pprTraceException :: ExceptionMonad m => String -> SDoc -> m a -> m a
pprTraceException heading doc =
handleGhcException $ \exc -> liftIO $ do
putStrLn $ showSDocDump unsafeGlobalDynFlags (sep [text heading, nest 2 doc])
putStrLn $ showSDocDump defaultSDocContext (sep [text heading, nest 2 doc])
throwGhcExceptionIO exc
-- | If debug output is on, show some 'SDoc' on the screen along
......@@ -127,10 +131,10 @@ warnPprTrace :: HasCallStack => Bool -> String -> Int -> SDoc -> a -> a
-- Should typically be accessed with the WARN macros
warnPprTrace _ _ _ _ x | not debugIsOn = x
warnPprTrace _ _file _line _msg x
| hasNoDebugOutput unsafeGlobalDynFlags = x
| unsafeHasNoDebugOutput = x
warnPprTrace False _file _line _msg x = x
warnPprTrace True file line msg x
= pprDebugAndThen unsafeGlobalDynFlags trace heading
= pprDebugAndThen defaultSDocContext trace heading
(msg $$ callStackDoc )
x
where
......
......@@ -15,8 +15,6 @@
--
-------------------------------------------------------------------------------
{-# OPTIONS_GHC -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Driver.Session (
......@@ -199,7 +197,7 @@ module GHC.Driver.Session (
wordAlignment,
unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,
setUnsafeGlobalDynFlags,
-- * SSE and AVX
isSseEnabled,
......@@ -256,6 +254,7 @@ import GHC.Settings.Constants
import GHC.Utils.Panic
import qualified GHC.Utils.Ppr.Colour as Col
import GHC.Utils.Misc
import GHC.Utils.GlobalVars
import GHC.Data.Maybe
import GHC.Utils.Monad
import qualified GHC.Utils.Ppr as Pretty
......@@ -275,7 +274,6 @@ import GHC.Utils.Json
import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
import System.IO.Unsafe ( unsafePerformIO )
import Data.IORef
import Control.Arrow ((&&&))
import Control.Monad
......@@ -305,11 +303,6 @@ import qualified GHC.Data.EnumSet as EnumSet
import GHC.Foreign (withCString, peekCString)
import qualified GHC.LanguageExtensions as LangExt
#if GHC_STAGE >= 2
-- used by SHARED_GLOBAL_VAR
import Foreign (Ptr)
#endif
-- Note [Updating flag description in the User's Guide]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
......@@ -4892,40 +4885,12 @@ makeDynFlagsConsistent dflags
os = platformOS platform
--------------------------------------------------------------------------
-- Do not use unsafeGlobalDynFlags!
--
-- unsafeGlobalDynFlags is a hack, necessary because we need to be able
-- to show SDocs when tracing, but we don't always have DynFlags
-- available.
--
-- Do not use it if you can help it. You may get the wrong value, or this
-- panic!
-- | This is the value that 'unsafeGlobalDynFlags' takes before it is
-- initialized.
defaultGlobalDynFlags :: DynFlags
defaultGlobalDynFlags =
(defaultDynFlags settings llvmConfig) { verbosity = 2 }
where
settings = panic "v_unsafeGlobalDynFlags: settings not initialised"
llvmConfig = panic "v_unsafeGlobalDynFlags: llvmConfig not initialised"
#if GHC_STAGE < 2
GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags)
#else
SHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags
, getOrSetLibHSghcGlobalDynFlags
, "getOrSetLibHSghcGlobalDynFlags"
, defaultGlobalDynFlags
, DynFlags )
#endif
unsafeGlobalDynFlags :: DynFlags
unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
setUnsafeGlobalDynFlags :: DynFlags -> IO ()
setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
setUnsafeGlobalDynFlags dflags = do
writeIORef v_unsafeHasPprDebug (hasPprDebug dflags)
writeIORef v_unsafeHasNoDebugOutput (hasNoDebugOutput dflags)
writeIORef v_unsafeHasNoStateHack (hasNoStateHack dflags)
-- -----------------------------------------------------------------------------
-- SSE and AVX
......
......@@ -9,7 +9,6 @@ data DynFlags
targetPlatform :: DynFlags -> Platform
unitState :: DynFlags -> UnitState
unsafeGlobalDynFlags :: DynFlags
hasPprDebug :: DynFlags -> Bool
hasNoDebugOutput :: DynFlags -> Bool
initSDocContext :: DynFlags -> PprStyle -> SDocContext
......@@ -755,14 +755,15 @@ link_caf node = do
-- name of the data constructor itself. Otherwise it is determined by
-- @closureDescription@ from the let binding information.
closureDescription :: DynFlags
-> Module -- Module
-> Name -- Id of closure binding
-> String
closureDescription
:: DynFlags
-> Module -- Module
-> Name -- Id of closure binding
-> String
-- Not called for StgRhsCon which have global info tables built in
-- CgConTbls.hs with a description generated from the data constructor
closureDescription dflags mod_name name
= showSDocDump dflags (char '<' <>
= showSDocDump (initSDocContext dflags defaultDumpStyle) (char '<' <>
(if isExternalName name
then ppr name -- ppr will include the module name prefix
else pprModule mod_name <> char '.' <> ppr name) <>
......
......@@ -123,7 +123,6 @@ module GHC.Types.Id (
import GHC.Prelude
import GHC.Driver.Session
import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding,
isCompulsoryUnfolding, Unfolding( NoUnfolding ) )
......@@ -161,6 +160,7 @@ import GHC.Core.Multiplicity
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.GlobalVars
import GHC.Driver.Ppr
......@@ -843,7 +843,7 @@ typeOneShot ty
isStateHackType :: Type -> Bool
isStateHackType ty
| hasNoStateHack unsafeGlobalDynFlags
| unsafeHasNoStateHack
= False
| otherwise
= case tyConAppTyCon_maybe ty of
......
......@@ -820,13 +820,15 @@ prettyPrintGhcErrors :: ExceptionMonad m => DynFlags -> m a -> m a
prettyPrintGhcErrors dflags
= MC.handle $ \e -> case e of
PprPanic str doc ->
pprDebugAndThen dflags panic (text str) doc
pprDebugAndThen ctx panic (text str) doc
PprSorry str doc ->
pprDebugAndThen dflags sorry (text str) doc
pprDebugAndThen ctx sorry (text str) doc
PprProgramError str doc ->
pprDebugAndThen dflags pgmError (text str) doc
pprDebugAndThen ctx pgmError (text str) doc
_ ->
liftIO $ throwIO e
where
ctx = initSDocContext dflags defaultUserStyle
-- | Checks if given 'WarnMsg' is a fatal warning.
isWarnMsgFatal :: DynFlags -> WarnMsg -> Maybe (Maybe WarningFlag)
......
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
module GHC.Utils.GlobalVars
( v_unsafeHasPprDebug
, v_unsafeHasNoDebugOutput
, v_unsafeHasNoStateHack
, unsafeHasPprDebug
, unsafeHasNoDebugOutput
, unsafeHasNoStateHack
, global
, consIORef
, globalM
, sharedGlobal
, sharedGlobalM
)
where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Conc.Sync ( sharedCAF )
import System.IO.Unsafe
import Data.IORef
import Foreign (Ptr)
--------------------------------------------------------------------------
-- Do not use global variables!
--
-- Global variables are a hack. Do not use them if you can help it.
#if GHC_STAGE < 2
GLOBAL_VAR(v_unsafeHasPprDebug, False, Bool)
GLOBAL_VAR(v_unsafeHasNoDebugOutput, False, Bool)
GLOBAL_VAR(v_unsafeHasNoStateHack, False, Bool)
#else
SHARED_GLOBAL_VAR( v_unsafeHasPprDebug
, getOrSetLibHSghcGlobalHasPprDebug
, "getOrSetLibHSghcGlobalHasPprDebug"
, False
, Bool )
SHARED_GLOBAL_VAR( v_unsafeHasNoDebugOutput
, getOrSetLibHSghcGlobalHasNoDebugOutput
, "getOrSetLibHSghcGlobalHasNoDebugOutput"
, False
, Bool )
SHARED_GLOBAL_VAR( v_unsafeHasNoStateHack
, getOrSetLibHSghcGlobalHasNoStateHack
, "getOrSetLibHSghcGlobalHasNoStateHack"
, False
, Bool )
#endif
unsafeHasPprDebug :: Bool
unsafeHasPprDebug = unsafePerformIO $ readIORef v_unsafeHasPprDebug
unsafeHasNoDebugOutput :: Bool
unsafeHasNoDebugOutput = unsafePerformIO $ readIORef v_unsafeHasNoDebugOutput
unsafeHasNoStateHack :: Bool
unsafeHasNoStateHack = unsafePerformIO $ readIORef v_unsafeHasNoStateHack
{-
************************************************************************
* *
Globals and the RTS
* *
************************************************************************
When a plugin is loaded, it currently gets linked against a *newly
loaded* copy of the GHC package. This would not be a problem, except
that the new copy has its own mutable state that is not shared with
that state that has already been initialized by the original GHC
package.
(Note that if the GHC executable was dynamically linked this
wouldn't be a problem, because we could share the GHC library it
links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)
The solution is to make use of @sharedCAF@ through @sharedGlobal@
for globals that are shared between multiple copies of ghc packages.
-}
-- Global variables:
global :: a -> IORef a
global a = unsafePerformIO (newIORef a)
consIORef :: IORef [a] -> a -> IO ()
consIORef var x = do
atomicModifyIORef' var (\xs -> (x:xs,()))
globalM :: IO a -> IORef a
globalM ma = unsafePerformIO (ma >>= newIORef)
-- Shared global variables:
sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobal a get_or_set = unsafePerformIO $
newIORef a >>= flip sharedCAF get_or_set
sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobalM ma get_or_set = unsafePerformIO $
ma >>= newIORef >>= flip sharedCAF get_or_set
......@@ -107,9 +107,6 @@ module GHC.Utils.Misc (
modificationTimeIfExists,
withAtomicRename,
global, consIORef, globalM,
sharedGlobal, sharedGlobalM,
-- * Filenames and paths
Suffix,
splitLongestPrefix,
......@@ -143,8 +140,6 @@ import GHC.Utils.Exception
import GHC.Utils.Panic.Plain
import Data.Data
import Data.IORef ( IORef, newIORef, atomicModifyIORef' )
import System.IO.Unsafe ( unsafePerformIO )
import Data.List hiding (group)
import Data.List.NonEmpty ( NonEmpty(..) )
......@@ -154,7 +149,6 @@ import GHC.Stack (HasCallStack)
import Control.Applicative ( liftA2 )
import Control.Monad ( liftM, guard )
import Control.Monad.IO.Class ( MonadIO, liftIO )
import GHC.Conc.Sync ( sharedCAF )
import System.IO.Error as IO ( isDoesNotExistError )
import System.Directory ( doesDirectoryExist, getModificationTime, renameFile )
import System.FilePath
......@@ -1070,48 +1064,6 @@ strictMap f (x : xs) =
in
x' : xs'
{-
************************************************************************
* *
Globals and the RTS
* *
************************************************************************
When a plugin is loaded, it currently gets linked against a *newly
loaded* copy of the GHC package. This would not be a problem, except
that the new copy has its own mutable state that is not shared with
that state that has already been initialized by the original GHC
package.
(Note that if the GHC executable was dynamically linked this
wouldn't be a problem, because we could share the GHC library it
links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)
The solution is to make use of @sharedCAF@ through @sharedGlobal@
for globals that are shared between multiple copies of ghc packages.
-}
-- Global variables:
global :: a -> IORef a
global a = unsafePerformIO (newIORef a)
consIORef :: IORef [a] -> a -> IO ()
consIORef var x = do
atomicModifyIORef' var (\xs -> (x:xs,()))
globalM :: IO a -> IORef a
globalM ma = unsafePerformIO (ma >>= newIORef)
-- Shared global variables:
sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobal a get_or_set = unsafePerformIO $
newIORef a >>= flip sharedCAF get_or_set
sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobalM ma get_or_set = unsafePerformIO $
ma >>= newIORef >>= flip sharedCAF get_or_set
-- Module names:
......
......@@ -47,8 +47,6 @@ import GHC.Prelude
import GHC.Stack
import GHC.Utils.Outputable
import {-# SOURCE #-} GHC.Driver.Session (DynFlags, unsafeGlobalDynFlags)
import {-# SOURCE #-} GHC.Driver.Ppr (showSDoc)
import GHC.Utils.Panic.Plain
import GHC.Utils.Exception as Exception
......@@ -146,16 +144,14 @@ safeShowException e = do
-- | Append a description of the given exception to this string.
--
-- Note that this uses 'GHC.Driver.Session.unsafeGlobalDynFlags', which may have some
-- uninitialized fields if invoked before 'GHC.initGhcMonad' has been called.
-- If the error message to be printed includes a pretty-printer document
-- which forces one of these fields this call may bottom.
-- Note that this uses 'defaultSDocContext', which doesn't use the options
-- set by the user via DynFlags.
showGhcExceptionUnsafe :: GhcException -> ShowS
showGhcExceptionUnsafe = showGhcException unsafeGlobalDynFlags
showGhcExceptionUnsafe = showGhcException defaultSDocContext
-- | Append a description of the given exception to this string.
showGhcException :: DynFlags -> GhcException -> ShowS
showGhcException dflags = showPlainGhcException . \case
showGhcException :: SDocContext -> GhcException -> ShowS
showGhcException ctx = showPlainGhcException . \case
Signal n -> PlainSignal n
UsageError str -> PlainUsageError str
CmdLineError str -> PlainCmdLineError str
......@@ -165,11 +161,11 @@ showGhcException dflags = showPlainGhcException . \case
ProgramError str -> PlainProgramError str
PprPanic str sdoc -> PlainPanic $
concat [str, "\n\n", showSDoc dflags sdoc]
concat [str, "\n\n", renderWithContext ctx sdoc]
PprSorry str sdoc -> PlainProgramError $
concat [str, "\n\n", showSDoc dflags sdoc]
concat [str, "\n\n", renderWithContext ctx sdoc]
PprProgramError str sdoc -> PlainProgramError $
concat [str, "\n\n", showSDoc dflags sdoc]
concat [str, "\n\n", renderWithContext ctx sdoc]
throwGhcException :: GhcException -> a
throwGhcException = Exception.throw
......
......@@ -15,25 +15,25 @@ you will screw up the layout where they are used in case expressions!
#define GLOBAL_VAR(name,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = GHC.Utils.Misc.global (value);
name = GHC.Utils.GlobalVars.global (value);
#define GLOBAL_VAR_M(name,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = GHC.Utils.Misc.globalM (value);
name = GHC.Utils.GlobalVars.globalM (value);
#define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = GHC.Utils.Misc.sharedGlobal (value) (accessor); \
name = GHC.Utils.GlobalVars.sharedGlobal (value) (accessor);\
foreign import ccall unsafe saccessor \
accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
#define SHARED_GLOBAL_VAR_M(name,accessor,saccessor,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = GHC.Utils.Misc.sharedGlobalM (value) (accessor); \
name = GHC.Utils.GlobalVars.sharedGlobalM (value) (accessor); \
foreign import ccall unsafe saccessor \
accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
......
......@@ -177,6 +177,7 @@ Library
GHC.Types.Cpr
GHC.Cmm.DebugBlock
GHC.Utils.Exception
GHC.Utils.GlobalVars
GHC.Types.FieldLabel
GHC.Driver.Monad
GHC.Driver.Hooks
......
......@@ -31,6 +31,8 @@ mkStoreAccessorPrototype(SystemTimerThreadIOManagerThreadStore)
mkStoreAccessorPrototype(LibHSghcFastStringTable)
mkStoreAccessorPrototype(LibHSghcPersistentLinkerState)
mkStoreAccessorPrototype(LibHSghcInitLinkerDone)
mkStoreAccessorPrototype(LibHSghcGlobalDynFlags)
mkStoreAccessorPrototype(LibHSghcGlobalHasPprDebug)
mkStoreAccessorPrototype(LibHSghcGlobalHasNoDebugOutput)
mkStoreAccessorPrototype(LibHSghcGlobalHasNoStateHack)
mkStoreAccessorPrototype(LibHSghcStaticOptions)
mkStoreAccessorPrototype(LibHSghcStaticOptionsReady)
......@@ -35,7 +35,9 @@ typedef enum {
LibHSghcFastStringTable,
LibHSghcPersistentLinkerState,
LibHSghcInitLinkerDone,
LibHSghcGlobalDynFlags,
LibHSghcGlobalHasPprDebug,
LibHSghcGlobalHasNoDebugOutput,
LibHSghcGlobalHasNoStateHack,
LibHSghcStaticOptions,
LibHSghcStaticOptionsReady,
MaxStoreKey
......@@ -108,6 +110,8 @@ mkStoreAccessor(SystemTimerThreadIOManagerThreadStore)
mkStoreAccessor(LibHSghcFastStringTable)
mkStoreAccessor(LibHSghcPersistentLinkerState)
mkStoreAccessor(LibHSghcInitLinkerDone)
mkStoreAccessor(LibHSghcGlobalDynFlags)
mkStoreAccessor(LibHSghcGlobalHasPprDebug)
mkStoreAccessor(LibHSghcGlobalHasNoDebugOutput)
mkStoreAccessor(LibHSghcGlobalHasNoStateHack)
mkStoreAccessor(LibHSghcStaticOptions)
mkStoreAccessor(LibHSghcStaticOptionsReady)
......@@ -644,7 +644,9 @@
SymI_HasProto(getRTSStatsEnabled) \
SymI_HasProto(getOrSetLibHSghcPersistentLinkerState) \
SymI_HasProto(getOrSetLibHSghcInitLinkerDone) \
SymI_HasProto(getOrSetLibHSghcGlobalDynFlags) \
SymI_HasProto(getOrSetLibHSghcGlobalHasPprDebug) \
SymI_HasProto(getOrSetLibHSghcGlobalHasNoDebugOutput) \
SymI_HasProto(getOrSetLibHSghcGlobalHasNoStateHack) \
SymI_HasProto(genericRaise) \
SymI_HasProto(getProgArgv) \
SymI_HasProto(getFullProgArgv) \
......
......@@ -2,14 +2,19 @@ module LinkerTicklingPlugin where
import GHC.Plugins
import GHC.Driver.Session
import GHC.Utils.GlobalVars
plugin :: Plugin
plugin = defaultPlugin {
installCoreToDos = install
}
plugin = defaultPlugin
{ installCoreToDos = install
}
-- This tests whether plugins are linking against the *running* GHC or a new
-- instance of it. If it is a new instance (settings unsafeGlobalDynFlags) won't
-- have been initialised, so we'll get a GHC panic here:
install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _options todos = settings unsafeGlobalDynFlags `seq` return todos
install _options todos = io `seq` return todos
where
io = if not unsafeHasPprDebug
then error "unsafePprDebug should be set: plugin linked against a different GHC?"
else ()
......@@ -44,7 +44,7 @@ test('plugins06',
[extra_files(['LinkerTicklingPlugin.hs']),
unless(have_dynamic(), skip),
only_ways([config.ghc_plugin_way])],
multimod_compile_and_run, ['plugins06', '-package ghc'])
multimod_compile_and_run, ['plugins06', '-package ghc -dppr-debug'])
test('plugins07',
[extra_files(['rule-defining-plugin/']),
......