Commit e815c5f5 authored by Andrey Mokhov's avatar Andrey Mokhov

Fix overlapping build rules and generalise the pattern

See #391
parent 4fca3ae5
......@@ -25,7 +25,7 @@ module Hadrian.Utilities (
renderUnicorn,
-- * Miscellaneous
(<&>),
(<&>), (%%>),
-- * Useful re-exports
Dynamic, fromDynamic, toDyn, TypeRep, typeOf
......@@ -116,6 +116,15 @@ a -/- b
infixr 6 -/-
-- | Like Shake's '%>' but gives higher priority to longer patterns. Useful
-- in situations when a family of build rules, e.g. @"//*.a"@ and @"//*_p.a"@
-- can be matched by the same file, such as @library_p.a@. We break the tie
-- by preferring longer matches, which correpond to longer patterns.
(%%>) :: FilePattern -> (FilePath -> Action ()) -> Rules ()
p %%> a = priority (fromIntegral (length p) + 1) $ p %> a
infix 1 %%>
-- | Insert a value into Shake's type-indexed map.
insertExtra :: Typeable a => a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
insertExtra value = Map.insert (typeOf value) (toDyn value)
......
......@@ -53,7 +53,7 @@ buildDynamicLib context@Context{..} = do
buildPackageLibrary :: Context -> Rules ()
buildPackageLibrary context@Context {..} = do
let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgNameString package
libPrefix ++ "*" ++ (waySuffix way <.> "a") %> \a -> do
libPrefix ++ "*" ++ (waySuffix way <.> "a") %%> \a -> do
objs <- libraryObjects context
asuf <- libsuf way
let isLib0 = ("//*-0" ++ asuf) ?== a
......
......@@ -15,17 +15,15 @@ registerPackage rs context@Context {..} = do
-- Packages @ghc-boot@ and @ghc-boot-th@ both match the @ghc-boot*@
-- pattern, therefore we need to use priorities to match the right rule.
-- TODO: Get rid of this hack.
priority (fromIntegral . length $ pkgNameString package) $
"//" ++ stage0PackageDbDir -/- pkgNameString package ++ "*.conf" %>
buildConf rs context
"//" ++ stage0PackageDbDir -/- pkgNameString package ++ "*.conf" %%>
buildConf rs context
when (package == ghc) $ "//" ++ stage0PackageDbDir -/- packageDbStamp %>
buildStamp rs context
when (stage == Stage1) $ do
priority (fromIntegral . length $ pkgNameString package) $
inplacePackageDbPath -/- pkgNameString package ++ "*.conf" %>
buildConf rs context
inplacePackageDbPath -/- pkgNameString package ++ "*.conf" %%>
buildConf rs context
when (package == ghc) $ inplacePackageDbPath -/- packageDbStamp %>
buildStamp rs context
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment