[Git][ghc/ghc][wip/submod-bumps] 10 commits: Comments only: document newtypes' DataConWrapId

Ben Gamari gitlab at gitlab.haskell.org
Tue Jun 11 19:37:39 UTC 2019



Ben Gamari pushed to branch wip/submod-bumps at Glasgow Haskell Compiler / GHC


Commits:
0345b1b0 by Richard Eisenberg at 2019-06-11T03:52:10Z
Comments only: document newtypes' DataConWrapId

- - - - -
58a5d728 by David Eichmann at 2019-06-11T03:52:50Z
Refactor the rules for .hi and .o into a single rule using `&%>` #16764

Currently the rule for .hi files just triggers (via need) the rule
for the .o file, and .o rule generates both the .o and .hi file.
Likewise for .o-boot and .hi-boot files. This is a bit of an abuse
of Shake, and in fact shake supports rules with multiple output
with the &%> function. This exact use case appears in Neil
Mitchell's paper *Shake Before Building* section 6.3.

- - - - -
2f945086 by Ben Gamari at 2019-06-11T03:53:25Z
testsuite: Fix and extend closure_size test

This was previously broken in several ways. This is fixed and it also
now tests arrays. Unfortunately I was unable to find a way to continue
testing PAP and FUN sizes; these simply depend too much upon the
behavior of the simplifier.

I also tried to extend this to test non-empty arrays as well but
unfortunately this was non-trivial as the array card size constant isn't
readily available from haskell.

Fixes #16531.

- - - - -
e5d275f4 by Ben Gamari at 2019-06-11T03:53:25Z
ghc-heap: Add closure_size_noopt test

This adds a new test, only run in the `normal` way, to verify the size
of FUNs and PAPs.

- - - - -
12b6a587 by Ben Gamari at 2019-06-11T19:37:21Z
Bump binary to 0.8.7.0

(cherry picked from commit 983ada70a013c7642a751f6e41587ff95b57d0f8)

- - - - -
9020a981 by Ben Gamari at 2019-06-11T19:37:21Z
Bump Cabal submodule

(cherry picked from commit ff438786613f07df9b2d43eaeac49b13815d849d)

Metric Increase:
    haddock.Cabal

- - - - -
ecb30a83 by Ben Gamari at 2019-06-11T19:37:29Z
Bump time submodule to 1.9.3

(cherry picked from commit fdb07571036b1498800589d45b61781e6acdd368)

- - - - -
1785adfd by Ben Gamari at 2019-06-11T19:37:29Z
Bump terminfo to 0.4.1.4

(cherry picked from commit 1134488b4c9cef904ea82f22f1978646eea612df)

- - - - -
e5c6b4c2 by Ben Gamari at 2019-06-11T19:37:29Z
Bump process submodule to 1.6.5.1

- - - - -
34876db8 by Ben Gamari at 2019-06-11T19:37:29Z
testsuite: Fix fragile_for test modifier

- - - - -


16 changed files:

- compiler/basicTypes/MkId.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Rules/Compile.hs
- libraries/Cabal
- libraries/binary
- + libraries/ghc-heap/tests/ClosureSizeUtils.hs
- libraries/ghc-heap/tests/all.T
- libraries/ghc-heap/tests/closure_size.hs
- + libraries/ghc-heap/tests/closure_size_noopt.hs
- libraries/process
- libraries/terminfo
- libraries/time
- testsuite/driver/testlib.py
- testsuite/tests/driver/T4437.hs
- utils/ghc-cabal/Main.hs
- + utils/ghctags/ghctags.cabal


Changes:

=====================================
compiler/basicTypes/MkId.hs
=====================================
@@ -298,6 +298,24 @@ so the data constructor for T:C had a single argument, namely the
 predicate (C a).  But now we treat that as an ordinary argument, not
 part of the theta-type, so all is well.
 
+Note [Newtype workers]
+~~~~~~~~~~~~~~~~~~~~~~
+A newtype does not really have a worker. Instead, newtype constructors
+just unfold into a cast. But we need *something* for, say, MkAge to refer
+to. So, we do this:
+
+* The Id used as the newtype worker will have a compulsory unfolding to
+  a cast. See Note [Compulsory newtype unfolding]
+
+* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId,
+  as those have special treatment in the back end.
+
+* There is no top-level binding, because the compulsory unfolding
+  means that it will be inlined (to a cast) at every call site.
+
+We probably should have a NewtypeWorkId, but these Ids disappear as soon as
+we desugar anyway, so it seems a step too far.
+
 Note [Compulsory newtype unfolding]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Newtype wrappers, just like workers, have compulsory unfoldings.
