-- | Info about modules in the "home" unit
module GHC.Unit.Home.ModInfo
   ( HomeModInfo (..)
   , HomeModLinkable(..)
   , homeModInfoObject
   , homeModInfoByteCode
   , emptyHomeModInfoLinkable
   , justBytecode
   , justObjects
   , bytecodeAndObjects
   , HomePackageTable
   , emptyHomePackageTable
   , lookupHpt
   , eltsHpt
   , concatHpt
   , filterHpt
   , allHpt
   , anyHpt
   , mapHpt
   , delFromHpt
   , addToHpt
   , addHomeModInfoToHpt
   , addListToHpt
   , lookupHptDirectly
   , lookupHptByModule
   , listToHpt
   , listHMIToHpt
   , pprHPT
   )
where

import GHC.Prelude

import GHC.Unit.Module.ModIface
import GHC.Unit.Module.ModDetails
import GHC.Unit.Module

import GHC.Linker.Types ( Linkable(..), linkableIsNativeCodeOnly )

import GHC.Types.Unique
import GHC.Types.Unique.DFM

import GHC.Utils.Outputable
import Data.List (sortOn)
import Data.Ord
import GHC.Utils.Panic

-- | Information about modules in the package being compiled
data HomeModInfo = HomeModInfo
   { HomeModInfo -> ModIface
hm_iface    :: !ModIface
        -- ^ The basic loaded interface file: every loaded module has one of
        -- these, even if it is imported from another package

   , HomeModInfo -> ModDetails
hm_details  :: ModDetails
        -- ^ Extra information that has been created from the 'ModIface' for
        -- the module, typically during typechecking

        -- This field is LAZY because a ModDetails is constructed by knot tying.

   , HomeModInfo -> HomeModLinkable
hm_linkable :: !HomeModLinkable
        -- ^ The actual artifact we would like to link to access things in
        -- this module. See Note [Home module build products]
        --
        -- 'hm_linkable' might be empty:
        --
        --   1. If this is an .hs-boot module
        --
        --   2. Temporarily during compilation if we pruned away
        --      the old linkable because it was out of date.
        --
        -- When re-linking a module ('GHC.Driver.Main.HscNoRecomp'), we construct the
        -- 'HomeModInfo' by building a new 'ModDetails' from the old
        -- 'ModIface' (only).
   }

homeModInfoByteCode :: HomeModInfo -> Maybe Linkable
homeModInfoByteCode :: HomeModInfo -> Maybe Linkable
homeModInfoByteCode = HomeModLinkable -> Maybe Linkable
homeMod_bytecode (HomeModLinkable -> Maybe Linkable)
-> (HomeModInfo -> HomeModLinkable)
-> HomeModInfo
-> Maybe Linkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> HomeModLinkable
hm_linkable

homeModInfoObject :: HomeModInfo -> Maybe Linkable
homeModInfoObject :: HomeModInfo -> Maybe Linkable
homeModInfoObject = HomeModLinkable -> Maybe Linkable
homeMod_object (HomeModLinkable -> Maybe Linkable)
-> (HomeModInfo -> HomeModLinkable)
-> HomeModInfo
-> Maybe Linkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> HomeModLinkable
hm_linkable

emptyHomeModInfoLinkable :: HomeModLinkable
emptyHomeModInfoLinkable :: HomeModLinkable
emptyHomeModInfoLinkable = Maybe Linkable -> Maybe Linkable -> HomeModLinkable
HomeModLinkable Maybe Linkable
forall a. Maybe a
Nothing Maybe Linkable
forall a. Maybe a
Nothing

-- See Note [Home module build products]
data HomeModLinkable = HomeModLinkable { HomeModLinkable -> Maybe Linkable
homeMod_bytecode :: !(Maybe Linkable)
                                       , HomeModLinkable -> Maybe Linkable
homeMod_object   :: !(Maybe Linkable) }

instance Outputable HomeModLinkable where
  ppr :: HomeModLinkable -> SDoc
ppr (HomeModLinkable Maybe Linkable
l1 Maybe Linkable
l2) = Maybe Linkable -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Linkable
l1 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Maybe Linkable -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Linkable
l2

justBytecode :: Linkable -> HomeModLinkable
justBytecode :: Linkable -> HomeModLinkable
justBytecode Linkable
lm =
  Bool -> SDoc -> HomeModLinkable -> HomeModLinkable
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Bool -> Bool
not (Linkable -> Bool
linkableIsNativeCodeOnly Linkable
lm)) (Linkable -> SDoc
forall a. Outputable a => a -> SDoc
ppr Linkable
lm)
   (HomeModLinkable -> HomeModLinkable)
-> HomeModLinkable -> HomeModLinkable
forall a b. (a -> b) -> a -> b
$ HomeModLinkable
emptyHomeModInfoLinkable { homeMod_bytecode = Just lm }

