2 Hake: a meta build system for Barrelfish
4 Copyright (c) 2009, 2015, ETH Zurich.
7 This file is distributed under the terms in the attached LICENSE file.
8 If you do not find this file, copies can be found by writing to:
9 ETH Zurich D-INFK, Universitätstasse 6, CH-8092 Zurich. Attn: Systems Group.
12 -- Asynchronous IO for walking directories
13 import Control.Concurrent.Async
15 import Control.Monad.Error
20 import qualified Data.Set as S
22 import System.Directory
23 import System.Environment
25 import System.FilePath
28 -- The GHC API. We use the mtl-compatible version in order to use liftIO
29 -- within the GHC monad.
30 import GHC hiding (Target, Ghc, runGhc, FunBind, Match)
31 import GHC.Paths (libdir)
32 import Control.Monad.Ghc
33 import DynFlags (defaultFatalMessager, defaultFlushOut,
34 xopt_set, ExtensionFlag(Opt_DeriveDataTypeable,
35 Opt_StandaloneDeriving))
37 -- We parse and pretty-print Hakefiles.
38 import Language.Haskell.Exts
44 import qualified Config
47 data HakeError = HakeError String Int
48 instance Error HakeError
49 type HakeMonad = ErrorT HakeError IO
52 -- Command line options and parsing code
54 data Opts = Opts { opt_makefilename :: String,
55 opt_installdir :: String,
56 opt_sourcedir :: String,
57 opt_bfsourcedir :: String,
58 opt_abs_installdir :: String,
59 opt_abs_sourcedir :: String,
60 opt_abs_bfsourcedir :: String,
61 opt_usage_error :: Bool,
62 opt_architectures :: [String],
63 opt_verbosity :: Integer
67 parse_arguments :: [String] -> Opts
69 Opts { opt_makefilename = "Makefile",
70 opt_installdir = Config.install_dir,
71 opt_sourcedir = Config.source_dir,
72 opt_bfsourcedir = Config.source_dir,
73 opt_abs_installdir = "",
74 opt_abs_sourcedir = "",
75 opt_abs_bfsourcedir = "",
76 opt_usage_error = False,
77 opt_architectures = [],
79 parse_arguments ("--install-dir" : (s : t)) =
80 (parse_arguments t) { opt_installdir = s }
81 parse_arguments ("--source-dir" : s : t) =
82 (parse_arguments t) { opt_sourcedir = s }
83 parse_arguments ("--bfsource-dir" : s : t) =
84 (parse_arguments t) { opt_bfsourcedir = s }
85 parse_arguments ("--output-filename" : s : t) =
86 (parse_arguments t) { opt_makefilename = s }
87 parse_arguments ("--quiet" : t ) =
88 (parse_arguments t) { opt_verbosity = 0 }
89 parse_arguments ("--verbose" : t ) =
90 (parse_arguments t) { opt_verbosity = 2 }
91 parse_arguments ("--architecture" : a : t ) =
93 o2 = parse_arguments t
94 arches = (a : opt_architectures o2)
96 o2 { opt_architectures = arches }
98 (parse_arguments []) { opt_usage_error = True }
101 usage = unlines [ "Usage: hake <options>",
102 " --source-dir <dir> (required)",
103 " --bfsource-dir <dir> (defaults to source dir)",
104 " --install-dir <dir> (defaults to source dir)",
109 -- Check the configuration options, returning an error string if they're
111 configErrors :: Maybe String
113 | unknownArchs /= [] =
114 Just ("unknown architecture(s) specified: " ++
115 (concat $ intersperse ", " unknownArchs))
116 | Config.architectures == [] =
117 Just "no architectures defined"
118 | Config.lazy_thc && not Config.use_fp =
119 Just "Config.use_fp must be true to use Config.lazy_thc."
123 unknownArchs = Config.architectures \\ Args.allArchitectures
125 -- Walk the source tree and build a complete list of pathnames, loading any
127 listFiles :: FilePath -> IO ([FilePath], [(FilePath, String)])
128 listFiles root = listFiles' root root
130 listFiles' :: FilePath -> FilePath -> IO ([FilePath], [(FilePath, String)])
131 listFiles' root current
132 | ignore (takeFileName current) = return ([], [])
134 isdir <- doesDirectoryExist current
136 children <- getDirectoryContents current
137 walkchildren children
139 hake <- maybeHake current
140 return ([makeRelative root current], hake)
142 -- Walk the child directories in parallel. This speeds things up
143 -- dramatically over NFS, with its high latency.
144 walkchildren :: [FilePath] -> IO ([FilePath], [(FilePath, String)])
145 walkchildren children = do
146 children_async <- mapM (async.walkchild) children
147 results <- mapM wait children_async
148 return $ joinResults results
150 joinResults :: [([a],[b])] -> ([a],[b])
151 joinResults [] = ([],[])
152 joinResults ((as,bs):xs) =
153 let (as',bs') = joinResults xs in
154 (as ++ as', bs ++ bs')
156 walkchild :: FilePath -> IO ([FilePath], [(FilePath, String)])
157 walkchild child = listFiles' root (current </> child)
159 -- Load Hakfiles eagerly. This amounts to <1MB for Barrelfish (2015).
161 | takeFileName path == "Hakefile" = do
162 contents <- readFile path
163 return [(path, contents)]
164 | otherwise = return []
166 -- Don't descend into revision-control or build directories.
167 ignore :: FilePath -> Bool
170 ignore "CMakeFiles" = True
173 ignore "build" = True
177 -- Hake parsing using the GHC API
180 -- We invoke GHC to parse the Hakefiles in a preconfigured environment,
181 -- to implement the Hake DSL.
182 evalHakeFiles :: Handle -> Opts -> TreeDB -> [(FilePath, String)] ->
184 evalHakeFiles makefile o srcDB hakefiles =
185 defaultErrorHandler defaultFatalMessager defaultFlushOut $
186 runGhc (Just libdir) $
187 driveGhc makefile o srcDB hakefiles
189 -- This is the code that executes in the GHC monad.
190 driveGhc :: Handle -> Opts -> TreeDB -> [(FilePath, String)] ->
192 driveGhc makefile o srcDB hakefiles = do
194 dflags <- getSessionDynFlags
195 let dflags' = foldl xopt_set dflags [ Opt_DeriveDataTypeable,
196 Opt_StandaloneDeriving ]
197 _ <- setSessionDynFlags dflags'{
198 importPaths = module_paths,
199 hiDir = Just "./hake",
200 objectDir = Just "./hake"
203 -- Set compilation targets i.e. everything that needs to be built from
205 targets <- mapM (\m -> guessTarget m Nothing) source_modules
209 -- Import both system and Hake modules.
211 ([IIDecl $ simpleImportDecl $ mkModuleName m |
213 [IIDecl $ (simpleImportDecl $ mkModuleName m) {
214 ideclQualified = True
215 } | m <- qualified_modules])
217 -- Emit Makefile sections corresponding to Hakefiles
218 buildSections hakefiles
221 module_paths = [ (opt_installdir o) </> "hake", ".",
222 (opt_bfsourcedir o) </> "hake" ]
223 source_modules = [ "HakeTypes", "RuleDefs", "Args", "Config",
225 modules = [ "Prelude", "System.FilePath", "HakeTypes", "RuleDefs",
227 qualified_modules = [ "Config", "Data.List" ]
229 -- Evaluate one Hakefile, and emit its Makefile section. We collect
230 -- referenced directories as we go, to generate the 'directories'
232 buildSections' :: (S.Set FilePath) -> [(FilePath, String)] ->
234 buildSections' dirs [] = return dirs
235 buildSections' dirs ((abs_hakepath, contents):hs) = do
236 let hakepath = makeRelative (opt_sourcedir o) abs_hakepath
237 rule <- evaluate hakepath contents
238 dirs' <- liftIO $ makefileSection makefile o hakepath rule
239 buildSections' (S.union dirs' dirs) hs
241 buildSections :: [(FilePath, String)] -> Ghc (S.Set FilePath)
242 buildSections hs = buildSections' S.empty hs
244 -- Evaluate a Hakefile, returning something of the form
246 evaluate :: FilePath -> String -> Ghc HRule
247 evaluate hakepath hake_raw = do
251 prettyPrintWithMode (defaultMode {layout = PPNoLayout}) $
252 wrapHake hakepath hake_expr
255 val <- dynCompileExpr $ hake_wrapped ++
256 " :: TreeDB -> HRule"
257 let rule = fromDyn val (\_ -> Error "failed")
261 resolvePaths o (takeDirectory hakepath)
264 Right hake_error -> do
265 return $ Error "failed"
267 hake_parse = parseHake hakepath hake_raw
269 -- Parse a Hakefile, prior to wrapping it with Hake definitions
270 parseHake :: FilePath -> String -> Either Exp HakeError
271 parseHake filename contents =
274 ParseFailed loc str ->
275 Right $ HakeError (show loc ++ ": " ++ str) 2
280 parseFilename = filename,
281 baseLanguage = Haskell2010 })
284 -- Split a Hake rule up by token type. It's more efficient to do this
285 -- in a single pass, than to filter each as it's required.
288 ruleOutputs :: S.Set RuleToken,
289 ruleDepends :: S.Set RuleToken,
290 rulePreDepends :: S.Set RuleToken,
291 ruleBody :: [RuleToken],
292 ruleDirs :: S.Set FilePath
295 compileRule :: [RuleToken] -> CompiledRule
296 compileRule [] = CompiledRule S.empty S.empty S.empty [] S.empty
298 let CompiledRule outs deps predeps body dirs = compileRule ts
299 outs' = if isOutput t then S.insert t outs else outs
300 deps' = if isDependency t then S.insert t deps else deps
301 predeps' = if isPredependency t then S.insert t predeps else predeps
302 body' = if inRule t then t:body else body
303 dirs' = if isFileRef t &&
305 takeDirectory (frPath t) /= "."
306 then S.insert (replaceFileName (frPath t) ".marker") dirs
309 CompiledRule outs' deps' predeps' body' dirs'
311 inTree :: FilePath -> Bool
313 case splitDirectories p of
318 -- We wrap the AST of the parsed Hakefile to defind the 'find' and 'build'
319 -- primitives, and generate the correct expression type (HRule). The result
320 -- is an unevaluted function [FilePath] -> HRule, that needs to be supplied
321 -- with the list of all files in the source directory.
322 wrapHake :: FilePath -> Exp -> Exp
323 wrapHake hakefile hake_exp =
325 Lambda dummy_loc [PVar (Ident "sourceDB")] (
327 [FunBind [Match -- This is 'find'
330 [PVar (Ident "fn"), PVar (Ident "arg")]
333 (Paren (App (App (App (Var (UnQual (Ident "fn")))
334 (Var (UnQual (Ident "sourceDB"))))
335 (Lit (String hakefile)))
336 (Var (UnQual (Ident "arg"))))))
341 (Ident "build") -- This is 'build'
345 (App (App (App (Paren (App (Var (UnQual (Ident "buildFunction")))
346 (Var (UnQual (Ident "a")))))
347 (Var (UnQual (Ident "sourceDB"))))
348 (Lit (String hakefile)))
349 (Var (UnQual (Ident "a")))))
352 (Paren (App (Con (UnQual (Ident "Rules")))
356 dummy_loc = SrcLoc { srcFilename = "<hake internal>",
357 srcLine = 0, srcColumn = 0 }
360 -- Makefile generation
363 -- The Makefile header, generated once.
364 makefilePreamble :: Handle -> Opts -> [String] -> IO ()
365 makefilePreamble h opts args =
367 ([ "# This Makefile is generated by Hake. Do not edit!",
369 "# Hake was invoked with the following command line args:" ] ++
370 [ "# " ++ a | a <- args ] ++
372 "SRCDIR=" ++ opt_sourcedir opts,
373 "HAKE_ARCHS=" ++ intercalate " " Config.architectures,
374 "include ./symbolic_targets.mk" ])
376 -- There a several valid top-level build directores, apart from the
377 -- architecture-specific one.
378 arch_list :: S.Set String
379 arch_list = S.fromList (Config.architectures ++
380 ["", "src", "hake", "root", "tools", "docs"])
382 -- A rule is included if it applies to only "special" and configured
384 allowedArchs :: [String] -> Bool
385 allowedArchs = all (\a -> a `S.member` arch_list)
387 -- The section corresponding to a Hakefile. These routines all collect
388 -- and directories they see.
389 makefileSection :: Handle -> Opts -> FilePath -> HRule -> IO (S.Set FilePath)
390 makefileSection h opts hakepath rule = do
391 hPutStrLn h $ "# From: " ++ hakepath ++ "\n"
394 makefileRule :: Handle -> HRule -> IO (S.Set FilePath)
395 makefileRule h (Error s) = do
396 hPutStrLn h $ "$(error " ++ s ++ ")\n"
398 makefileRule h (Rules rules) = do
399 dir_lists <- mapM (makefileRule h) rules
400 return $! S.unions dir_lists
401 makefileRule h (Include token) = do
402 when (allowedArchs [frArch token]) $
403 mapM_ (hPutStrLn h) [
404 "ifeq ($(MAKECMDGOALS),clean)",
405 "else ifeq ($(MAKECMDGOALS),rehake)",
406 "else ifeq ($(MAKECMDGOALS),Makefile)",
408 "include " ++ (formatToken token),
412 makefileRule h (HakeTypes.Rule tokens) =
413 if allowedArchs (map frArch tokens)
414 then makefileRuleInner h tokens False
416 makefileRule h (Phony name double_colon tokens) = do
417 hPutStrLn h $ ".PHONY: " ++ name
418 makefileRuleInner h (Target "build" name : tokens) double_colon
420 printTokens :: Handle -> S.Set RuleToken -> IO ()
421 printTokens h tokens =
422 S.foldr (\t m -> hPutStr h (formatToken t) >> m) (return ()) tokens
424 printDirs :: Handle -> S.Set FilePath -> IO ()
426 S.foldr (\d m -> hPutStr h (d ++ " ") >> m) (return ()) dirs
428 makefileRuleInner :: Handle -> [RuleToken] -> Bool -> IO (S.Set FilePath)
429 makefileRuleInner h tokens double_colon = do
430 if S.null (ruleOutputs compiledRule)
432 hPutStr h "# hake: omitted rule with no output: "
435 printTokens h $ ruleOutputs compiledRule
436 if double_colon then hPutStr h ":: " else hPutStr h ": "
437 printTokens h $ ruleDepends compiledRule
438 hPutStr h " | directories "
439 printTokens h $ rulePreDepends compiledRule
443 compiledRule = compileRule tokens
445 doBody :: IO (S.Set FilePath)
447 when (ruleBody compiledRule /= []) $ do
449 mapM_ (hPutStr h . formatToken) $ ruleBody compiledRule
451 return $ ruleDirs compiledRule
454 -- Functions to resolve path names in rules.
456 -- Absolute paths are interpreted relative to one of the three trees: source,
457 -- build or install. Relative paths are interpreted relative to the directory
458 -- containing the Hakefile that referenced them, within one of the above tree.
459 -- Both build and install trees are divided by architecture, while the source
460 -- tree is not. All paths are output relative to the build directory.
462 -- For example, if we are building for architecture 'x86_64', with build tree
463 -- '/home/user/barrelfish/build' and build tree '/home/user/barrelfish'
464 -- (relative path '../', and we are compiling a Hakefile at 'apps/init/Hakefile'
465 -- (relative path '../apps/init/Hakefile'), we would resolve as follows:
467 -- In SourceTree "../apps/init" "x86_64" "main.c"
468 -- -> "../apps/init/main.c"
469 -- In BuildTree "../apps/init" "x86_64" "/include/generated.h"
470 -- -> "./x86_64/include/generated.h"
471 -- Out BuildTree "../apps/init" "root" "/doc/manual.pdf"
472 -- -> "./doc/manual.pdf"
474 -- Note that the 'root' architecture is special, and always refers to the root
475 -- of the relevant tree.
477 -- Recurse through the Hake AST
478 resolvePaths :: Opts -> FilePath -> HRule -> HRule
479 resolvePaths o hakepath (Rules hrules)
480 = Rules $ map (resolvePaths o hakepath) hrules
481 resolvePaths o hakepath (HakeTypes.Rule tokens)
482 = HakeTypes.Rule $ map (resolveTokenPath o hakepath) tokens
483 resolvePaths o hakepath (Include token)
484 = Include $ resolveTokenPath o hakepath token
485 resolvePaths o hakepath (Error s)
487 resolvePaths o hakepath (Phony name dbl tokens)
488 = Phony name dbl $ map (resolveTokenPath o hakepath) tokens
490 -- Now resolve at the level of individual rule tokens. At this level,
491 -- we need to take into account the tree (source, build, or install).
492 resolveTokenPath :: Opts -> FilePath -> RuleToken -> RuleToken
493 -- An input token specifies which tree it refers to.
494 resolveTokenPath o hakepath (In tree arch path) =
495 (In tree arch (treePath o tree arch path hakepath))
496 -- An output token implicitly refers to the build tree.
497 resolveTokenPath o hakepath (Out arch path) =
498 (Out arch (treePath o BuildTree arch path hakepath))
499 -- A dependency token specifies which tree it refers to.
500 resolveTokenPath o hakepath (Dep tree arch path) =
501 (Dep tree arch (treePath o tree arch path hakepath))
502 -- A non-dependency token specifies which tree it refers to.
503 resolveTokenPath o hakepath (NoDep tree arch path) =
504 (NoDep tree arch (treePath o tree arch path hakepath))
505 -- A pre-dependency token specifies which tree it refers to.
506 resolveTokenPath o hakepath (PreDep tree arch path) =
507 (PreDep tree arch (treePath o tree arch path hakepath))
508 -- An target token implicitly refers to the build tree.
509 resolveTokenPath o hakepath (Target arch path) =
510 (Target arch (treePath o BuildTree arch path hakepath))
511 -- Other tokens don't contain paths to resolve.
512 resolveTokenPath _ _ token = token
514 -- Now we get down to the nitty gritty. We have, in order:
515 -- o: The options in force
516 -- tree: The tree (source, build, or install)
517 -- arch: The architecture (e.g. armv7)
518 -- path: The pathname we want to resolve
519 -- hakepath: The directory containing the Hakefile
520 -- If the tree is SrcTree or the architecture is "root", everything
521 -- is relative to the top-level directory for that tree. Otherwise,
522 -- it's relative to the top-level directory plus the architecture.
523 treePath :: Opts -> TreeRef -> FilePath -> FilePath -> FilePath -> FilePath
524 -- The architecture 'root' is special.
525 treePath o SrcTree "root" path hakepath =
526 relPath (opt_sourcedir o) path hakepath
527 treePath o BuildTree "root" path hakepath =
528 relPath "." path hakepath
529 treePath o InstallTree "root" path hakepath =
530 relPath (opt_installdir o) path hakepath
531 -- Source-tree paths don't get an architecture.
532 treePath o SrcTree arch path hakepath =
533 relPath (opt_sourcedir o) path hakepath
534 treePath o BuildTree arch path hakepath =
535 relPath ("." </> arch) path hakepath
536 treePath o InstallTree arch path hakepath =
537 relPath (opt_installdir o </> arch) path hakepath
539 -- First evaluate the given path 'path', relative to the Hakefile directory
540 -- 'hakepath'. If 'path' is absolute (i.e. begins with a /), it is unchanged.
541 -- Otherwise it is appended to 'hakepath'. We then treat this as a relative
542 -- path (by removing any initial /), and append it to the relevant tree root
543 -- (which may or may not have an architecture path appended already).
544 relPath treeroot path hakepath =
545 treeroot </> stripSlash (hakepath </> path)
547 -- Strip any leading slash from the filename. This is much faster than
548 -- 'makeRelative "/"'.
549 stripSlash :: FilePath -> FilePath
550 stripSlash ('/':cs) = cs
553 -- Emit the rule to rebuild the Hakefile.
554 makeHakeDeps :: Handle -> Opts -> [String] -> IO ()
555 makeHakeDeps h o l = do
557 hPutStrLn h ".DELETE_ON_ERROR:\n" -- this applies to following targets.
559 hake = resolveTokenPath o "" (In InstallTree "root" "/hake/hake")
560 makefile = resolveTokenPath o "/" (Out "root" (opt_makefilename o))
561 rule = HakeTypes.Rule
563 Str "--source-dir", Str (opt_sourcedir o),
564 Str "--install-dir", Str (opt_installdir o),
565 Str "--output-filename", makefile
567 [ Dep SrcTree "root" h | h <- l ]
570 -- Emit the rules to create the build directories
571 makeDirectories :: Handle -> S.Set FilePath -> IO ()
572 makeDirectories h dirs = do
573 hPutStrLn h "# Directories follow"
574 hPutStrLn h "DIRECTORIES=\\"
575 mapM_ (\d -> hPutStrLn h $ " " ++ d ++ " \\") (S.toList dirs)
577 hPutStrLn h ".PHONY: directories"
578 hPutStr h "directories: $(DIRECTORIES)"
580 hPutStrLn h "%.marker:"
581 hPutStrLn h "\tmkdir -p `dirname $@`"
582 hPutStrLn h "\ttouch $@"
584 makeDir :: Handle -> FilePath -> IO ()
586 hPutStrLn h $ "hake_dirs: " ++ dir ++ "\n"
587 hPutStrLn h $ dir ++ ":"
588 hPutStrLn h $ "\tmkdir -p " ++ (takeDirectory dir)
589 hPutStrLn h $ "\ttouch " ++ dir
598 -- Parse arguments; architectures default to config file
599 args <- liftIO $ System.Environment.getArgs
600 let o1 = parse_arguments args
601 al = if opt_architectures o1 == []
602 then Config.architectures
603 else opt_architectures o1
604 opts' = o1 { opt_architectures = al }
606 when (opt_usage_error opts') $
607 throwError (HakeError usage 1)
609 -- Check configuration settings.
610 -- This is currently known at compile time, but might not always be!
611 when (isJust configErrors) $
612 throwError (HakeError ("Error in configuration: " ++
613 (fromJust configErrors)) 2)
615 -- Canonicalise directories
616 abs_sourcedir <- liftIO $ canonicalizePath $ opt_sourcedir opts'
617 abs_bfsourcedir <- liftIO $ canonicalizePath $ opt_bfsourcedir opts'
618 abs_installdir <- liftIO $ canonicalizePath $ opt_installdir opts'
619 let opts = opts' { opt_abs_sourcedir = abs_sourcedir,
620 opt_abs_bfsourcedir = abs_bfsourcedir,
621 opt_abs_installdir = abs_installdir }
623 liftIO $ putStrLn ("Source directory: " ++ opt_sourcedir opts ++
624 " (" ++ opt_abs_sourcedir opts ++ ")")
625 liftIO $ putStrLn ("BF Source directory: " ++ opt_bfsourcedir opts ++
626 " (" ++ opt_abs_bfsourcedir opts ++ ")")
627 liftIO $ putStrLn ("Install directory: " ++ opt_installdir opts ++
628 " (" ++ opt_abs_installdir opts ++ ")")
631 liftIO $ putStrLn "Scanning directory tree..."
632 (relfiles, hakefiles) <- liftIO $ listFiles (opt_sourcedir opts)
633 let srcDB = tdbBuild relfiles
635 -- Open the Makefile and write the preamble
636 liftIO $ putStrLn $ "Creating " ++ (opt_makefilename opts) ++ "..."
637 makefile <- liftIO $ openFile(opt_makefilename opts) WriteMode
638 liftIO $ makefilePreamble makefile opts args
639 liftIO $ makeHakeDeps makefile opts $ map fst hakefiles
641 -- Evaluate Hakefiles
642 liftIO $ putStrLn $ "Evaluating " ++ show (length hakefiles) ++
644 dirs <- liftIO $ evalHakeFiles makefile opts srcDB hakefiles
646 -- Emit directory rules
647 liftIO $ putStrLn $ "Generating build directory dependencies..."
648 liftIO $ makeDirectories makefile dirs
650 liftIO $ hFlush makefile
651 liftIO $ hClose makefile
656 r <- runErrorT $ body `catchError` handleFailure
659 handleFailure (HakeError str n) = do
660 liftIO $ putStrLn str
661 liftIO $ exitWith (ExitFailure n)