Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Fumiaki Kinoshita
GHC
Commits
e2330b6d
Commit
e2330b6d
authored
Nov 30, 2016
by
Ben Gamari
🐢
Browse files
Revert "Make globals use sharedCAF"
This reverts commit
6f7ed1e5
due to breakage of the build on Windows.
parent
03766cdb
Changes
14
Hide whitespace changes
Inline
Side-by-side
compiler/HsVersions.h
View file @
e2330b6d
...
...
@@ -32,22 +32,6 @@ name = Util.global (value);
name :: IORef (ty); \
name = Util.globalM (value);
#define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = Util.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 = Util.sharedGlobalM (value) (accessor); \
foreign import ccall unsafe saccessor \
accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
#define ASSERT(e) if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else
#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else
#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $
...
...
compiler/ghci/Linker.hs
View file @
e2330b6d
{-# LANGUAGE CPP, NondecreasingIndentation, TupleSections, RecordWildCards #-}
{-# OPTIONS_GHC -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
--
-- (c) The University of Glasgow 2002-2006
--
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
-- | The dynamic linker for GHCi.
--
-- This module deals with the top-level issues of dynamic linking,
...
...
@@ -15,7 +16,10 @@ module Linker ( getHValue, showLinkerState,
extendLinkEnv
,
deleteFromLinkEnv
,
extendLoadedPkgs
,
linkPackages
,
initDynLinker
,
linkModule
,
linkCmdLineLibs
linkCmdLineLibs
,
-- Saving/restoring globals
PersistentLinkerState
,
saveLinkerGlobals
,
restoreLinkerGlobals
)
where
#
include
"HsVersions.h"
...
...
@@ -62,11 +66,6 @@ import System.Directory
import
Exception
#
if
__GLASGOW_HASKELL__
>=
709
import
Foreign
#
else
import
Foreign.Safe
#
endif
{- **********************************************************************
...
...
@@ -85,22 +84,9 @@ library to side-effect the PLS and for those changes to be reflected here.
The PersistentLinkerState maps Names to actual closures (for
interpreted code only), for use during linking.
-}
#
if
STAGE
<
2
GLOBAL_VAR_M
(
v_PersistentLinkerState
,
newMVar
(
panic
"Dynamic linker not initialised"
),
MVar
PersistentLinkerState
)
GLOBAL_VAR
(
v_InitLinkerDone
,
False
,
Bool
)
-- Set True when dynamic linker is initialised
#
else
SHARED_GLOBAL_VAR_M
(
v_PersistentLinkerState
,
getOrSetLibHSghcPersistentLinkerState
,
"getOrSetLibHSghcPersistentLinkerState"
,
newMVar
(
panic
"Dynamic linker not initialised"
)
,
MVar
PersistentLinkerState
)
-- Set True when dynamic linker is initialised
SHARED_GLOBAL_VAR
(
v_InitLinkerDone
,
getOrSetLibHSghcInitLinkerDone
,
"getOrSetLibHSghcInitLinkerDone"
,
False
,
Bool
)
#
endif
modifyPLS_
::
(
PersistentLinkerState
->
IO
PersistentLinkerState
)
->
IO
()
modifyPLS_
f
=
readIORef
v_PersistentLinkerState
>>=
flip
modifyMVar_
f
...
...
@@ -1442,3 +1428,17 @@ maybePutStr dflags s
maybePutStrLn
::
DynFlags
->
String
->
IO
()
maybePutStrLn
dflags
s
=
maybePutStr
dflags
(
s
++
"
\n
"
)
{- **********************************************************************
Tunneling global variables into new instance of GHC library
********************************************************************* -}
saveLinkerGlobals
::
IO
(
MVar
PersistentLinkerState
,
Bool
)
saveLinkerGlobals
=
liftM2
(,)
(
readIORef
v_PersistentLinkerState
)
(
readIORef
v_InitLinkerDone
)
restoreLinkerGlobals
::
(
MVar
PersistentLinkerState
,
Bool
)
->
IO
()
restoreLinkerGlobals
(
pls
,
ild
)
=
do
writeIORef
v_PersistentLinkerState
pls
writeIORef
v_InitLinkerDone
ild
compiler/main/DynFlags.hs
View file @
e2330b6d
...
...
@@ -232,13 +232,6 @@ import qualified Data.IntSet as IntSet
import
GHC.Foreign
(
withCString
,
peekCString
)
import
qualified
GHC.LanguageExtensions
as
LangExt
#
if
__GLASGOW_HASKELL__
>=
709
import
Foreign
#
else
import
Foreign.Safe
#
endif
-- Note [Updating flag description in the User's Guide]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
...
...
@@ -5144,15 +5137,7 @@ defaultGlobalDynFlags =
where
settings
=
panic
"v_unsafeGlobalDynFlags: not initialised"
#
if
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
...
...
compiler/main/StaticFlags.hs
View file @
e2330b6d
...
...
@@ -48,12 +48,6 @@ import Control.Monad
import
Data.IORef
import
System.IO.Unsafe
(
unsafePerformIO
)
#
if
__GLASGOW_HASKELL__
>=
709
import
Foreign
#
else
import
Foreign.Safe
#
endif
-----------------------------------------------------------------------------
-- Static flags
...
...
@@ -97,21 +91,9 @@ parseStaticFlagsFull flagsAvailable args = do
-- holds the static opts while they're being collected, before
-- being unsafely read by unpacked_static_opts below.
#
if
STAGE
<
2
GLOBAL_VAR
(
v_opt_C
,
[]
,
[
String
])
GLOBAL_VAR
(
v_opt_C_ready
,
False
,
Bool
)
#
else
SHARED_GLOBAL_VAR
(
v_opt_C
,
getOrSetLibHSghcStaticOptions
,
"getOrSetLibHSghcStaticOptions"
,
[]
,
[
String
])
SHARED_GLOBAL_VAR
(
v_opt_C_ready
,
getOrSetLibHSghcStaticOptionsReady
,
"getOrSetLibHSghcStaticOptionsReady"
,
False
,
Bool
)
#
endif
staticFlags
::
[
String
]
staticFlags
=
unsafePerformIO
$
do
...
...
compiler/simplCore/CoreMonad.hs
View file @
e2330b6d
...
...
@@ -95,8 +95,16 @@ import Control.Applicative ( Alternative(..) )
import
Prelude
hiding
(
read
)
#
ifdef
GHCI
import
Control.Concurrent.MVar
(
MVar
)
import
Linker
(
PersistentLinkerState
,
saveLinkerGlobals
,
restoreLinkerGlobals
)
import
{-#
SOURCE
#-
}
TcSplice
(
lookupThName_maybe
)
import
qualified
Language.Haskell.TH
as
TH
#
else
saveLinkerGlobals
::
IO
()
saveLinkerGlobals
=
return
()
restoreLinkerGlobals
::
()
->
IO
()
restoreLinkerGlobals
()
=
return
()
#
endif
{-
...
...
@@ -501,7 +509,12 @@ data CoreReader = CoreReader {
cr_print_unqual
::
PrintUnqualified
,
cr_loc
::
SrcSpan
,
-- Use this for log/error messages so they
-- are at least tagged with the right source file
cr_visible_orphan_mods
::
!
ModuleSet
cr_visible_orphan_mods
::
!
ModuleSet
,
#
ifdef
GHCI
cr_globals
::
(
MVar
PersistentLinkerState
,
Bool
)
#
else
cr_globals
::
()
#
endif
}
-- Note: CoreWriter used to be defined with data, rather than newtype. If it
...
...
@@ -573,13 +586,15 @@ runCoreM :: HscEnv
->
CoreM
a
->
IO
(
a
,
SimplCount
)
runCoreM
hsc_env
rule_base
us
mod
orph_imps
print_unqual
loc
m
=
liftM
extract
$
runIOEnv
reader
$
unCoreM
m
state
=
do
{
glbls
<-
saveLinkerGlobals
;
liftM
extract
$
runIOEnv
(
reader
glbls
)
$
unCoreM
m
state
}
where
reader
=
CoreReader
{
reader
glbls
=
CoreReader
{
cr_hsc_env
=
hsc_env
,
cr_rule_base
=
rule_base
,
cr_module
=
mod
,
cr_visible_orphan_mods
=
orph_imps
,
cr_globals
=
glbls
,
cr_print_unqual
=
print_unqual
,
cr_loc
=
loc
}
...
...
@@ -675,9 +690,59 @@ getPackageFamInstEnv = do
eps
<-
liftIO
$
hscEPS
hsc_env
return
$
eps_fam_inst_env
eps
{-# DEPRECATED reinitializeGlobals "reinitializing globals is now a no-op." #-}
{-
************************************************************************
* *
Initializing globals
* *
************************************************************************
This is a rather annoying function. 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.
(NB This mechanism is sufficient for granting plugins read-only access to
globals that are guaranteed to be initialized before the plugin is loaded. If
any further synchronization is necessary, I would suggest using the more
sophisticated mechanism involving GHC.Conc.Sync.sharedCAF and rts/Globals.c to
share a single instance of the global variable among the compiler and the
plugins. Perhaps we should migrate all global variables to use that mechanism,
for robustness... -- NSF July 2013)
This leads to loaded plugins calling GHC code which pokes the static flags,
and then dying with a panic because the static flags *it* sees are uninitialized.
There are two possible solutions:
1. Export the symbols from the GHC executable from the GHC library and link
against this existing copy rather than a new copy of the GHC library
2. Carefully ensure that the global state in the two copies of the GHC
library matches
I tried 1. and it *almost* works (and speeds up plugin load times!) except
on Windows. On Windows the GHC library tends to export more than 65536 symbols
(see #5292) which overflows the limit of what we can export from the EXE and
causes breakage.
(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.)
We are going to try 2. instead. Unfortunately, this means that every plugin
will have to say `reinitializeGlobals` before it does anything, but never mind.
I've threaded the cr_globals through CoreM rather than giving them as an
argument to the plugin function so that we can turn this function into
(return ()) without breaking any plugins when we eventually get 1. working.
-}
reinitializeGlobals
::
CoreM
()
reinitializeGlobals
=
return
()
reinitializeGlobals
=
do
linker_globals
<-
read
cr_globals
hsc_env
<-
getHscEnv
let
dflags
=
hsc_dflags
hsc_env
liftIO
$
restoreLinkerGlobals
linker_globals
liftIO
$
setUnsafeGlobalDynFlags
dflags
{-
************************************************************************
...
...
compiler/utils/FastString.hs
View file @
e2330b6d
...
...
@@ -285,6 +285,13 @@ originally assigned to those FastStrings. Thus the lookup fails since the
domain of the GlobalRdrEnv is affected by the RdrName's OccName's FastString's
unique.
The old `reinitializeGlobals` mechanism is enough to provide the plugin with
read-access to the table, but it insufficient in the general case where the
plugin may allocate FastStrings. This mutates the supply for the FastStrings'
unique, and that needs to be propagated back to the compiler's instance of the
global variable. Such propagation is beyond the `reinitializeGlobals`
mechanism.
Maintaining synchronization of the two instances of this global is rather
difficult because of the uses of `unsafePerformIO` in this module. Not
synchronizing them risks breaking the rather major invariant that two
...
...
compiler/utils/Util.hs
View file @
e2330b6d
...
...
@@ -104,7 +104,6 @@ module Util (
hSetTranslit
,
global
,
consIORef
,
globalM
,
sharedGlobal
,
sharedGlobalM
,
-- * Filenames and paths
Suffix
,
...
...
@@ -145,7 +144,6 @@ import qualified GHC.Stack
import
Control.Applicative
(
liftA2
)
import
Control.Monad
(
liftM
)
import
GHC.IO.Encoding
(
mkTextEncoding
,
textEncodingName
)
import
GHC.Conc.Sync
(
sharedCAF
)
import
System.IO
(
Handle
,
hGetEncoding
,
hSetEncoding
)
import
System.IO.Error
as
IO
(
isDoesNotExistError
)
import
System.Directory
(
doesDirectoryExist
,
getModificationTime
)
...
...
@@ -932,28 +930,6 @@ seqList :: [a] -> b -> b
seqList
[]
b
=
b
seqList
(
x
:
xs
)
b
=
x
`
seq
`
seqList
xs
b
{-
************************************************************************
* *
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
...
...
@@ -966,16 +942,6 @@ consIORef var x = do
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:
looksLikeModuleName
::
String
->
Bool
...
...
docs/users_guide/extending_ghc.rst
View file @
e2330b6d
...
...
@@ -305,6 +305,7 @@ just returns the original compilation pipeline, unmodified, and says
install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ todo = do
reinitializeGlobals
putMsgS "Hello!"
return todo
...
...
@@ -313,6 +314,16 @@ cabal for instance,) you can then use it by just specifying
``-fplugin=DoNothing.Plugin`` on the command line, and during the
compilation you should see GHC say '
Hello
'.
Note carefully the ``reinitializeGlobals`` call at the beginning of the
installation function. Due to bugs in the windows linker dealing with
``libghc``, this call is necessary to properly ensure compiler plugins
have the same global state as GHC at the time of invocation. Without
``reinitializeGlobals``, compiler plugins can crash at runtime because
they may require state that hasn'
t
otherwise
been
initialized
.
In
the
future
,
when
the
linking
bugs
are
fixed
,
``
reinitializeGlobals
``
will
be
deprecated
with
a
warning
,
and
changed
to
do
nothing
.
..
_core
-
plugins
-
in
-
more
-
detail
:
Core
plugins
in
more
detail
...
...
@@ -385,6 +396,7 @@ in a module it compiles:
install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
install _ todo = do
reinitializeGlobals
return (CoreDoPluginPass "Say name" pass : todo)
pass :: ModGuts -> CoreM ModGuts
...
...
@@ -434,6 +446,7 @@ will print out the name of any top-level non-recursive binding with the
install
::
[
CommandLineOption
]
->
[
CoreToDo
]
->
CoreM
[
CoreToDo
]
install
_
todo
=
do
reinitializeGlobals
return
(
CoreDoPluginPass
"Say name"
pass
:
todo
)
pass
::
ModGuts
->
CoreM
ModGuts
...
...
includes/rts/Globals.h
View file @
e2330b6d
...
...
@@ -17,23 +17,14 @@
#ifndef RTS_GLOBALS_H
#define RTS_GLOBALS_H
#define mkStoreAccessorPrototype(name) \
StgStablePtr \
getOrSet##name(StgStablePtr ptr);
mkStoreAccessorPrototype
(
GHCConcSignalSignalHandlerStore
)
mkStoreAccessorPrototype
(
GHCConcWindowsPendingDelaysStore
)
mkStoreAccessorPrototype
(
GHCConcWindowsIOManagerThreadStore
)
mkStoreAccessorPrototype
(
GHCConcWindowsProddingStore
)
mkStoreAccessorPrototype
(
SystemEventThreadEventManagerStore
)
mkStoreAccessorPrototype
(
SystemEventThreadIOManagerThreadStore
)
mkStoreAccessorPrototype
(
SystemTimerThreadEventManagerStore
)
mkStoreAccessorPrototype
(
SystemTimerThreadIOManagerThreadStore
)
mkStoreAccessorPrototype
(
LibHSghcFastStringTable
)
mkStoreAccessorPrototype
(
LibHSghcPersistentLinkerState
)
mkStoreAccessorPrototype
(
LibHSghcInitLinkerDone
)
mkStoreAccessorPrototype
(
LibHSghcGlobalDynFlags
)
mkStoreAccessorPrototype
(
LibHSghcStaticOptions
)
mkStoreAccessorPrototype
(
LibHSghcStaticOptionsReady
)
StgStablePtr
getOrSetGHCConcSignalSignalHandlerStore
(
StgStablePtr
value
);
StgStablePtr
getOrSetGHCConcWindowsPendingDelaysStore
(
StgStablePtr
ptr
);
StgStablePtr
getOrSetGHCConcWindowsIOManagerThreadStore
(
StgStablePtr
ptr
);
StgStablePtr
getOrSetGHCConcWindowsProddingStore
(
StgStablePtr
ptr
);
StgStablePtr
getOrSetSystemEventThreadEventManagerStore
(
StgStablePtr
ptr
);
StgStablePtr
getOrSetSystemEventThreadIOManagerThreadStore
(
StgStablePtr
ptr
);
StgStablePtr
getOrSetSystemTimerThreadEventManagerStore
(
StgStablePtr
ptr
);
StgStablePtr
getOrSetSystemTimerThreadIOManagerThreadStore
(
StgStablePtr
ptr
);
StgStablePtr
getOrSetLibHSghcFastStringTable
(
StgStablePtr
ptr
);
#endif
/* RTS_GLOBALS_H */
libraries/base/GHC/Conc/Sync.hs
View file @
e2330b6d
...
...
@@ -856,7 +856,7 @@ modifyMVar_ m io =
-- Thread waiting
-----------------------------------------------------------------------------
-- Machinery needed to ensure that we only have one copy of certain
-- Machinery needed to ensure
b
that we only have one copy of certain
-- CAFs in this module even when the base package is present twice, as
-- it is when base is dynamically loaded into GHCi. The RTS keeps
-- track of the single true value of the CAF, so even when the CAFs in
...
...
rts/Globals.c
View file @
e2330b6d
...
...
@@ -13,7 +13,7 @@
* dynamically loads
*
* libHSghc - a statically-linked ghc has its own copy and so will Core
* plugins it dynamically loads
.
* plugins it dynamically loads
(cf CoreMonad.reinitializeGlobals)
*
* ---------------------------------------------------------------------------*/
...
...
@@ -33,11 +33,6 @@ typedef enum {
SystemTimerThreadEventManagerStore
,
SystemTimerThreadIOManagerThreadStore
,
LibHSghcFastStringTable
,
LibHSghcPersistentLinkerState
,
LibHSghcInitLinkerDone
,
LibHSghcGlobalDynFlags
,
LibHSghcStaticOptions
,
LibHSghcStaticOptionsReady
,
MaxStoreKey
}
StoreKey
;
...
...
@@ -92,22 +87,56 @@ static StgStablePtr getOrSetKey(StoreKey key, StgStablePtr ptr)
return
ret
;
}
#define mkStoreAccessor(name) \
StgStablePtr \
getOrSet##name(StgStablePtr ptr) \
{ return getOrSetKey(name, ptr); }
mkStoreAccessor
(
GHCConcSignalSignalHandlerStore
)
mkStoreAccessor
(
GHCConcWindowsPendingDelaysStore
)
mkStoreAccessor
(
GHCConcWindowsIOManagerThreadStore
)
mkStoreAccessor
(
GHCConcWindowsProddingStore
)
mkStoreAccessor
(
SystemEventThreadEventManagerStore
)
mkStoreAccessor
(
SystemEventThreadIOManagerThreadStore
)
mkStoreAccessor
(
SystemTimerThreadEventManagerStore
)
mkStoreAccessor
(
SystemTimerThreadIOManagerThreadStore
)
mkStoreAccessor
(
LibHSghcFastStringTable
)
mkStoreAccessor
(
LibHSghcPersistentLinkerState
)
mkStoreAccessor
(
LibHSghcInitLinkerDone
)
mkStoreAccessor
(
LibHSghcGlobalDynFlags
)
mkStoreAccessor
(
LibHSghcStaticOptions
)
mkStoreAccessor
(
LibHSghcStaticOptionsReady
)
StgStablePtr
getOrSetGHCConcSignalSignalHandlerStore
(
StgStablePtr
ptr
)
{
return
getOrSetKey
(
GHCConcSignalSignalHandlerStore
,
ptr
);
}
StgStablePtr
getOrSetGHCConcWindowsPendingDelaysStore
(
StgStablePtr
ptr
)
{
return
getOrSetKey
(
GHCConcWindowsPendingDelaysStore
,
ptr
);
}
StgStablePtr
getOrSetGHCConcWindowsIOManagerThreadStore
(
StgStablePtr
ptr
)
{
return
getOrSetKey
(
GHCConcWindowsIOManagerThreadStore
,
ptr
);
}
StgStablePtr
getOrSetGHCConcWindowsProddingStore
(
StgStablePtr
ptr
)
{
return
getOrSetKey
(
GHCConcWindowsProddingStore
,
ptr
);
}
StgStablePtr
getOrSetSystemEventThreadEventManagerStore
(
StgStablePtr
ptr
)
{
return
getOrSetKey
(
SystemEventThreadEventManagerStore
,
ptr
);
}
StgStablePtr
getOrSetSystemEventThreadIOManagerThreadStore
(
StgStablePtr
ptr
)
{
return
getOrSetKey
(
SystemEventThreadIOManagerThreadStore
,
ptr
);
}
StgStablePtr
getOrSetSystemTimerThreadEventManagerStore
(
StgStablePtr
ptr
)
{
return
getOrSetKey
(
SystemTimerThreadEventManagerStore
,
ptr
);
}
StgStablePtr
getOrSetSystemTimerThreadIOManagerThreadStore
(
StgStablePtr
ptr
)
{
return
getOrSetKey
(
SystemTimerThreadIOManagerThreadStore
,
ptr
);
}
StgStablePtr
getOrSetLibHSghcFastStringTable
(
StgStablePtr
ptr
)
{
return
getOrSetKey
(
LibHSghcFastStringTable
,
ptr
);
}
testsuite/tests/plugins/LinkerTicklingPlugin.hs
View file @
e2330b6d
...
...
@@ -12,4 +12,6 @@ plugin = defaultPlugin {
-- or a new instance of it. If it is a new instance the staticFlags
-- won't have been initialised, so we'll get a GHC panic here:
install
::
[
CommandLineOption
]
->
[
CoreToDo
]
->
CoreM
[
CoreToDo
]
install
_options
todos
=
length
staticFlags
`
seq
`
return
todos
install
_options
todos
=
reinitializeGlobals
>>
(
length
staticFlags
`
seq
`
return
todos
)
--- XXX: remove reinitializeGlobals when we have fixed the linker
-- problem (see comment with reinitializeGlobals in CoreMonad.hs)
testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs
View file @
e2330b6d
...
...
@@ -13,6 +13,7 @@ plugin = defaultPlugin {
install
::
[
CommandLineOption
]
->
[
CoreToDo
]
->
CoreM
[
CoreToDo
]
install
_
todo
=
do
reinitializeGlobals
return
(
CoreDoPluginPass
"Say name"
pass
:
todo
)
pass
::
ModGuts
->
CoreM
ModGuts
...
...
testsuite/tests/simplCore/should_compile/T7702plugin/T7702Plugin.hs
View file @
e2330b6d
...
...
@@ -8,6 +8,7 @@ plugin = defaultPlugin { installCoreToDos = install }
where
install
::
[
CommandLineOption
]
->
[
CoreToDo
]
->
CoreM
[
CoreToDo
]
install
_
todos
=
do
reinitializeGlobals
putMsgS
"T7702Plugin"
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment