2 % (c) The University of Glasgow, 2000
4 \section[CmLink]{Linker for GHCI}
7 module CmLink ( Linkable(..), Unlinked(..),
9 findModuleLinkable_maybe,
10 modname_of_linkable, is_package_linkable,
14 PersistentLinkerState{-abstractly!-}, emptyPLS,
22 import CmStaticInfo ( GhciMode(..) )
23 import Outputable ( SDoc )
24 import Digraph ( SCC(..), flattenSCC )
26 import Module ( ModuleName, PackageName )
30 import Panic ( panic )
35 #include "HsVersions.h"
39 data PersistentLinkerState
40 = PersistentLinkerState {
43 -- Current global mapping from RdrNames to closure addresses
44 closure_env :: ClosureEnv,
46 -- the current global mapping from RdrNames of DataCons to
47 -- info table addresses.
48 -- When a new Unlinked is linked into the running image, or an existing
49 -- module in the image is replaced, the itbl_env must be updated
53 -- notionally here, but really lives in the C part of the linker:
54 -- object_symtab :: FiniteMap String Addr
56 dummy :: () -- sigh, can't have an empty record
62 = LinkOK PersistentLinkerState
63 | LinkErrs PersistentLinkerState [SDoc]
65 findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
66 findModuleLinkable_maybe lis mod
67 = case [LM time nm us | LM time nm us <- lis, nm == mod] of
70 many -> pprPanic "findModuleLinkable" (ppr mod)
73 emptyPLS :: IO PersistentLinkerState
75 emptyPLS = return (PersistentLinkerState { closure_env = emptyFM,
78 emptyPLS = return (PersistentLinkerState {})
83 link :: GhciMode -- interactive or batch
84 -> Bool -- attempt linking in batch mode?
85 -> [Linkable] -- only contains LMs, not LPs
86 -> PersistentLinkerState
89 -- For the moment, in the batch linker, we don't bother to tell doLink
90 -- which packages to link -- it just tries all that are available.
91 -- batch_attempt_linking should only be *looked at* in batch mode. It
92 -- should only be True if the upsweep was successful and someone
93 -- exports main, i.e., we have good reason to believe that linking
96 -- There will be (ToDo: are) two lists passed to link. These
99 -- 1. The list of all linkables in the current home package. This is
100 -- used by the batch linker to link the program, and by the interactive
101 -- linker to decide which modules from the previous link it can
103 -- 2. The list of modules on which we just called "compile". This list
104 -- is used by the interactive linker to decide which modules need
105 -- to be actually linked this time around (or unlinked and re-linked
106 -- if the module was recompiled).
108 link mode batch_attempt_linking linkables pls1
109 = do hPutStrLn stderr "CmLink.link: linkables are ..."
110 hPutStrLn stderr (showSDoc (vcat (map ppr linkables)))
111 res <- link' mode batch_attempt_linking linkables pls1
112 hPutStrLn stderr "CmLink.link: done"
115 link' Batch batch_attempt_linking linkables pls1
116 | batch_attempt_linking
117 = do let o_files = concatMap getOfiles linkables
119 -- doLink only returns if it succeeds
122 = do hPutStrLn stderr "CmLink.link(batch): upsweep (partially?) failed OR main not exported;"
123 hPutStrLn stderr " -- not doing linking"
126 getOfiles (LP _) = panic "CmLink.link(getOfiles): shouldn't get package linkables"
127 getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
129 link' Interactive batch_attempt_linking linkables pls1
130 = linkObjs linkables pls1
133 ppLinkableSCC :: SCC Linkable -> SDoc
134 ppLinkableSCC = ppr . flattenSCC
137 modname_of_linkable (LM _ nm _) = nm
138 modname_of_linkable (LP _) = panic "modname_of_linkable: package"
140 is_package_linkable (LP _) = True
141 is_package_linkable (LM _ _ _) = False
143 filterModuleLinkables :: (ModuleName -> Bool)
146 filterModuleLinkables p [] = []
147 filterModuleLinkables p (li:lis)
150 LM _ modnm _ -> if p modnm then retain else dump
152 dump = filterModuleLinkables p lis
155 -----------------------------------------------------------------------------
156 -- Linker for interactive mode
159 linkObjs = panic "CmLink.linkObjs: no interpreter"
160 unload = panic "CmLink.unload: no interpreter"
161 lookupClosure = panic "CmLink.lookupClosure: no interpreter"
163 linkObjs [] pls = linkFinish pls [] []
164 linkObjs (l@(LM _ _ uls) : ls) pls
165 | all isObject uls = do
166 mapM_ loadObj [ file | DotO file <- uls ]
168 | all isInterpretable uls = linkInterpretedCode (l:ls) [] [] pls
169 | otherwise = invalidLinkable
171 throwDyn (OtherError "CmLink.linkObjs: found package linkable")
174 linkInterpretedCode [] mods ul_trees pls = linkFinish pls mods ul_trees
175 linkInterpretedCode (LM _ m uls : ls) mods ul_trees pls
176 | all isInterpretable uls =
177 linkInterpretedCode ls (m:mods) (uls++ul_trees) pls
180 = throwDyn (OtherError "can't link object code that depends on interpreted code")
181 | otherwise = invalidLinkable
182 linkInterpretedCode _ _ _ pls =
183 throwDyn (OtherError "CmLink.linkInterpretedCode: found package linkable")
185 invalidLinkable = throwDyn (OtherError "linkable doesn't contain entirely objects interpreted code")
188 -- link all the interpreted code in one go. We first remove from the
189 -- various environments any previous versions of these modules.
190 linkFinish pls mods ul_trees = do
192 let itbl_env' = filterRdrNameEnv mods (itbl_env pls)
193 closure_env' = filterRdrNameEnv mods (closure_env pls)
194 stuff = [ (trees,itbls) | Trees trees itbls <- ul_trees ]
196 (ibinds, new_itbl_env, new_closure_env) <-
197 linkIModules itbl_env' closure_env' stuff
199 let new_pls = PersistentLinkerState {
200 closure_env = new_closure_env,
201 itbl_env = new_itbl_env
203 putStrLn (showSDoc (vcat (map ppr (keysFM new_closure_env))))
204 return (LinkOK new_pls)
206 -- purge the current "linked image"
207 unload :: PersistentLinkerState -> IO PersistentLinkerState
208 unload pls = return pls{ closure_env = emptyFM, itbl_env = emptyFM }
210 linkExpr :: PersistentLinkerState -> UnlinkedIExpr -> IO HValue
211 linkExpr PersistentLinkerState{ itbl_env = ie, closure_env = ce } expr
212 = iExprToHValue ie ce expr