1-- | Dependencies and Usage of a module
2module GHC.Unit.Module.Deps
3   ( Dependencies (..)
4   , Usage (..)
5   , noDependencies
6   )
7where
8
9import GHC.Prelude
10
11import GHC.Types.SafeHaskell
12import GHC.Types.Name
13import GHC.Unit.Module.Name
14import GHC.Unit.Module
15
16import GHC.Utils.Fingerprint
17import GHC.Utils.Binary
18
19-- | Dependency information about ALL modules and packages below this one
20-- in the import hierarchy.
21--
22-- Invariant: the dependencies of a module @M@ never includes @M@.
23--
24-- Invariant: none of the lists contain duplicates.
25data Dependencies = Deps
26   { dep_mods   :: [ModuleNameWithIsBoot]
27      -- ^ All home-package modules transitively below this one
28      -- I.e. modules that this one imports, or that are in the
29      --      dep_mods of those directly-imported modules
30
31   , dep_pkgs   :: [(UnitId, Bool)]
32      -- ^ All packages transitively below this module
33      -- I.e. packages to which this module's direct imports belong,
34      --      or that are in the dep_pkgs of those modules
35      -- The bool indicates if the package is required to be
36      -- trusted when the module is imported as a safe import
37      -- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names
38
39   , dep_orphs  :: [Module]
40      -- ^ Transitive closure of orphan modules (whether
41      -- home or external pkg).
42      --
43      -- (Possible optimization: don't include family
44      -- instance orphans as they are anyway included in
45      -- 'dep_finsts'.  But then be careful about code
46      -- which relies on dep_orphs having the complete list!)
47      -- This does NOT include us, unlike 'imp_orphs'.
48
49   , dep_finsts :: [Module]
50      -- ^ Transitive closure of depended upon modules which
51      -- contain family instances (whether home or external).
52      -- This is used by 'checkFamInstConsistency'.  This
53      -- does NOT include us, unlike 'imp_finsts'. See Note
54      -- [The type family instance consistency story].
55
56   , dep_plgins :: [ModuleName]
57      -- ^ All the plugins used while compiling this module.
58   }
59   deriving( Eq )
60        -- Equality used only for old/new comparison in GHC.Iface.Recomp.addFingerprints
61        -- See 'GHC.Tc.Utils.ImportAvails' for details on dependencies.
62
63instance Binary Dependencies where
64    put_ bh deps = do put_ bh (dep_mods deps)
65                      put_ bh (dep_pkgs deps)
66                      put_ bh (dep_orphs deps)
67                      put_ bh (dep_finsts deps)
68                      put_ bh (dep_plgins deps)
69
70    get bh = do ms <- get bh
71                ps <- get bh
72                os <- get bh
73                fis <- get bh
74                pl <- get bh
75                return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
76                               dep_finsts = fis, dep_plgins = pl })
77
78noDependencies :: Dependencies
79noDependencies = Deps [] [] [] [] []
80
81-- | Records modules for which changes may force recompilation of this module
82-- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance
83--
84-- This differs from Dependencies.  A module X may be in the dep_mods of this
85-- module (via an import chain) but if we don't use anything from X it won't
86-- appear in our Usage
87data Usage
88  -- | Module from another package
89  = UsagePackageModule {
90        usg_mod      :: Module,
91           -- ^ External package module depended on
92        usg_mod_hash :: Fingerprint,
93            -- ^ Cached module fingerprint
94        usg_safe :: IsSafeImport
95            -- ^ Was this module imported as a safe import
96    }
97  -- | Module from the current package
98  | UsageHomeModule {
99        usg_mod_name :: ModuleName,
100            -- ^ Name of the module
101        usg_mod_hash :: Fingerprint,
102            -- ^ Cached module fingerprint
103        usg_entities :: [(OccName,Fingerprint)],
104            -- ^ Entities we depend on, sorted by occurrence name and fingerprinted.
105            -- NB: usages are for parent names only, e.g. type constructors
106            -- but not the associated data constructors.
107        usg_exports  :: Maybe Fingerprint,
108            -- ^ Fingerprint for the export list of this module,
109            -- if we directly imported it (and hence we depend on its export list)
110        usg_safe :: IsSafeImport
111            -- ^ Was this module imported as a safe import
112    }                                           -- ^ Module from the current package
113  -- | A file upon which the module depends, e.g. a CPP #include, or using TH's
114  -- 'addDependentFile'
115  | UsageFile {
116        usg_file_path  :: FilePath,
117        -- ^ External file dependency. From a CPP #include or TH
118        -- addDependentFile. Should be absolute.
119        usg_file_hash  :: Fingerprint
120        -- ^ 'Fingerprint' of the file contents.
121
122        -- Note: We don't consider things like modification timestamps
123        -- here, because there's no reason to recompile if the actual
124        -- contents don't change.  This previously lead to odd
125        -- recompilation behaviors; see #8114
126  }
127  -- | A requirement which was merged into this one.
128  | UsageMergedRequirement {
129        usg_mod :: Module,
130        usg_mod_hash :: Fingerprint
131  }
132    deriving( Eq )
133        -- The export list field is (Just v) if we depend on the export list:
134        --      i.e. we imported the module directly, whether or not we
135        --           enumerated the things we imported, or just imported
136        --           everything
137        -- We need to recompile if M's exports change, because
138        -- if the import was    import M,       we might now have a name clash
139        --                                      in the importing module.
140        -- if the import was    import M(x)     M might no longer export x
141        -- The only way we don't depend on the export list is if we have
142        --                      import M()
143        -- And of course, for modules that aren't imported directly we don't
144        -- depend on their export lists
145
146instance Binary Usage where
147    put_ bh usg@UsagePackageModule{} = do
148        putByte bh 0
149        put_ bh (usg_mod usg)
150        put_ bh (usg_mod_hash usg)
151        put_ bh (usg_safe     usg)
152
153    put_ bh usg@UsageHomeModule{} = do
154        putByte bh 1
155        put_ bh (usg_mod_name usg)
156        put_ bh (usg_mod_hash usg)
157        put_ bh (usg_exports  usg)
158        put_ bh (usg_entities usg)
159        put_ bh (usg_safe     usg)
160
161    put_ bh usg@UsageFile{} = do
162        putByte bh 2
163        put_ bh (usg_file_path usg)
164        put_ bh (usg_file_hash usg)
165
166    put_ bh usg@UsageMergedRequirement{} = do
167        putByte bh 3
168        put_ bh (usg_mod      usg)
169        put_ bh (usg_mod_hash usg)
170
171    get bh = do
172        h <- getByte bh
173        case h of
174          0 -> do
175            nm    <- get bh
176            mod   <- get bh
177            safe  <- get bh
178            return UsagePackageModule { usg_mod = nm, usg_mod_hash = mod, usg_safe = safe }
179          1 -> do
180            nm    <- get bh
181            mod   <- get bh
182            exps  <- get bh
183            ents  <- get bh
184            safe  <- get bh
185            return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod,
186                     usg_exports = exps, usg_entities = ents, usg_safe = safe }
187          2 -> do
188            fp   <- get bh
189            hash <- get bh
190            return UsageFile { usg_file_path = fp, usg_file_hash = hash }
191          3 -> do
192            mod <- get bh
193            hash <- get bh
194            return UsageMergedRequirement { usg_mod = mod, usg_mod_hash = hash }
195          i -> error ("Binary.get(Usage): " ++ show i)
196