2 % (c) The University of Glasgow, 2000
4 \section[CmLink]{Linker for GHCI}
7 module CmLink ( Linkable(..), Unlinked(..),
10 modname_of_linkable, is_package_linkable,
14 PersistentLinkerState{-abstractly!-}, emptyPLS
21 import CmStaticInfo ( GhciMode(..) )
22 import Module ( ModuleName, PackageName )
23 import Outputable ( SDoc )
25 import Digraph ( SCC(..), flattenSCC )
29 import Panic ( panic )
33 #include "HsVersions.h"
37 data PersistentLinkerState
38 = PersistentLinkerState {
41 -- Current global mapping from RdrNames to closure addresses
42 closure_env :: ClosureEnv,
44 -- the current global mapping from RdrNames of DataCons to
45 -- info table addresses.
46 -- When a new Unlinked is linked into the running image, or an existing
47 -- module in the image is replaced, the itbl_env must be updated
51 -- notionally here, but really lives in the C part of the linker:
52 -- object_symtab :: FiniteMap String Addr
54 dummy :: () -- sigh, can't have an empty record
60 = LinkOK PersistentLinkerState
61 | LinkErrs PersistentLinkerState [SDoc]
63 findModuleLinkable :: [Linkable] -> ModuleName -> Linkable
64 findModuleLinkable lis mod
65 = case [LM nm us | LM nm us <- lis, nm == mod] of
67 other -> pprPanic "findModuleLinkable" (ppr mod)
70 emptyPLS :: IO PersistentLinkerState
72 emptyPLS = return (PersistentLinkerState { closure_env = emptyFM,
75 emptyPLS = return (PersistentLinkerState {})
80 link :: GhciMode -- interactive or batch
81 -> Bool -- attempt linking in batch mode?
82 -> [Linkable] -- only contains LMs, not LPs
83 -> PersistentLinkerState
86 -- For the moment, in the batch linker, we don't bother to tell doLink
87 -- which packages to link -- it just tries all that are available.
88 -- batch_attempt_linking should only be *looked at* in batch mode. It
89 -- should only be True if the upsweep was successful and someone
90 -- exports main, i.e., we have good reason to believe that linking
93 -- There will be (ToDo: are) two lists passed to link. These
96 -- 1. The list of all linkables in the current home package. This is
97 -- used by the batch linker to link the program, and by the interactive
98 -- linker to decide which modules from the previous link it can
100 -- 2. The list of modules on which we just called "compile". This list
101 -- is used by the interactive linker to decide which modules need
102 -- to be actually linked this time around (or unlinked and re-linked
103 -- if the module was recompiled).
105 link Batch batch_attempt_linking linkables pls1
106 | batch_attempt_linking
107 = do hPutStrLn stderr "CmLink.link(batch): linkables are ..."
108 hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
109 let o_files = concatMap getOfiles linkables
111 -- doLink only returns if it succeeds
112 hPutStrLn stderr "CmLink.link(batch): done"
115 = do hPutStrLn stderr "CmLink.link(batch): upsweep (partially?) failed OR main not exported;"
116 hPutStrLn stderr " -- not doing linking"
119 getOfiles (LP _) = panic "CmLink.link(getOfiles): shouldn't get package linkables"
120 getOfiles (LM _ us) = map nameOfObject (filter isObject us)
122 link Interactive batch_attempt_linking linkables pls1
123 = linkObjs linkables pls1
125 ppLinkableSCC :: SCC Linkable -> SDoc
126 ppLinkableSCC = ppr . flattenSCC
129 modname_of_linkable (LM nm _) = nm
130 modname_of_linkable (LP _) = panic "modname_of_linkable: package"
132 is_package_linkable (LP _) = True
133 is_package_linkable (LM _ _) = False
135 filterModuleLinkables :: (ModuleName -> Bool)
138 filterModuleLinkables p [] = []
139 filterModuleLinkables p (li:lis)
142 LM modnm _ -> if p modnm then retain else dump
144 dump = filterModuleLinkables p lis
147 -----------------------------------------------------------------------------
148 -- Linker for interactive mode
151 linkObjs = panic "CmLink.linkObjs: no interpreter"
152 unload = panic "CmLink.unload: no interpreter"
154 linkObjs [] pls = linkFinish pls [] []
155 linkObjs (l@(LM _ uls) : ls) pls
156 | all isObject uls = do
157 mapM_ loadObj [ file | DotO file <- uls ]
159 | all isInterpretable uls = linkInterpretedCode (l:ls) [] [] pls
160 | otherwise = invalidLinkable
162 throwDyn (OtherError "CmLink.linkObjs: found package linkable")
165 linkInterpretedCode [] mods ul_trees pls = linkFinish pls mods ul_trees
166 linkInterpretedCode (LM m uls : ls) mods ul_trees pls
167 | all isInterpretable uls =
168 linkInterpretedCode ls (m:mods) (uls++ul_trees) pls
171 = throwDyn (OtherError "can't link object code that depends on interpreted code")
172 | otherwise = invalidLinkable
173 linkInterpretedCode _ _ _ pls =
174 throwDyn (OtherError "CmLink.linkInterpretedCode: found package linkable")
176 invalidLinkable = throwDyn (OtherError "linkable doesn't contain entirely objects interpreted code")
179 -- link all the interpreted code in one go. We first remove from the
180 -- various environments any previous versions of these modules.
181 linkFinish pls mods ul_trees = do
182 let itbl_env' = filterRdrNameEnv mods (itbl_env pls)
183 closure_env' = filterRdrNameEnv mods (closure_env pls)
184 stuff = [ (trees,itbls) | Trees trees itbls <- ul_trees ]
186 (ibinds, new_itbl_env, new_closure_env) <-
187 linkIModules closure_env' itbl_env' stuff
189 let new_pls = PersistentLinkerState {
190 closure_env = new_closure_env,
191 itbl_env = new_itbl_env
194 return (LinkOK new_pls)
196 -- purge the current "linked image"
197 unload :: PersistentLinkerState -> IO PersistentLinkerState
198 unload pls = return pls{ closure_env = emptyFM, itbl_env = emptyFM }