@@ -447,6 +465,8 @@ mkDataConWorkId :: Name -> DataCon -> Id
 mkDataConWorkId wkr_name data_con
   | isNewTyCon tycon
   = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info
+      -- See Note [Newtype workers]
+
   | otherwise
   = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info
 


=====================================
hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
=====================================
@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -Wno-deprecations #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Hadrian.Haskell.Cabal.Parse
@@ -17,6 +16,7 @@ module Hadrian.Haskell.Cabal.Parse (
 import Data.Bifunctor
 import Data.List.Extra
 import Development.Shake
+import qualified Distribution.Compat.Graph                     as Graph
 import qualified Distribution.ModuleName                       as C
 import qualified Distribution.Package                          as C
 import qualified Distribution.PackageDescription               as C
@@ -30,6 +30,7 @@ import qualified Distribution.Simple.Utils                     as C
 import qualified Distribution.Simple.Program.Types             as C
 import qualified Distribution.Simple.Configure                 as C (getPersistBuildConfig)
 import qualified Distribution.Simple.Build                     as C
+import qualified Distribution.Types.ComponentLocalBuildInfo    as C
 import qualified Distribution.Types.ComponentRequestedSpec     as C
 import qualified Distribution.InstalledPackageInfo             as Installed
 import qualified Distribution.Simple.PackageIndex              as C
@@ -219,7 +220,7 @@ resolveContextData context at Context {..} = do
 
     -- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations
     -- See: https://github.com/snowleopard/hadrian/issues/548
-    let extDeps      = C.externalPackageDeps lbi'
+    let extDeps      = externalPackageDeps lbi'
         deps         = map (C.display . snd) extDeps
         depDirect    = map (fromMaybe (error "resolveContextData: depDirect failed")
                      . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps
@@ -306,7 +307,20 @@ buildAutogenFiles context = do
 getHookedBuildInfo :: [FilePath] -> IO C.HookedBuildInfo
 getHookedBuildInfo [] = return C.emptyHookedBuildInfo
 getHookedBuildInfo (baseDir:baseDirs) = do
-    maybeInfoFile <- C.findHookedPackageDesc baseDir
+    maybeInfoFile <- C.findHookedPackageDesc C.normal baseDir
     case maybeInfoFile of
         Nothing       -> getHookedBuildInfo baseDirs
         Just infoFile -> C.readHookedBuildInfo C.silent infoFile
+
+externalPackageDeps :: C.LocalBuildInfo -> [(C.UnitId, C.MungedPackageId)]
+externalPackageDeps lbi =
+    -- TODO:  what about non-buildable components?
+    nub [ (ipkgid, pkgid)
+        | clbi            <- Graph.toList (C.componentGraph lbi)
+        , (ipkgid, pkgid) <- C.componentPackageDeps clbi
+        , not (internal ipkgid) ]
+  where
+    -- True if this dependency is an internal one (depends on the library
+    -- defined in the same package).
+    internal ipkgid = any ((==ipkgid) . C.componentUnitId) (Graph.toList (C.componentGraph lbi))
+


=====================================
hadrian/src/Rules/Compile.hs
=====================================
@@ -4,7 +4,7 @@ import Hadrian.BuildPath
 import Hadrian.Oracles.TextFile
 
 import Base
-import Context
+import Context as C
 import Expression
 import Rules.Generate
 import Settings
@@ -30,16 +30,29 @@ compilePackage rs = do
     --
     -- and parse the information we need (stage, package path, ...) from
     -- the path and figure out the suitable way to produce that object file.
-    objectFilesUnder root |%> \path -> do
-        obj <- parsePath (parseBuildObject root) "<object file path parser>" path
-        compileObject rs path obj
+    alternatives $ do
+      -- Language is identified by subdirectory under /build.
+      -- These are non-haskell files so only have a .o or .<way>_o suffix.
+      [ root -/- "**/build/c/**/*." ++ wayPat ++ "o"
+        | wayPat <- wayPats] |%> compileNonHsObject rs C
+
+      [ root -/- "**/build/cmm/**/*." ++ wayPat ++ "o"
+        | wayPat <- wayPats] |%> compileNonHsObject rs Cmm
+
+      [ root -/- "**/build/s/**/*." ++ wayPat ++ "o"
+        | wayPat <- wayPats] |%> compileNonHsObject rs Asm
+
+      -- All else is haskell.
+      -- This comes last as it overlaps with the above rules' file patterns.
+      forM_ ((,) <$> hsExts <*> wayPats) $ \ ((oExt, hiExt), wayPat) ->
+        [ root -/- "**/build/**/*." ++ wayPat ++ oExt
+        , root -/- "**/build/**/*." ++ wayPat ++ hiExt ]
+          &%> \ [o, _hi] -> compileHsObjectAndHi rs o
   where
-    objectFilesUnder r = [ r -/- ("**/build/**/*" ++ pat)
-                         | pat <- extensionPats ]
-
-    exts = [ "o", "hi", "o-boot", "hi-boot" ]
-    patternsFor e = [ "." ++ e, ".*_" ++ e ]
-    extensionPats = concatMap patternsFor exts
+    hsExts = [ ("o", "hi")
+             , ("o-boot", "hi-boot")
+             ]
+    wayPats = [ "", "*_" ]
 
 -- * Object file paths types and parsers
 
@@ -153,67 +166,47 @@ objectContext (BuildPath _ stage pkgPath obj) =
 
 -- * Building an object
 
-compileHsObject
-    :: [(Resource, Int)] -> FilePath -> BuildPath Object -> HsObject -> Action ()
-compileHsObject rs objpath b@(BuildPath _root stage _path _o) hsobj =
-  case hsobj of
-    HsObject _basename (Extension way Hi    ) -> need [objpath -<.> osuf     way]
-    HsObject _basename (Extension way HiBoot) -> need [objpath -<.> obootsuf way]
-    HsObject _basename (Extension way suf) -> do
-        let ctx = objectContext b
-        ctxPath <- contextPath ctx
-        (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
-        need (src:deps)
-        needLibrary =<< contextDependencies ctx
-
-        -- The .dependencies files only lists shallow dependencies. ghc will
-        -- generally read more *.hi and *.hi-boot files (deep dependencies).
-        -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#cloud-shared-cache-build)
-        -- Note that this may allow too many *.hi and *.hi-boot files, but
-        -- calculating the exact set of deep dependencies is not feasible.
-        trackAllow [ "//*." ++ hisuf     way
-                   , "//*." ++ hibootsuf way
-                   ]
-
-        buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]
-        -- Andrey: It appears that the previous refactoring has broken
-        -- multiple-output build rules. Ideally, we should bring multiple-output
-        -- rules back, see: https://github.com/snowleopard/hadrian/issues/216.
-        -- As a temporary solution, I'm using Shake's new 'produces' feature to
-        -- record that this rule also produces a corresponding interface file.
-        let hi | suf == O     = objpath -<.> hisuf     way
-               | suf == OBoot = objpath -<.> hibootsuf way
-               | otherwise    = error "Internal error: unknown Haskell object extension"
-        produces [hi]
-
-compileNonHsObject
-  :: [(Resource, Int)] -> FilePath -> BuildPath Object -> NonHsObject
-  -> Action ()
-compileNonHsObject rs objpath b@(BuildPath _root stage _path _o) nonhsobj =
-  case nonhsobj of
-    NonHsObject lang _basename _way ->
-      go (builderFor lang) (toSrcFor lang)
-
-  where builderFor C = Ghc CompileCWithGhc
-        builderFor _ = Ghc CompileHs
-
-        toSrcFor Asm = obj2src "S"   (const False)
-        toSrcFor C   = obj2src "c"   (const False)
-        toSrcFor Cmm = obj2src "cmm" isGeneratedCmmFile
-
-        go builder tosrc = do
-            let ctx = objectContext b
-            src <- tosrc ctx objpath
-            need [src]
-            needDependencies ctx src (objpath <.> "d")
-            buildWithResources rs $ target ctx (builder stage) [src] [objpath]
-
-compileObject
-  :: [(Resource, Int)] -> FilePath -> BuildPath Object -> Action ()
-compileObject rs objpath b@(BuildPath _root _stage _path (Hs o)) =
-  compileHsObject rs objpath b o
-compileObject rs objpath b@(BuildPath _root _stage _path (NonHs o)) =
-  compileNonHsObject rs objpath b o
+compileHsObjectAndHi
+    :: [(Resource, Int)] -> FilePath -> Action ()
+compileHsObjectAndHi rs objpath = do
+  root <- buildRoot
+  b@(BuildPath _root stage _path _o)
+    <- parsePath (parseBuildObject root) "<object file path parser>" objpath
+  let ctx = objectContext b
+      way = C.way ctx
+  ctxPath <- contextPath ctx
+  (src, deps) <- lookupDependencies (ctxPath -/- ".dependencies") objpath
+  need (src:deps)
+  needLibrary =<< contextDependencies ctx
+
+  -- The .dependencies file lists indicating inputs. ghc will
+  -- generally read more *.hi and *.hi-boot files (direct inputs).
+  -- Allow such reads (see https://gitlab.haskell.org/ghc/ghc/wikis/Developing-Hadrian#haskell-object-files-and-hi-inputs)
+  -- Note that this may allow too many *.hi and *.hi-boot files, but
+  -- calculating the exact set of direct inputs is not feasible.
+  trackAllow [ "//*." ++ hisuf     way
+             , "//*." ++ hibootsuf way
+             ]
+
+  buildWithResources rs $ target ctx (Ghc CompileHs stage) [src] [objpath]
+
+compileNonHsObject :: [(Resource, Int)] -> SourceLang -> FilePath -> Action ()
+compileNonHsObject rs lang path = do
+  root <- buildRoot
+  b@(BuildPath _root stage _path _o)
+    <- parsePath (parseBuildObject root) "<object file path parser>" path
+  let
+    ctx = objectContext b
+    builder = case lang of
+      C -> Ghc CompileCWithGhc
+      _ -> Ghc CompileHs
+  src <- case lang of
+      Asm -> obj2src "S"   (const False)      ctx path
+      C   -> obj2src "c"   (const False)      ctx path
+      Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path
+  need [src]
+  needDependencies ctx src (path <.> "d")
+  buildWithResources rs $ target ctx (builder stage) [src] [path]
 
 -- * Helpers
 


=====================================
libraries/Cabal
=====================================
@@ -1 +1 @@
-Subproject commit 5d258537b754005d2a1d170b44d764b63ff4fc75
+Subproject commit f697d3209990c3314efe840be54fb7c5a967e6ff


=====================================
libraries/binary
=====================================
@@ -1 +1 @@
-Subproject commit 94855814e2e4f7a0f191ffa5b4c98ee0147e3174
+Subproject commit fcd9d3cb2a942c54347d28bcb80a1b46d2d7d673


=====================================
libraries/ghc-heap/tests/ClosureSizeUtils.hs
=====================================
@@ -0,0 +1,52 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Utilities for the @closure_size@ tests
+module ClosureSizeUtils (assertSize, assertSizeUnlifted) where
+
+import Control.Monad
+import GHC.Exts
+import GHC.Exts.Heap.Closures
+import GHC.Stack
+import Type.Reflection
+
+profHeaderSize :: Int
+#if PROFILING
+profHeaderSize = 2
+#else
+profHeaderSize = 0
+#endif
+
+assertSize
+  :: forall a. (HasCallStack, Typeable a)
+  => a     -- ^ closure
+  -> Int   -- ^ expected size in words
+  -> IO ()
+assertSize x =
+  assertSizeBox (asBox x) (typeRep @a)
+
+assertSizeUnlifted
+  :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a)
+  => a     -- ^ closure
+  -> Int   -- ^ expected size in words
+  -> IO ()
+assertSizeUnlifted x =
+  assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a)
+
+assertSizeBox
+  :: forall a. (HasCallStack)
+  => Box   -- ^ closure
+  -> TypeRep a
+  -> Int   -- ^ expected size in words
+  -> IO ()
+assertSizeBox x ty expected = do
+  let !size = closureSize x
+  when (size /= expected') $ do
+    putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected'
+    putStrLn $ prettyCallStack callStack
+  where expected' = expected + profHeaderSize
+{-# NOINLINE assertSize #-}


=====================================
libraries/ghc-heap/tests/all.T
=====================================
@@ -1,11 +1,26 @@
 test('heap_all',
-     [when(have_profiling(),
-      extra_ways(['prof'])),
+     [when(have_profiling(), extra_ways(['prof'])),
       # These ways produce slightly different heap representations.
       # Currently we don't test them.
       omit_ways(['ghci', 'hpc'])
      ],
      compile_and_run, [''])
+
+# Test everything except FUNs and PAPs in all ways.
 test('closure_size',
-     omit_ways(['ghci', 'hpc', 'prof']),
+     [extra_files(['ClosureSizeUtils.hs']),
+      when(have_profiling(), extra_ways(['prof'])),
+      # These ways produce slightly different heap representations.
+      # Currently we don't test them.
+      omit_ways(['hpc'])
+     ],
+     compile_and_run, [''])
+
+# Test PAPs and FUNs only in normal way (e.g. with -O0)
+# since otherwise the simplifier interferes.
+test('closure_size_noopt',
+     [extra_files(['ClosureSizeUtils.hs']),
+      only_ways(['normal'])
+     ],
      compile_and_run, [''])
+


=====================================
libraries/ghc-heap/tests/closure_size.hs
=====================================
@@ -1,25 +1,20 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE TypeInType #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-import Control.Monad
-import Type.Reflection
-import GHC.Stack
+import GHC.Exts
+import GHC.IO
+import ClosureSizeUtils
 
-import GHC.Exts.Heap.Closures
+data A = A (Array# Int)
+data MA = MA (MutableArray# RealWorld Int)
+data BA = BA ByteArray#
+data MBA = MBA (MutableByteArray# RealWorld)
+data B = B BCO#
+data APC a = APC a
 
-assertSize :: forall a. (HasCallStack, Typeable a)
-           => a -> Int -> IO ()
-assertSize !x expected = do
-  let !size = closureSize (asBox x)
-  when (size /= expected) $ do
-    putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected
-    putStrLn $ prettyCallStack callStack
-{-# NOINLINE assertSize #-}
-
-pap :: Int -> Char -> Int
-pap x _ = x
-{-# NOINLINE pap #-}
 
 main :: IO ()
 main = do
@@ -28,7 +23,26 @@ main = do
   assertSize (Nothing :: Maybe ()) 2
   assertSize ((1,2) :: (Int,Int)) 3
   assertSize ((1,2,3) :: (Int,Int,Int)) 4
-  assertSize (id :: Int -> Int) 1
-  assertSize (fst :: (Int,Int) -> Int) 1
-  assertSize (pap 1) 2
 
+  MA ma <- IO $ \s ->
+      case newArray# 0# 0 s of
+          (# s1, x #) -> (# s1, MA x #)
+
+  A a <- IO $ \s ->
+      case freezeArray# ma 0# 0# s of
+          (# s1, x #) -> (# s1, A x #)
+
+  MBA mba <- IO $ \s ->
+      case newByteArray# 0# s of
+          (# s1, x #) -> (# s1, MBA x #)
+
+  BA ba <- IO $ \s ->
+      case newByteArray# 0# s of
+          (# s1, x #) ->
+              case unsafeFreezeByteArray# x s1 of
+                  (# s2, y #) -> (# s2, BA y #)
+
+  assertSizeUnlifted ma 3
+  assertSizeUnlifted a 3
+  assertSizeUnlifted mba 2
+  assertSizeUnlifted ba 2


=====================================
libraries/ghc-heap/tests/closure_size_noopt.hs
=====================================
@@ -0,0 +1,12 @@
+import ClosureSizeUtils
+
+pap :: Int -> Char -> Int
+pap x _ = x
+{-# NOINLINE pap #-}
+
+main :: IO ()
+main = do
+  assertSize (id :: Int -> Int) 1
+  assertSize (fst :: (Int,Int) -> Int) 1
+  assertSize (pap 1) 2
+


=====================================
libraries/process
=====================================
@@ -1 +1 @@
-Subproject commit d860209e53c1b40b7c251fc8378886bbcb394402
+Subproject commit 09446a522f5c8ec5a5c32c7494bc1704e107776e


=====================================
libraries/terminfo
=====================================
@@ -1 +1 @@
-Subproject commit 7049b2625a490feda9bcb201a5a811d790f06cd0
+Subproject commit 6065302a4f75649f14397833766e82c8182935bf


=====================================
libraries/time
=====================================
@@ -1 +1 @@
-Subproject commit 9e96c26132fef01a3113c8b152b1be96c0eccd86
+Subproject commit 5319bed3b14c21de5410ead88ec8aaa838d7339c


=====================================
testsuite/driver/testlib.py
=====================================
@@ -257,14 +257,14 @@ def fragile( bug ):
 
     return helper
 
-def fragile_for( name, opts, bug, ways ):
+def fragile_for( bug, ways ):
     """
     Indicates that the test should be skipped due to fragility in the given
     test ways as documented in the given ticket.
     """
     def helper( name, opts, bug=bug, ways=ways ):
         record_broken(name, opts, bug)
-        opts.omit_ways = ways
+        opts.omit_ways += ways
 
     return helper
 
@@ -274,7 +274,7 @@ def omit_ways( ways ):
     return lambda name, opts, w=ways: _omit_ways( name, opts, w )
 
 def _omit_ways( name, opts, ways ):
-    opts.omit_ways = ways
+    opts.omit_ways += ways
 
 # -----
 


=====================================
testsuite/tests/driver/T4437.hs
=====================================
@@ -39,8 +39,6 @@ expectedGhcOnlyExtensions :: [String]
 expectedGhcOnlyExtensions = ["RelaxedLayout",
                              "AlternativeLayoutRule",
                              "AlternativeLayoutRuleTransitional",
-                             "EmptyDataDeriving",
-                             "GeneralisedNewtypeDeriving",
                              "CUSKs",
                              "ImportQualifiedPost"]
 


=====================================
utils/ghc-cabal/Main.hs
=====================================
@@ -19,8 +19,10 @@ import Distribution.Simple.Utils (defaultPackageDesc, findHookedPackageDesc, wri
                                   toUTF8LBS)
 import Distribution.Simple.Build (writeAutogenFiles)
 import Distribution.Simple.Register
+import qualified Distribution.Compat.Graph as Graph
 import Distribution.Text
 import Distribution.Types.MungedPackageId
+import Distribution.Types.LocalBuildInfo
 import Distribution.Verbosity
 import qualified Distribution.InstalledPackageInfo as Installed
 import qualified Distribution.Simple.PackageIndex as PackageIndex
@@ -251,6 +253,18 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts
           htmldir   = toPathTemplate "$docdir"
       }
 
+externalPackageDeps :: LocalBuildInfo -> [(UnitId, MungedPackageId)]
+externalPackageDeps lbi =
+    -- TODO:  what about non-buildable components?
+    nub [ (ipkgid, pkgid)
+        | clbi            <- Graph.toList (componentGraph lbi)
+        , (ipkgid, pkgid) <- componentPackageDeps clbi
+        , not (internal ipkgid) ]
+  where
+    -- True if this dependency is an internal one (depends on the library
+    -- defined in the same package).
+    internal ipkgid = any ((==ipkgid) . componentUnitId) (Graph.toList (componentGraph lbi))
+
 generate :: FilePath -> FilePath -> [String] -> IO ()
 generate directory distdir config_args
  = withCurrentDirectory directory
@@ -274,8 +288,8 @@ generate directory distdir config_args
               -- cabal 2.2+ will expect it, but fallback to the old default
               -- location if we don't find any.  This is the case of the
               -- bindist, which doesn't ship the $dist/build folder.
-              maybe_infoFile <- findHookedPackageDesc (cwd </> distdir </> "build")
-                                <|> defaultHookedPackageDesc
+              maybe_infoFile <- findHookedPackageDesc verbosity (cwd </> distdir </> "build")
+                                <|> fmap Just (defaultPackageDesc verbosity)
               case maybe_infoFile of
                   Nothing       -> return emptyHookedBuildInfo
                   Just infoFile -> readHookedBuildInfo verbosity infoFile
@@ -307,8 +321,9 @@ generate directory distdir config_args
 
       let
           comp = compiler lbi
-          libBiModules lib = (libBuildInfo lib, libModules lib)
+          libBiModules lib = (libBuildInfo lib, foldMap (allLibModules lib) (componentNameCLBIs lbi $ CLibName defaultLibName))
           exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)
+          biModuless :: [(BuildInfo, [ModuleName.ModuleName])]
           biModuless = (map libBiModules . maybeToList $ library pd)
                     ++ (map exeBiModules $ executables pd)
           buildableBiModuless = filter isBuildable biModuless


=====================================
utils/ghctags/ghctags.cabal
=====================================
@@ -0,0 +1,23 @@
+Name: ghctags
+Version: 0.1
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: A simple generator of vi- and emacs-compatible TAGS files.
+Description: XXX
+Category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+Executable ghctags
+    Default-Language: Haskell2010
+
+    Main-Is: Main.hs
+
+    Build-Depends: base       >= 4   && < 5,
+                   containers,
+                   Cabal      >= 3.0 && <3.1,
+                   ghc
+



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7124b7152a6fdc4a7a91a21ba20a0e7c0656fde2...34876db83aab33fafcce4922f80aab5bb0d8bc1a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/7124b7152a6fdc4a7a91a21ba20a0e7c0656fde2...34876db83aab33fafcce4922f80aab5bb0d8bc1a
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190611/623e286c/attachment-0001.html>


More information about the ghc-commits mailing list