justObjects :: Linkable -> HomeModLinkable
justObjects :: Linkable -> HomeModLinkable
justObjects Linkable
lm =
  Bool -> SDoc -> HomeModLinkable -> HomeModLinkable
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Linkable -> Bool
linkableIsNativeCodeOnly Linkable
lm) (Linkable -> SDoc
forall a. Outputable a => a -> SDoc
ppr Linkable
lm)
   (HomeModLinkable -> HomeModLinkable)
-> HomeModLinkable -> HomeModLinkable
forall a b. (a -> b) -> a -> b
$ HomeModLinkable
emptyHomeModInfoLinkable { homeMod_object = Just lm }

bytecodeAndObjects :: Linkable -> Linkable -> HomeModLinkable
bytecodeAndObjects :: Linkable -> Linkable -> HomeModLinkable
bytecodeAndObjects Linkable
bc Linkable
o =
  Bool -> SDoc -> HomeModLinkable -> HomeModLinkable
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Bool -> Bool
not (Linkable -> Bool
linkableIsNativeCodeOnly Linkable
bc) Bool -> Bool -> Bool
&& Linkable -> Bool
linkableIsNativeCodeOnly Linkable
o) (Linkable -> SDoc
forall a. Outputable a => a -> SDoc
ppr Linkable
bc SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Linkable -> SDoc
forall a. Outputable a => a -> SDoc
ppr Linkable
o)
    (Maybe Linkable -> Maybe Linkable -> HomeModLinkable
HomeModLinkable (Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
bc) (Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just Linkable
o))


{-
Note [Home module build products]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

When compiling a home module we can produce some combination of the following
build products.

1. A byte code linkable, for use with the byte code interpreter.
2. An object file linkable, for linking a final executable or the byte code interpreter

What we have produced is recorded in the `HomeModLinkable` type. In the case
that these linkables are produced they are stored in the relevant field so that
subsequent modules can retrieve and use them as necessary.

* `-fbyte-code` will *only* produce a byte code linkable. This is the default in GHCi.
* `-fobject-code` will *only* produce an object file linkable. This is the default in -c and --make mode.
* `-fbyte-code-and-object-code` produces both a byte-code and object file linkable. So both fields are populated.

Why would you want to produce both an object file and byte code linkable? If you
also want to use `-fprefer-byte-code` then you should probably also use this
flag to make sure that byte code is generated for your modules.

-}

-- | Helps us find information about modules in the home package
type HomePackageTable = DModuleNameEnv HomeModInfo
   -- Domain = modules in the home unit that have been fully compiled
   -- "home" unit id cached (implicit) here for convenience

-- | Constructs an empty HomePackageTable
emptyHomePackageTable :: HomePackageTable
emptyHomePackageTable :: HomePackageTable
emptyHomePackageTable  = HomePackageTable
forall {k} (key :: k) elt. UniqDFM key elt
emptyUDFM

lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt = HomePackageTable -> ModuleName -> Maybe HomeModInfo
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> Maybe elt
lookupUDFM

lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo
lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo
lookupHptDirectly = HomePackageTable -> Unique -> Maybe HomeModInfo
forall {k} (key :: k) elt. UniqDFM key elt -> Unique -> Maybe elt
lookupUDFM_Directly

eltsHpt :: HomePackageTable -> [HomeModInfo]
eltsHpt :: HomePackageTable -> [HomeModInfo]
eltsHpt = HomePackageTable -> [HomeModInfo]
forall {k} (key :: k) elt. UniqDFM key elt -> [elt]
eltsUDFM

-- | Like @concatMap f . 'eltsHpt'@, but filters out all 'HomeModInfo' for which
-- @f@ returns the empty list before doing the sort inherent to 'eltsUDFM'.
concatHpt :: (HomeModInfo -> [a]) -> HomePackageTable -> [a]
concatHpt :: forall a. (HomeModInfo -> [a]) -> HomePackageTable -> [a]
concatHpt HomeModInfo -> [a]
f = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a])
-> (HomePackageTable -> [[a]]) -> HomePackageTable -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqDFM ModuleName [a] -> [[a]]
forall {k} (key :: k) elt. UniqDFM key elt -> [elt]
eltsUDFM (UniqDFM ModuleName [a] -> [[a]])
-> (HomePackageTable -> UniqDFM ModuleName [a])
-> HomePackageTable
-> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HomeModInfo -> Maybe [a])
-> HomePackageTable -> UniqDFM ModuleName [a]
forall {k} elt1 elt2 (key :: k).
(elt1 -> Maybe elt2) -> UniqDFM key elt1 -> UniqDFM key elt2
mapMaybeUDFM HomeModInfo -> Maybe [a]
g
  where
    g :: HomeModInfo -> Maybe [a]
