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=" ++ (concat $ intersperse " " 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 -- printDirs h $ ruleDirs compiledRule
439 hPutStr h " | directories "
440 --when (not (S.null (rulePreDepends compiledRule))) $ do
441 printTokens h $ rulePreDepends compiledRule
445 compiledRule = compileRule tokens
447 doBody :: IO (S.Set FilePath)
449 when (ruleBody compiledRule /= []) $ do
451 mapM_ (hPutStr h . formatToken) $ ruleBody compiledRule
453 return $ ruleDirs compiledRule
456 -- Functions to resolve path names in rules.
458 -- Absolute paths are interpreted relative to one of the three trees: source,
459 -- build or install. Relative paths are interpreted relative to the directory
460 -- containing the Hakefile that referenced them, within one of the above tree.
461 -- Both build and install trees are divided by architecture, while the source
462 -- tree is not. All paths are output relative to the build directory.
464 -- For example, if we are building for architecture 'x86_64', with build tree
465 -- '/home/user/barrelfish/build' and build tree '/home/user/barrelfish'
466 -- (relative path '../', and we are compiling a Hakefile at 'apps/init/Hakefile'
467 -- (relative path '../apps/init/Hakefile'), we would resolve as follows:
469 -- In SourceTree "../apps/init" "x86_64" "main.c"
470 -- -> "../apps/init/main.c"
471 -- In BuildTree "../apps/init" "x86_64" "/include/generated.h"
472 -- -> "./x86_64/include/generated.h"
473 -- Out BuildTree "../apps/init" "root" "/doc/manual.pdf"
474 -- -> "./doc/manual.pdf"
476 -- Note that the 'root' architecture is special, and always refers to the root
477 -- of the relevant tree.
479 -- Recurse through the Hake AST
480 resolvePaths :: Opts -> FilePath -> HRule -> HRule
481 resolvePaths o hakepath (Rules hrules)
482 = Rules $ map (resolvePaths o hakepath) hrules
483 resolvePaths o hakepath (HakeTypes.Rule tokens)
484 = HakeTypes.Rule $ map (resolveTokenPath o hakepath) tokens
485 resolvePaths o hakepath (Include token)
486 = Include $ resolveTokenPath o hakepath token
487 resolvePaths o hakepath (Error s)
489 resolvePaths o hakepath (Phony name dbl tokens)
490 = Phony name dbl $ map (resolveTokenPath o hakepath) tokens
492 -- Now resolve at the level of individual rule tokens. At this level,
493 -- we need to take into account the tree (source, build, or install).
494 resolveTokenPath :: Opts -> FilePath -> RuleToken -> RuleToken
495 -- An input token specifies which tree it refers to.
496 resolveTokenPath o hakepath (In tree arch path) =
497 (In tree arch (treePath o tree arch path hakepath))
498 -- An output token implicitly refers to the build tree.
499 resolveTokenPath o hakepath (Out arch path) =
500 (Out arch (treePath o BuildTree arch path hakepath))
501 -- A dependency token specifies which tree it refers to.
502 resolveTokenPath o hakepath (Dep tree arch path) =
503 (Dep tree arch (treePath o tree arch path hakepath))
504 -- A non-dependency token specifies which tree it refers to.
505 resolveTokenPath o hakepath (NoDep tree arch path) =
506 (NoDep tree arch (treePath o tree arch path hakepath))
507 -- A pre-dependency token specifies which tree it refers to.
508 resolveTokenPath o hakepath (PreDep tree arch path) =
509 (PreDep tree arch (treePath o tree arch path hakepath))
510 -- An target token implicitly refers to the build tree.
511 resolveTokenPath o hakepath (Target arch path) =
512 (Target arch (treePath o BuildTree arch path hakepath))
513 -- Other tokens don't contain paths to resolve.
514 resolveTokenPath _ _ token = token
516 -- Now we get down to the nitty gritty. We have, in order:
517 -- o: The options in force
518 -- tree: The tree (source, build, or install)
519 -- arch: The architecture (e.g. armv7)
520 -- path: The pathname we want to resolve
521 -- hakepath: The directory containing the Hakefile
522 -- If the tree is SrcTree or the architecture is "root", everything
523 -- is relative to the top-level directory for that tree. Otherwise,
524 -- it's relative to the top-level directory plus the architecture.
525 treePath :: Opts -> TreeRef -> FilePath -> FilePath -> FilePath -> FilePath
526 -- The architecture 'root' is special.
527 treePath o SrcTree "root" path hakepath =
528 relPath (opt_sourcedir o) path hakepath
529 treePath o BuildTree "root" path hakepath =
530 relPath "." path hakepath
531 treePath o InstallTree "root" path hakepath =
532 relPath (opt_installdir o) path hakepath
533 -- Source-tree paths don't get an architecture.
534 treePath o SrcTree arch path hakepath =
535 relPath (opt_sourcedir o) path hakepath
536 treePath o BuildTree arch path hakepath =
537 relPath ("." </> arch) path hakepath
538 treePath o InstallTree arch path hakepath =
539 relPath (opt_installdir o </> arch) path hakepath
541 -- First evaluate the given path 'path', relative to the Hakefile directory
542 -- 'hakepath'. If 'path' is absolute (i.e. begins with a /), it is unchanged.
543 -- Otherwise it is appended to 'hakepath'. We then treat this as a relative
544 -- path (by removing any initial /), and append it to the relevant tree root
545 -- (which may or may not have an architecture path appended already).
546 relPath treeroot path hakepath =
547 treeroot </> stripSlash (hakepath </> path)
549 -- Strip any leading slash from the filename. This is much faster than
550 -- 'makeRelative "/"'.
551 stripSlash :: FilePath -> FilePath
552 stripSlash ('/':cs) = cs
555 -- Emit the rule to rebuild the Hakefile.
556 makeHakeDeps :: Handle -> Opts -> [String] -> IO ()
557 makeHakeDeps h o l = do
559 hPutStrLn h ".DELETE_ON_ERROR:\n" -- this applies to following targets.
561 hake = resolveTokenPath o "" (In InstallTree "root" "/hake/hake")
562 makefile = resolveTokenPath o "/" (Out "root" (opt_makefilename o))
563 rule = HakeTypes.Rule
565 Str "--source-dir", Str (opt_sourcedir o),
566 Str "--install-dir", Str (opt_installdir o),
567 Str "--output-filename", makefile
569 [ Dep SrcTree "root" h | h <- l ]
572 -- Emit the rules to create the build directories
573 makeDirectories :: Handle -> S.Set FilePath -> IO ()
574 makeDirectories h dirs = do
575 hPutStrLn h "# Directories follow"
576 --mapM_ (makeDir h) (S.toList (S.delete ("." </> ".marker") dirs))
577 hPutStrLn h "DIRECTORIES=\\"
578 mapM_ (\d -> hPutStrLn h $ " " ++ d ++ " \\") (S.toList dirs)
580 hPutStrLn h ".PHONY: directories"
581 hPutStr h "directories: $(DIRECTORIES)"
583 hPutStrLn h "%.marker:"
584 hPutStrLn h "\tmkdir -p `dirname $@`"
585 hPutStrLn h "\ttouch $@"
587 makeDir :: Handle -> FilePath -> IO ()
589 hPutStrLn h $ "hake_dirs: " ++ dir ++ "\n"
590 hPutStrLn h $ dir ++ ":"
591 hPutStrLn h $ "\tmkdir -p " ++ (takeDirectory dir)
592 hPutStrLn h $ "\ttouch " ++ dir
601 -- Parse arguments; architectures default to config file
602 args <- liftIO $ System.Environment.getArgs
603 let o1 = parse_arguments args
604 al = if opt_architectures o1 == []
605 then Config.architectures
606 else opt_architectures o1
607 opts' = o1 { opt_architectures = al }
609 when (opt_usage_error opts') $
610 throwError (HakeError usage 1)
612 -- Check configuration settings.
613 -- This is currently known at compile time, but might not always be!
614 when (isJust configErrors) $
615 throwError (HakeError ("Error in configuration: " ++
616 (fromJust configErrors)) 2)
618 -- Canonicalise directories
619 abs_sourcedir <- liftIO $ canonicalizePath $ opt_sourcedir opts'
620 abs_bfsourcedir <- liftIO $ canonicalizePath $ opt_bfsourcedir opts'
621 abs_installdir <- liftIO $ canonicalizePath $ opt_installdir opts'
622 let opts = opts' { opt_abs_sourcedir = abs_sourcedir,
623 opt_abs_bfsourcedir = abs_bfsourcedir,
624 opt_abs_installdir = abs_installdir }
626 liftIO $ putStrLn ("Source directory: " ++ opt_sourcedir opts ++
627 " (" ++ opt_abs_sourcedir opts ++ ")")
628 liftIO $ putStrLn ("BF Source directory: " ++ opt_bfsourcedir opts ++
629 " (" ++ opt_abs_bfsourcedir opts ++ ")")
630 liftIO $ putStrLn ("Install directory: " ++ opt_installdir opts ++
631 " (" ++ opt_abs_installdir opts ++ ")")
634 liftIO $ putStrLn "Reading directory tree..."
635 (relfiles, hakefiles) <- liftIO $ listFiles (opt_sourcedir opts)
636 let srcDB = tdbBuild relfiles
638 -- Open the Makefile and write the preamble
639 liftIO $ putStrLn $ "Opening " ++ (opt_makefilename opts)
640 makefile <- liftIO $ openFile(opt_makefilename opts) WriteMode
641 liftIO $ makefilePreamble makefile opts args
642 liftIO $ makeHakeDeps makefile opts $ map fst hakefiles
644 -- Evaluate Hakefiles
645 liftIO $ putStrLn $ "Evaluating " ++ show (length hakefiles) ++
647 dirs <- liftIO $ evalHakeFiles makefile opts srcDB hakefiles
649 -- Emit directory rules
650 liftIO $ putStrLn $ "Generating build directory dependencies..."
651 liftIO $ makeDirectories makefile dirs
653 liftIO $ hFlush makefile
654 liftIO $ hClose makefile
659 r <- runErrorT $ body `catchError` handleFailure
662 handleFailure (HakeError str n) = do
663 liftIO $ putStrLn str
664 liftIO $ exitWith (ExitFailure n)