ghc/compiler/compMan/CmTypes.lhs

   1 %
   2 % (c) The University of Glasgow, 2000
   3 %
   4 \section[CmTypes]{Types for the compilation manager}
   5
   6 \begin{code}
   7 module CmTypes (
   8    Unlinked(..),  isObject, nameOfObject, isInterpretable,
   9    Linkable(..), isObjectLinkable, partitionLinkable,
  10    ModSummary(..), ms_allimps, pprSummaryTime, modSummaryName,
  11   ) where
  12
  13 import Interpreter
  14 import HscTypes
  15 import Module
  16 import Outputable
  17
  18 import Time             ( ClockTime )
  19
  20
  21 data Unlinked
  22    = DotO FilePath
  23    | DotA FilePath
  24    | DotDLL FilePath
  25    | BCOs [UnlinkedBCO] ItblEnv  -- bunch of interpretable bindings, +
  26                                  -- a mapping from DataCons to their itbls
  27
  28 instance Outputable Unlinked where
  29    ppr (DotO path)   = text "DotO" <+> text path
  30    ppr (DotA path)   = text "DotA" <+> text path
  31    ppr (DotDLL path) = text "DotDLL" <+> text path
  32    ppr (BCOs bcos _) = text "BCOs" <+> ppr bcos
  33
  34 isObject (DotO _) = True
  35 isObject (DotA _) = True
  36 isObject (DotDLL _) = True
  37 isObject _ = False
  38
  39 nameOfObject (DotO fn)   = fn
  40 nameOfObject (DotA fn)   = fn
  41 nameOfObject (DotDLL fn) = fn
  42
  43 isInterpretable = not . isObject
  44
  45 data Linkable = LM {
  46   linkableTime     :: ClockTime,
  47   linkableModName  :: ModuleName,       -- should be Module, but see below
  48   linkableUnlinked :: [Unlinked]
  49  }
  50
  51 isObjectLinkable :: Linkable -> Bool
  52 isObjectLinkable l = all isObject (linkableUnlinked l)
  53
  54 -- HACK to support f-x-dynamic in the interpreter; no other purpose
  55 partitionLinkable :: Linkable -> [Linkable]
  56 partitionLinkable li
  57    = let li_uls = linkableUnlinked li
  58          li_uls_obj = filter isObject li_uls
  59          li_uls_bco = filter isInterpretable li_uls
  60      in
  61          case (li_uls_obj, li_uls_bco) of
  62             (objs@(_:_), bcos@(_:_))
  63                -> [li{linkableUnlinked=li_uls_obj}, li{linkableUnlinked=li_uls_bco}]
  64             other
  65                -> [li]
  66
  67 instance Outputable Linkable where
  68    ppr (LM when_made mod unlinkeds)
  69       = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
  70         $$ nest 3 (ppr unlinkeds)
  71
  72 -- The ModuleLocation contains both the original source filename and the
  73 -- filename of the cleaned-up source file after all preprocessing has been
  74 -- done.  The point is that the summariser will have to cpp/unlit/whatever
  75 -- all files anyway, and there's no point in doing this twice -- just
  76 -- park the result in a temp file, put the name of it in the location,
  77 -- and let @compile@ read from that file on the way back up.
  78 data ModSummary
  79    = ModSummary {
  80         ms_mod      :: Module,                  -- name, package
  81         ms_location :: ModuleLocation,          -- location
  82         ms_srcimps  :: [ModuleName],            -- source imports
  83         ms_imps     :: [ModuleName],            -- non-source imports
  84         ms_hs_date  :: ClockTime                -- timestamp of summarised file
  85      }
  86
  87 instance Outputable ModSummary where
  88    ppr ms
  89       = sep [text "ModSummary {",
  90              nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
  91                           text "ms_mod =" <+> ppr (ms_mod ms) <> comma,
  92                           text "ms_imps =" <+> ppr (ms_imps ms),
  93                           text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
  94              char '}'
  95             ]
  96
  97 pprSummaryTime ms
  98    = text "ms_hs_date = " <> parens (text (show (ms_hs_date ms)))
  99
 100 ms_allimps ms
 101    = ms_srcimps ms ++ ms_imps ms
 102
 103 modSummaryName :: ModSummary -> ModuleName
 104 modSummaryName = moduleName . ms_mod
 105 \end{code}