g HomeModInfo
hmi = case HomeModInfo -> [a]
f HomeModInfo
hmi of { [] -> Maybe [a]
forall a. Maybe a
Nothing; [a]
as -> [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
as }

filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
filterHpt = (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
forall {k} elt (key :: k).
(elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt
filterUDFM

allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
allHpt = (HomeModInfo -> Bool) -> HomePackageTable -> Bool
forall {k} elt (key :: k). (elt -> Bool) -> UniqDFM key elt -> Bool
allUDFM

anyHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
anyHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
anyHpt = (HomeModInfo -> Bool) -> HomePackageTable -> Bool
forall {k} elt (key :: k). (elt -> Bool) -> UniqDFM key elt -> Bool
anyUDFM

mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable
mapHpt :: (HomeModInfo -> HomeModInfo)
-> HomePackageTable -> HomePackageTable
mapHpt = (HomeModInfo -> HomeModInfo)
-> HomePackageTable -> HomePackageTable
forall {k} elt1 elt2 (key :: k).
(elt1 -> elt2) -> UniqDFM key elt1 -> UniqDFM key elt2
mapUDFM

delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
delFromHpt = HomePackageTable -> ModuleName -> HomePackageTable
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> UniqDFM key elt
delFromUDFM

addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
addToHpt = HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> elt -> UniqDFM key elt
addToUDFM

addHomeModInfoToHpt :: HomeModInfo -> HomePackageTable -> HomePackageTable
addHomeModInfoToHpt :: HomeModInfo -> HomePackageTable -> HomePackageTable
addHomeModInfoToHpt HomeModInfo
hmi HomePackageTable
hpt = HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
addToHpt HomePackageTable
hpt (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface
hm_iface HomeModInfo
hmi))) HomeModInfo
hmi

addListToHpt
  :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
addListToHpt :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
addListToHpt = HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
forall key elt.
Uniquable key =>
UniqDFM key elt -> [(key, elt)] -> UniqDFM key elt
addListToUDFM

listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
listToHpt = [(ModuleName, HomeModInfo)] -> HomePackageTable
forall key elt. Uniquable key => [(key, elt)] -> UniqDFM key elt
listToUDFM

listHMIToHpt :: [HomeModInfo] -> HomePackageTable
listHMIToHpt :: [HomeModInfo] -> HomePackageTable
listHMIToHpt [HomeModInfo]
hmis =
  [(ModuleName, HomeModInfo)] -> HomePackageTable
listToHpt [(Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface
hm_iface HomeModInfo
hmi)), HomeModInfo
hmi) | HomeModInfo
hmi <- [HomeModInfo]
sorted_hmis]
  where
    -- Sort to put Non-boot things last, so they overwrite the boot interfaces
    -- in the HPT, other than that, the order doesn't matter
    sorted_hmis :: [HomeModInfo]
sorted_hmis = (HomeModInfo -> Down IsBootInterface)
-> [HomeModInfo] -> [HomeModInfo]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (IsBootInterface -> Down IsBootInterface
forall a. a -> Down a
Down (IsBootInterface -> Down IsBootInterface)
-> (HomeModInfo -> IsBootInterface)
-> HomeModInfo
-> Down IsBootInterface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> IsBootInterface
mi_boot (ModIface -> IsBootInterface)
-> (HomeModInfo -> ModIface) -> HomeModInfo -> IsBootInterface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface
hm_iface) [HomeModInfo]
hmis

lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
-- The HPT is indexed by ModuleName, not Module,
-- we must check for a hit on the right Module
lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
lookupHptByModule HomePackageTable
hpt Module
mod
  = case HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt HomePackageTable
hpt (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) of
      Just HomeModInfo
hm | ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface
hm_iface HomeModInfo
hm) Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
mod -> HomeModInfo -> Maybe HomeModInfo
forall a. a -> Maybe a
Just HomeModInfo
hm
      Maybe HomeModInfo
_otherwise                               -> Maybe HomeModInfo
forall a. Maybe a
Nothing

pprHPT :: HomePackageTable -> SDoc
-- A bit arbitrary for now
pprHPT :: HomePackageTable -> SDoc
pprHPT HomePackageTable
hpt = HomePackageTable -> ([HomeModInfo] -> SDoc) -> SDoc
forall {k} (key :: k) a. UniqDFM key a -> ([a] -> SDoc) -> SDoc
pprUDFM HomePackageTable
hpt (([HomeModInfo] -> SDoc) -> SDoc)
-> ([HomeModInfo] -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \[HomeModInfo]
hms ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface
hm_iface HomeModInfo
hm))
         | HomeModInfo
hm <- [HomeModInfo]
hms ]