ghc/compiler/ghci/CmLink.lhs

   1 %
   2 % (c) The University of Glasgow, 2000
   3 %
   4 \section[CmLink]{Linker for GHCI}
   5
   6 \begin{code}
   7 module CmLink ( Linkable(..),
   8                 filterModuleLinkables,
   9                 modname_of_linkable, is_package_linkable,
  10                 LinkResult(..),
  11                 link,
  12                 PLS{-abstractly!-}, emptyPLS )
  13 where
  14
  15 import StgInterp        ( linkIModules, ClosureEnv, ItblEnv )
  16 import Linker
  17
  18 import CmStaticInfo     ( PCI )
  19 import CmFind           ( Path, PkgName )
  20 import InterpSyn        ( UnlinkedIBind, HValue )
  21 import Module           ( Module )
  22 import Outputable       ( SDoc )
  23 import FiniteMap        ( FiniteMap, emptyFM )
  24 import RdrName          ( RdrName )
  25 import Digraph          ( SCC )
  26 import Addr             ( Addr )
  27 import Outputable
  28 import Panic            ( panic )
  29
  30 #include "HsVersions.h"
  31 \end{code}
  32
  33 \begin{code}
  34 data PLS
  35    = MkPLS {
  36         closure_env :: ClosureEnv,
  37         itbl_env    :: ItblEnv
  38         -- notionally here, but really lives in the C part of the linker:
  39         --            object_symtab :: FiniteMap String Addr
  40      }
  41
  42 data LinkResult
  43    = LinkOK   PLS
  44    | LinkErrs PLS [SDoc]
  45
  46 data Unlinked
  47    = DotO Path
  48    | DotA Path
  49    | DotDLL Path
  50    | Trees [UnlinkedIBind]      -- bunch of interpretable bindings
  51
  52 isObject (DotO _) = True
  53 isObject (DotA _) = True
  54 isObject (DotDLL _) = True
  55 isObject _ = False
  56
  57 isInterpretable (Trees _) = True
  58 isInterpretable _ = False
  59
  60 data Linkable
  61    = LM {-should be:Module-} String{- == ModName-} [Unlinked]
  62    | LP PkgName
  63
  64 emptyPLS :: IO PLS
  65 emptyPLS = return (MkPLS { closure_env = emptyFM,
  66                            itbl_env    = emptyFM })
  67 \end{code}
  68
  69 \begin{code}
  70 link :: PCI -> [SCC Linkable] -> PLS -> IO LinkResult
  71
  72 #ifndef GHCI_NOTYET
  73 link = panic "CmLink.link: not implemented"
  74 #else
  75 link pci [] pls = return (LinkOK pls)
  76 link pci (group:groups) pls = do
  77    -- the group is either all objects or all interpretable, for now
  78    if all isObject group
  79         then do mapM loadObj [ file | DotO file <- group ]
  80                 resolveObjs
  81                 link pci groups pls
  82     else if all isInterpretable group
  83         then do (new_closure_env, new_itbl_env) <-
  84                    linkIModules (closure_env pls)
  85                                 (itbl_env pls)
  86                                 [ trees | Trees trees <- group ]
  87                 link pci groups MkPLS{closure_env=new_closure_env,
  88                                       itbl_env=new_itbl_env}
  89     else
  90         return (LinkErrs pls (ptext SLIT("linker: group must contain all objects or all interpreted modules")))
  91 #endif
  92
  93 modname_of_linkable (LM nm _) = nm
  94 modname_of_linkable (LP _)    = panic "modname_of_linkable: package"
  95
  96 is_package_linkable (LP _)   = True
  97 is_package_linkable (LM _ _) = False
  98
  99 filterModuleLinkables :: (String{- ==ModName-} -> Bool)
 100                       -> [Linkable]
 101                       -> [Linkable]
 102 filterModuleLinkables p [] = []
 103 filterModuleLinkables p (li:lis)
 104    = case li of
 105         LP _       -> retain
 106         LM modnm _ -> if p modnm then retain else dump
 107      where
 108         dump   = filterModuleLinkables p lis
 109         retain = li : dump
 110 \end{code}