2 % (c) The University of Glasgow, 2000
4 \section[CmLink]{Linker for GHCI}
7 module CmLink ( Linkable(..), Unlinked(..),
9 modname_of_linkable, is_package_linkable,
12 PersistentLinkerState{-abstractly!-}, emptyPLS )
15 import StgInterp ( linkIModules, ClosureEnv, ItblEnv )
17 import CmStaticInfo ( PackageConfigInfo )
18 import Module ( ModuleName, PackageName )
19 import InterpSyn ( UnlinkedIBind, HValue, binder )
20 import Module ( Module )
21 import Outputable ( SDoc )
22 import FiniteMap ( emptyFM )
23 import Digraph ( SCC(..) )
25 import Panic ( panic )
27 #include "HsVersions.h"
31 data PersistentLinkerState
32 = PersistentLinkerState {
33 -- Current global mapping from RdrNames to closure addresses
34 closure_env :: ClosureEnv,
36 -- the current global mapping from RdrNames of DataCons to
37 -- info table addresses.
38 -- When a new Unlinked is linked into the running image, or an existing
39 -- module in the image is replaced, the itbl_env must be updated
43 -- notionally here, but really lives in the C part of the linker:
44 -- object_symtab :: FiniteMap String Addr
48 = LinkOK PersistentLinkerState
49 | LinkErrs PersistentLinkerState [SDoc]
55 | Trees [UnlinkedIBind] ItblEnv -- bunch of interpretable bindings, +
56 -- a mapping from DataCons to their itbls
58 instance Outputable Unlinked where
59 ppr (DotO path) = text "DotO" <+> text path
60 ppr (DotA path) = text "DotA" <+> text path
61 ppr (DotDLL path) = text "DotDLL" <+> text path
62 ppr (Trees binds) = text "Trees" <+> ppr (map binder binds)
65 isObject (DotO _) = True
66 isObject (DotA _) = True
67 isObject (DotDLL _) = True
70 isInterpretable (Trees _) = True
71 isInterpretable _ = False
74 = LM ModuleName [Unlinked]
77 instance Outputable Linkable where
78 ppr (LM mod_nm unlinkeds) = text "LinkableM" <+> ppr mod_nm <+> ppr unlinkeds
79 ppr (LP package_nm) = text "LinkableP" <+> ptext package_nm
81 emptyPLS :: IO PersistentLinkerState
82 emptyPLS = return (PersistentLinkerState { closure_env = emptyFM,
87 link :: PackageConfigInfo
89 -> PersistentLinkerState
93 --link = panic "CmLink.link: not implemented"
95 = do putStrLn "Hello from the Linker!"
96 putStrLn (showSDoc (vcat (map ppLinkableSCC groups)))
97 putStrLn "Bye-bye from the Linker!"
100 ppLinkableSCC :: SCC Linkable -> SDoc
101 ppLinkableSCC (CyclicSCC xs) = ppr xs
102 ppLinkableSCC (AcyclicSCC x) = ppr [x]
106 link pci [] pls = return (LinkOK pls)
107 link pci (group:groups) pls = do
108 -- the group is either all objects or all interpretable, for now
109 if all isObject group
110 then do mapM loadObj [ file | DotO file <- group ]
113 else if all isInterpretable group
114 then do (new_closure_env, new_itbl_env) <-
115 linkIModules (closure_env pls)
117 [ trees | Trees trees <- group ]
118 link pci groups (PersistentLinkerState{
119 closure_env=new_closure_env,
120 itbl_env=new_itbl_env})
122 return (LinkErrs pls (ptext SLIT("linker: group must contain all objects or all interpreted modules")))
125 modname_of_linkable (LM nm _) = nm
126 modname_of_linkable (LP _) = panic "modname_of_linkable: package"
128 is_package_linkable (LP _) = True
129 is_package_linkable (LM _ _) = False
131 filterModuleLinkables :: (ModuleName -> Bool)
134 filterModuleLinkables p [] = []
135 filterModuleLinkables p (li:lis)
138 LM modnm _ -> if p modnm then retain else dump
140 dump = filterModuleLinkables p lis