Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Glasgow Haskell Compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
4115f23c
Commit
4115f23c
authored
Jul 06, 2013
by
nfrisby
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
This reverts commit
163de258
and commit...
This reverts commit
163de258
and commit
279ac9f6
.
parent
48f462f3
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
10 additions
and
70 deletions
+10
-70
compiler/simplCore/CoreMonad.lhs
compiler/simplCore/CoreMonad.lhs
+6
-43
compiler/simplCore/SimplCore.lhs
compiler/simplCore/SimplCore.lhs
+2
-2
compiler/utils/FastString.lhs
compiler/utils/FastString.lhs
+2
-25
No files found.
compiler/simplCore/CoreMonad.lhs
View file @
4115f23c
...
...
@@ -44,7 +44,7 @@ module CoreMonad (
liftIO1, liftIO2, liftIO3, liftIO4,
-- ** Global initialization
reinitializeGlobals,
bracketGlobals,
reinitializeGlobals,
-- ** Dealing with annotations
getAnnotations, getFirstAnnotations,
...
...
@@ -722,12 +722,11 @@ data CoreReader = CoreReader {
cr_hsc_env :: HscEnv,
cr_rule_base :: RuleBase,
cr_module :: Module,
cr_globals :: (,,) (Bool, [String]) -- from StaticFlags
FastStringTable -- from FastString
cr_globals :: ((Bool, [String]),
#ifdef GHCI
(MVar PersistentLinkerState, Bool) -- from Linker
(MVar PersistentLinkerState, Bool))
#else
(
)
()
)
#endif
}
...
...
@@ -796,7 +795,7 @@ runCoreM :: HscEnv
-> CoreM a
-> IO (a, SimplCount)
runCoreM hsc_env rule_base us mod m = do
glbls <- liftM
3 (,,) saveStaticFlagGlobals saveFSTable
saveLinkerGlobals
glbls <- liftM
2 (,) saveStaticFlagGlobals
saveLinkerGlobals
liftM extract $ runIOEnv (reader glbls) $ unCoreM m state
where
reader glbls = CoreReader {
...
...
@@ -898,8 +897,6 @@ getOrigNameCache = do
%* *
%************************************************************************
Note [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
...
...
@@ -930,49 +927,15 @@ 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.
-----
We include the FastString table in this mechanism, because we'd like
FastStrings created by the plugin to have the same uniques as similar strings
created by the host compiler itself. For example, this allows plugins to
lookup known names (eg `mkTcOcc "MySpecialType"`) in the GlobalRdrEnv or even
re-invoke the parser.
In particular, the following little sanity test was failing in a plugin
prototyping safe newtype-coercions.
let rdrName = mkModuleName "GHC.NT.Type" `mkRdrQual` mkTcOcc "NT"
putMsgS $ showSDoc dflags $ ppr $ lookupGRE_RdrName rdrName $ mg_rdr_env guts
`mkTcOcc` involves the lookup (or creation) of a FastString. Since the
plugin's FastString.string_table is empty, constructing the RdrName also
allocates new uniques for the FastStrings "GHC.NT.Type" and "NT". These
uniques are almost certainly unequal to the ones that the host compiler
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.
\begin{code}
-- called by plugin
reinitializeGlobals :: CoreM ()
reinitializeGlobals = do
(sf_globals,
fs_table,
linker_globals) <- read cr_globals
(sf_globals, linker_globals) <- read cr_globals
hsc_env <- getHscEnv
let dflags = hsc_dflags hsc_env
liftIO $ restoreStaticFlagGlobals sf_globals
liftIO $ restoreFSTable fs_table
liftIO $ restoreLinkerGlobals linker_globals
liftIO $ setUnsafeGlobalDynFlags dflags
-- called by host compiler, assuming argument is code from a plugin
bracketGlobals :: CoreM a -> CoreM a
bracketGlobals (CoreM f) = do
tbl <- liftIO saveFSTable
let upd e = e {cr_globals=(x,tbl,z)}
where (x,_,z) = cr_globals e
x <- CoreM (\s -> updEnv upd (f s))
liftIO unsaveFSTable
return x
\end{code}
%************************************************************************
...
...
compiler/simplCore/SimplCore.lhs
View file @
4115f23c
...
...
@@ -311,7 +311,7 @@ addPluginPasses dflags builtin_passes
; foldM query_plug builtin_passes named_plugins }
where
query_plug todos (mod_nm, plug)
=
bracketGlobals $
installCoreToDos plug options todos
= installCoreToDos plug options todos
where
options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
, opt_mod_nm == mod_nm ]
...
...
@@ -407,7 +407,7 @@ doCorePass _ CoreDoNothing = return
doCorePass _ (CoreDoPasses passes) = runCorePasses passes
#ifdef GHCI
doCorePass _ (CoreDoPluginPass _ pass) = {-# SCC "Plugin" #-}
(bracketGlobals . pass)
doCorePass _ (CoreDoPluginPass _ pass) = {-# SCC "Plugin" #-}
pass
#endif
doCorePass _ pass = pprPanic "doCorePass" (ppr pass)
...
...
compiler/utils/FastString.lhs
View file @
4115f23c
...
...
@@ -91,10 +91,7 @@ module FastString
unpackLitString,
-- ** Operations
lengthLS,
-- * Saving/restoring globals
saveFSTable, restoreFSTable, unsaveFSTable, FastStringTable
lengthLS
) where
#include "HsVersions.h"
...
...
@@ -480,7 +477,7 @@ nilFS = mkFastString ""
getFastStringTable :: IO [[FastString]]
getFastStringTable = do
tbl <- readIORef string_table
buckets <- mapM (lookupTbl tbl) [0 .. hASH_TBL_SIZE
- 1
]
buckets <- mapM (lookupTbl tbl) [0 .. hASH_TBL_SIZE]
return buckets
-- -----------------------------------------------------------------------------
...
...
@@ -576,24 +573,4 @@ fsLit x = mkFastString x
forall x . sLit (unpackCString# x) = mkLitString# x #-}
{-# RULES "fslit"
forall x . fsLit (unpackCString# x) = mkFastString# x #-}
--------------------
-- for plugins; see Note [Initializing globals] in CoreMonad
-- called by host compiler
saveFSTable :: IO FastStringTable
saveFSTable = readIORef string_table
-- called by host compiler
unsaveFSTable :: IO ()
unsaveFSTable = do
tbl@(FastStringTable _ arr#) <- readIORef string_table
buckets <- mapM (lookupTbl tbl) [0 .. hASH_TBL_SIZE - 1]
let size = sum $ map length $ buckets
writeIORef string_table (FastStringTable size arr#)
-- called by plugin
restoreFSTable :: FastStringTable -> IO ()
restoreFSTable = writeIORef string_table
\end{code}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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