git.barrelfish.org Git - barrelfish/blob - hake/Main.hs

   1 import Control.Monad.Error
   2
   3 import Data.Dynamic
   4 import Data.List
   5 import Data.Maybe
   6 import qualified Data.Set as S
   7
   8 import System.Directory
   9 import System.Environment
  10 import System.Exit
  11 import System.FilePath
  12 import System.IO
  13 import System.Mem
  14
  15 import GHC hiding (Target, Ghc, GhcT, runGhc, runGhcT, FunBind, Match)
  16 import GHC.Paths (libdir)
  17 import Control.Monad.Ghc
  18 import DynFlags (defaultFatalMessager, defaultFlushOut,
  19                  xopt_set, ExtensionFlag (Opt_DeriveDataTypeable))
  20 import GHC.Stats
  21
  22 import Language.Haskell.Exts
  23
  24 import RuleDefs
  25 import HakeTypes
  26 import qualified Args
  27 import qualified Config
  28 import qualified Path
  29
  30 data HakeError = HakeError String Int
  31 instance Error HakeError
  32 type HakeMonad = ErrorT HakeError IO
  33
  34 --
  35 -- Command line options and parsing code
  36 --
  37 data Opts = Opts { opt_makefilename :: String,
  38                    opt_installdir :: String,
  39                    opt_sourcedir :: String,
  40                    opt_bfsourcedir :: String,
  41                    opt_abs_installdir :: String,
  42                    opt_abs_sourcedir :: String,
  43                    opt_abs_bfsourcedir :: String,
  44                    opt_usage_error :: Bool,
  45                    opt_architectures :: [String],
  46                    opt_verbosity :: Integer
  47                  }
  48           deriving (Show,Eq)
  49
  50 parse_arguments :: [String] -> Opts
  51 parse_arguments [] =
  52   Opts { opt_makefilename = "Makefile",
  53          opt_installdir = Config.install_dir,
  54          opt_sourcedir = Config.source_dir,
  55          opt_bfsourcedir = Config.source_dir,
  56          opt_abs_installdir = "",
  57          opt_abs_sourcedir = "",
  58          opt_abs_bfsourcedir = "",
  59          opt_usage_error = False,
  60          opt_architectures = [],
  61          opt_verbosity = 1 }
  62 parse_arguments ("--install-dir" : (s : t)) =
  63   (parse_arguments t) { opt_installdir = s }
  64 parse_arguments ("--source-dir" : s : t) =
  65   (parse_arguments t) { opt_sourcedir = s }
  66 parse_arguments ("--bfsource-dir" : s : t) =
  67   (parse_arguments t) { opt_bfsourcedir = s }
  68 parse_arguments ("--output-filename" : s : t) =
  69   (parse_arguments t) { opt_makefilename = s }
  70 parse_arguments ("--quiet" : t ) =
  71   (parse_arguments t) { opt_verbosity = 0 }
  72 parse_arguments ("--verbose" : t ) =
  73   (parse_arguments t) { opt_verbosity = 2 }
  74 parse_arguments ("--architecture" : a : t ) =
  75   let
  76     o2 = parse_arguments t
  77     arches = (a : opt_architectures o2)
  78   in
  79     o2 { opt_architectures = arches }
  80 parse_arguments _ =
  81   (parse_arguments []) { opt_usage_error = True }
  82
  83 usage :: String
  84 usage = unlines [ "Usage: hake <options>",
  85                   "   --source-dir <dir> (required)",
  86                   "   --bfsource-dir <dir> (defaults to source dir)",
  87                   "   --install-dir <dir> (defaults to source dir)",
  88                   "   --quiet",
  89                   "   --verbose"
  90                 ]
  91
  92 -- check the configuration options, returning an error string if they're insane
  93 configErrors :: Maybe String
  94 configErrors
  95     | unknownArchs /= [] =
  96         Just ("unknown architecture(s) specified: " ++
  97         (concat $ intersperse ", " unknownArchs))
  98     | Config.architectures == [] =
  99         Just "no architectures defined"
 100     | Config.lazy_thc && not Config.use_fp =
 101         Just "Config.use_fp must be true to use Config.lazy_thc."
 102     | otherwise =
 103         Nothing
 104     where
 105         unknownArchs = Config.architectures \\ Args.allArchitectures
 106
 107 --
 108 -- Walk all over a directory tree and build a complete list of pathnames
 109 --
 110 listFiles :: FilePath -> IO ([FilePath], [(FilePath, String)])
 111 listFiles root = do
 112     isdir <- doesDirectoryExist root
 113     if isdir then do
 114         children <- getDirectoryContents root
 115         walkchildren children
 116     else
 117         return ([], [])
 118     where
 119         walkchildren :: [FilePath] -> IO ([FilePath], [(FilePath, String)])
 120         walkchildren [] = return ([], [])
 121         walkchildren (child:siblings) = do
 122             (allfiles, hakefiles) <- walkchild child
 123             (allfilesS, hakefilesS) <- walkchildren siblings
 124             return $ (allfiles ++ allfilesS, hakefiles ++ hakefilesS)
 125
 126         walkchild :: FilePath -> IO ([FilePath], [(FilePath, String)])
 127         walkchild child = do
 128             if ignore child
 129             then return ([], [])
 130             else do
 131                 (allfiles, hakefiles) <- listFiles (root </> child)
 132                 hake <- maybeHake child
 133                 return $ ((root </> child) : allfiles,
 134                           hake ++ hakefiles)
 135             where
 136                 maybeHake "Hakefile" = do
 137                     contents <- readFile (root </> child)
 138                     return [(root </> child, contents)]
 139                 maybeHake _ = return []
 140
 141         ignore :: FilePath -> Bool
 142         ignore "."          = True
 143         ignore ".."         = True
 144         ignore "CMakeFiles" = True
 145         ignore ".hg"        = True
 146         ignore "build"      = True
 147         ignore ".git"       = True
 148         ignore _            = False
 149
 150 instance Show SuccessFlag
 151 instance Show RunResult
 152
 153 driveGhc :: Handle -> Opts -> [FilePath] -> [(FilePath, String)] ->
 154             Ghc (S.Set FilePath)
 155 driveGhc makefile o allfiles hakefiles = do
 156     -- Set the RTS flags
 157     dflags <- getSessionDynFlags
 158     let dflags' = foldl xopt_set dflags [ Opt_DeriveDataTypeable ]
 159     _ <- setSessionDynFlags dflags'{
 160         importPaths = module_paths,
 161         hiDir = Just "./hake",
 162         objectDir = Just "./hake"
 163     }
 164
 165     -- Set compilation targets
 166     targets <- mapM (\m -> guessTarget m Nothing) source_modules
 167     setTargets targets
 168     load LoadAllTargets
 169
 170     -- Import modules
 171     setContext
 172         ([IIDecl $ simpleImportDecl $ mkModuleName m |
 173             m <- modules] ++
 174          [IIDecl $ (simpleImportDecl $ mkModuleName m) {
 175                 ideclQualified = True
 176           } | m <- qualified_modules])
 177
 178     buildSections hakefiles
 179
 180     where
 181         module_paths = [ (opt_installdir o) </> "hake", ".",
 182                          (opt_bfsourcedir o) </> "hake" ]
 183         source_modules = [ "HakeTypes", "RuleDefs", "Path", "Args", "Config" ]
 184         modules = [ "Prelude", "HakeTypes", "RuleDefs", "Path", "Args" ]
 185         qualified_modules = [ "Config", "Data.List" ]
 186
 187         buildSections' :: (S.Set FilePath) -> [(FilePath, String)] ->
 188                           Ghc (S.Set FilePath)
 189         buildSections' dirs [] = return dirs
 190         buildSections' dirs ((abs_hakepath, contents):hs) = do
 191             --liftIO $ putStrLn (fst h)
 192             --liftIO $ gcStats
 193             let hakepath = makeRelative (opt_sourcedir o) abs_hakepath
 194             rule <- evaluate hakepath contents
 195             dirs' <- liftIO $ makefileSection makefile o hakepath rule
 196             buildSections' (S.union dirs' dirs) hs
 197
 198         buildSections :: [(FilePath, String)] -> Ghc (S.Set FilePath)
 199         buildSections hs = buildSections' S.empty hs
 200
 201         evaluate :: FilePath -> String -> Ghc HRule
 202         evaluate hakepath hake_raw = do
 203             case hake_parse of
 204                 Left hake_expr -> do
 205                     let hake_wrapped =
 206                             prettyPrintWithMode (defaultMode {layout = PPNoLayout}) $
 207                                 wrapHake hakepath hake_expr
 208
 209                     val <- dynCompileExpr $ hake_wrapped ++ " :: [String] -> HRule"
 210                     let rule = fromDyn val (\_ -> Error "failed")
 211                     let resolved_rule =
 212                             resolvePaths o (takeDirectory hakepath)
 213                                            (rule allfiles)
 214                     return resolved_rule
 215                 Right hake_error -> do
 216                     return $ Error "failed"
 217             where
 218                 hake_parse = parseHake hakepath hake_raw
 219
 220 evalHakeFiles :: Handle -> Opts -> [FilePath] -> [(FilePath, String)] ->
 221                  IO (S.Set FilePath)
 222 evalHakeFiles makefile o allfiles hakefiles =
 223     defaultErrorHandler defaultFatalMessager defaultFlushOut $
 224         runGhc (Just libdir) $
 225         driveGhc makefile o allfiles hakefiles
 226
 227 parseHake :: FilePath -> String -> Either Exp HakeError
 228 parseHake filename contents =
 229     case result of
 230         ParseOk e -> Left e
 231         ParseFailed loc str ->
 232             Right $ HakeError (show loc ++ ": " ++ str) 2
 233     where
 234         result =
 235             parseExpWithMode
 236                 (defaultParseMode {
 237                     parseFilename = filename,
 238                     baseLanguage = Haskell2010 })
 239                 contents
 240
 241 wrapHake :: FilePath -> Exp -> Exp
 242 wrapHake hakefile hake_exp =
 243     Paren (
 244     Lambda dummy_loc [PVar (Ident "allfiles")] (
 245     Let (BDecls
 246         [FunBind [Match
 247             dummy_loc
 248             (Ident "find")
 249             [PVar (Ident "fn"), PVar (Ident "arg")]
 250             Nothing
 251             (UnGuardedRhs
 252                 (Paren (App (App (App (Var (UnQual (Ident "fn")))
 253                                       (Var (UnQual (Ident "allfiles"))))
 254                                  (Lit (String hakefile)))
 255                        (Var (UnQual (Ident "arg"))))))
 256             (BDecls [])],
 257
 258         FunBind [Match
 259             dummy_loc
 260             (Ident "build")
 261             [PVar (Ident "a")]
 262             Nothing
 263             (UnGuardedRhs
 264                 (App (App (App (Paren (App (Var (UnQual (Ident "buildFunction")))
 265                                            (Var (UnQual (Ident "a")))))
 266                                (Var (UnQual (Ident "allfiles"))))
 267                           (Lit (String hakefile)))
 268                      (Var (UnQual (Ident "a")))))
 269             (BDecls [])]
 270         ])
 271         (Paren (App (Con (UnQual (Ident "Rules")))
 272                     hake_exp))
 273     ))
 274     where
 275         dummy_loc = SrcLoc { srcFilename = "<hake internal>",
 276                                 srcLine = 0, srcColumn = 0 }
 277
 278 makefilePreamble :: Handle -> Opts -> [String] -> IO ()
 279 makefilePreamble h opts args =
 280     mapM_ (hPutStrLn h)
 281           ([ "# This Makefile is generated by Hake.  Do not edit!",
 282              "# ",
 283              "# Hake was invoked with the following command line args:" ] ++
 284            [ "#        " ++ a | a <- args ] ++
 285            [ "# ",
 286              "SRCDIR=" ++ (opt_sourcedir opts),
 287              "HAKE_ARCHS=" ++ (concat $ intersperse " " Config.architectures),
 288              "include ./symbolic_targets.mk" ])
 289
 290 -- a rule is included if it has only "special" architectures and enabled architectures
 291 allowedArchs :: [String] -> Bool
 292 allowedArchs = all (\a -> a `elem` (Config.architectures ++ specialArchitectures))
 293     where specialArchitectures = ["", "src", "hake", "root", "tools", "docs"]
 294
 295 makefileSection :: Handle -> Opts -> FilePath -> HRule -> IO (S.Set FilePath)
 296 makefileSection h opts hakepath rule = do
 297     hPutStrLn h $ "# From: " ++ hakepath ++ "\n"
 298     makefileRule h rule
 299
 300 makefileRule :: Handle -> HRule -> IO (S.Set FilePath)
 301 makefileRule h (Error s) = do
 302     hPutStrLn h $ "$(error " ++ s ++ ")\n"
 303     return S.empty
 304 makefileRule h (Rules rules) = do
 305     dir_lists <- mapM (makefileRule h) rules
 306     return $! S.unions dir_lists
 307 makefileRule h (Include token) = do
 308     when (allowedArchs [frArch token]) $
 309         mapM_ (hPutStrLn h) [
 310             "ifeq ($(MAKECMDGOALS),clean)",
 311             "else ifeq ($(MAKECMDGOALS),rehake)",
 312             "else ifeq ($(MAKECMDGOALS),Makefile)",
 313             "else",
 314             "include " ++ (formatToken token),
 315             "endif",
 316             "" ]
 317     return S.empty
 318 makefileRule h (HakeTypes.Rule tokens) =
 319     if allowedArchs (map frArch tokens)
 320         then makefileRuleInner h tokens False
 321         else return S.empty
 322 makefileRule h (Phony name double_colon tokens) = do
 323     hPutStrLn h $ ".PHONY: " ++ name
 324     makefileRuleInner h (Target "build" name : tokens) double_colon
 325
 326 printTokens :: Handle -> S.Set RuleToken -> IO ()
 327 printTokens h tokens =
 328     S.foldr (\t m -> hPutStr h (formatToken t) >> m) (return ()) tokens
 329
 330 printDirs :: Handle -> S.Set FilePath -> IO ()
 331 printDirs h dirs =
 332     S.foldr (\d m -> hPutStr h (d ++ " ") >> m) (return ()) dirs
 333
 334 makefileRuleInner :: Handle -> [RuleToken] -> Bool -> IO (S.Set FilePath)
 335 makefileRuleInner h tokens double_colon = do
 336     if S.null (ruleOutputs compiledRule)
 337     then do
 338         hPutStr h "# hake: omitted rule with no output: "
 339         doBody
 340     else do
 341         printTokens h $ ruleOutputs compiledRule
 342         if double_colon then hPutStr h ":: " else hPutStr h ": "
 343         printTokens h $ ruleDepends compiledRule
 344         printDirs h $ ruleDirs compiledRule
 345         when (not (S.null (rulePreDepends compiledRule))) $ do
 346             hPutStr h " | "
 347             printTokens h $ rulePreDepends compiledRule
 348         hPutStrLn h ""
 349         doBody
 350     where
 351         compiledRule = compileRule tokens
 352
 353         doBody :: IO (S.Set FilePath)
 354         doBody = do
 355             when (ruleBody compiledRule /= []) $ do
 356                 hPutStr h "\t"
 357                 mapM_ (hPutStr h . formatToken) $ ruleBody compiledRule
 358             hPutStrLn h "\n"
 359             return $ ruleDirs compiledRule
 360
 361 ---
 362 --- Functions to resolve relative path names in rules.
 363 ---
 364 --- First, the outer function: resolve path names in an HRule. The
 365 --- third argument, 'root', is frequently the pathname of the Hakefile
 366 --- relative to the source tree - since relative pathnames in
 367 --- Hakefiles are interpreted relative to the Hakefile location.
 368 ---
 369 resolvePaths :: Opts -> FilePath -> HRule -> HRule
 370 resolvePaths o hakepath (Rules hrules)
 371     = Rules $ map (resolvePaths o hakepath) hrules
 372 resolvePaths o hakepath (HakeTypes.Rule tokens)
 373     = HakeTypes.Rule $ map (resolveTokenPath o hakepath) tokens
 374 resolvePaths o hakepath (Include token)
 375     = Include $ resolveTokenPath o hakepath token
 376 resolvePaths o hakepath (Error s)
 377     = Error s
 378 resolvePaths o hakepath (Phony name dbl tokens)
 379     = Phony name dbl $ map (resolveTokenPath o hakepath) tokens
 380
 381 --- Now resolve at the level of individual rule tokens.  At this
 382 --- level, we need to take into account the tree (source, build, or
 383 --- install).
 384 resolveTokenPath :: Opts -> FilePath -> RuleToken -> RuleToken
 385 -- An input token specifies which tree it refers to.
 386 resolveTokenPath o hakepath (In tree arch path) =
 387     (In tree arch (treePath o tree arch path hakepath))
 388 -- An output token implicitly refers to the build tree.
 389 resolveTokenPath o hakepath (Out arch path) =
 390     (Out arch (treePath o BuildTree arch path hakepath))
 391 -- A dependency token specifies which tree it refers to.
 392 resolveTokenPath o hakepath (Dep tree arch path) =
 393     (Dep tree arch (treePath o tree arch path hakepath))
 394 -- A non-dependency token specifies which tree it refers to.
 395 resolveTokenPath o hakepath (NoDep tree arch path) =
 396     (NoDep tree arch (treePath o tree arch path hakepath))
 397 -- A pre-dependency token specifies which tree it refers to.
 398 resolveTokenPath o hakepath (PreDep tree arch path) =
 399     (PreDep tree arch (treePath o tree arch path hakepath))
 400 -- An target token implicitly refers to the build tree.
 401 resolveTokenPath o hakepath (Target arch path) =
 402     (Target arch (treePath o BuildTree arch path hakepath))
 403 -- Other tokens don't contain paths to resolve.
 404 resolveTokenPath _ _ token = token
 405
 406 --- Now we get down to the nitty gritty.  We have, in order:
 407 ---   o:        The options in force
 408 ---   tree:     The tree (source, build, or install)
 409 ---   arch:     The architecture (e.g. armv7)
 410 ---   path:     The pathname we want to resolve
 411 ---   hakepath: The directory containing the Hakefile
 412 --- If the tree is SrcTree or the architecture is "root", everything
 413 --- is relative to the top-level directory for that tree.  Otherwise,
 414 --- it's relative to the top-level directory plus the architecture.
 415 treePath :: Opts -> TreeRef -> FilePath -> FilePath -> FilePath -> FilePath
 416
 417 treePath o SrcTree "root" path hakepath =
 418     relPath (opt_sourcedir o) path hakepath
 419 treePath o BuildTree "root" path hakepath =
 420     relPath "." path hakepath
 421 treePath o InstallTree "root" path hakepath =
 422     relPath (opt_installdir o) path hakepath
 423
 424 treePath o SrcTree arch path hakepath =
 425     relPath (opt_sourcedir o) path hakepath
 426 treePath o BuildTree arch path hakepath =
 427     relPath ("." </> arch) path hakepath
 428 treePath o InstallTree arch path hakepath =
 429     relPath (opt_installdir o </> arch) path hakepath
 430
 431 --- This is where the work is done: take 'hd' (pathname relative to
 432 --- us of the Hakefile) and resolve the filename we're interested in
 433 --- relative to this.  This gives us a pathname relative to some root
 434 --- of some architecture tree, then return this relative to the actual
 435 --- tree we're interested in.  It's troubling that this takes more
 436 --- bytes to explain than to code.
 437 ---   d:    Pathname of top directory of the tree (source, build, install)
 438 ---   f:    Filename we are interested in, relative to 'root' below
 439 ---   hd:   Directory containing the Hakefile
 440 ---
 441 relPath treeroot path hakepath =
 442     treeroot </> stripSlash (hakepath </> path)
 443
 444 -- Strip any leading slash from the filename.  This is much faster than
 445 -- 'makeRelative "/"'
 446 stripSlash :: FilePath -> FilePath
 447 stripSlash ('/':cs) = cs
 448 stripSlash cs = cs
 449
 450 makeHakeDeps :: Handle -> Opts -> [String] -> IO ()
 451 makeHakeDeps h o l = do
 452     makefileRule h rule
 453     hPutStrLn h ".DELETE_ON_ERROR:\n" -- this applies to all targets in the Makefile
 454     where
 455         hake = resolveTokenPath o "" (In InstallTree "root" "/hake/hake")
 456         makefile = resolveTokenPath o "/" (Out "root" (opt_makefilename o))
 457         rule = HakeTypes.Rule
 458                     ( [ hake,
 459                         Str "--source-dir", Str (opt_sourcedir o),
 460                         Str "--install-dir", Str (opt_installdir o),
 461                         Str "--output-filename", makefile
 462                       ] ++
 463                       [ Dep SrcTree "root" h | h <- l ]
 464                     )
 465
 466 makeDirectories :: Handle -> S.Set FilePath -> IO ()
 467 makeDirectories h dirs = do
 468     hPutStrLn h "# Directories follow"
 469     mapM_ (makeDir h) (S.toList (S.delete ("." </> ".marker") dirs))
 470
 471 makeDir :: Handle -> FilePath -> IO ()
 472 makeDir h dir = do
 473     hPutStrLn h $ "hake_dirs: " ++ dir ++ "\n"
 474     hPutStrLn h $ dir ++ ":"
 475     hPutStrLn h $ "\tmkdir -p " ++ (takeDirectory dir)
 476     hPutStrLn h $ "\ttouch " ++ dir
 477     hPutStrLn h ""
 478
 479 scanTokens :: [RuleToken] -> (S.Set RuleToken, S.Set RuleToken,
 480                               S.Set RuleToken, [RuleToken],
 481                               S.Set FilePath)
 482 scanTokens [] = (S.empty, S.empty, S.empty, [], S.empty)
 483 scanTokens (t:ts) =
 484     case t of
 485         Out _ f      -> (S.insert t outs, deps, predeps, body', dirs' f)
 486         Target _ f   -> (S.insert t outs, deps, predeps, body', dirs' f)
 487         In _ _ f     -> (outs, S.insert t deps, predeps, body', dirs' f)
 488         Dep _ _ f    -> (outs, S.insert t deps, predeps, body', dirs' f)
 489         PreDep _ _ f -> (outs, deps, S.insert t predeps, body', dirs' f)
 490         NoDep _ _ f  -> (outs, deps, predeps, body', dirs' f)
 491         _            -> (outs, deps, predeps, body', dirs)
 492     where
 493         (outs, deps, predeps, body, dirs) = scanTokens ts
 494         body' = if inRule t then t:body else body
 495         dirs' f = if Path.isBelow (takeDirectory f) "." &&
 496                      takeDirectory f /= "."
 497                   then S.insert (dirOf f) dirs else dirs
 498
 499         dirOf :: FilePath -> FilePath
 500         dirOf f = (takeDirectory f) </> ".marker"
 501
 502
 503 data CompiledRule =
 504     CompiledRule {
 505         ruleOutputs    :: S.Set RuleToken,
 506         ruleDepends    :: S.Set RuleToken,
 507         rulePreDepends :: S.Set RuleToken,
 508         ruleBody       :: [RuleToken],
 509         ruleDirs       :: S.Set FilePath
 510     }
 511
 512 compileRule :: [RuleToken] -> CompiledRule
 513 compileRule tokens
 514     = CompiledRule {
 515         ruleOutputs    = outs,
 516         ruleDepends    = deps,
 517         rulePreDepends = predeps,
 518         ruleBody       = body,
 519         ruleDirs       = dirs
 520         }
 521     where
 522         (outs, deps, predeps, body, dirs) = scanTokens tokens
 523
 524 gcStats :: IO ()
 525 gcStats = do
 526     performGC
 527     gc_stats <- getGCStats
 528     putStrLn $ show (currentBytesUsed gc_stats) ++ " - " ++
 529                show (numGcs gc_stats) ++ " - " ++
 530                show (maxBytesUsed gc_stats) ++ " - " ++
 531                show (wallSeconds gc_stats)
 532
 533 body :: HakeMonad ()
 534 body =  do
 535     -- parse arguments; architectures default to config file
 536     args <- liftIO $ System.Environment.getArgs
 537     let o1 = parse_arguments args
 538         al = if opt_architectures o1 == []
 539              then Config.architectures
 540              else opt_architectures o1
 541         opts' = o1 { opt_architectures = al }
 542
 543     when (opt_usage_error opts') $
 544         throwError (HakeError usage 1)
 545
 546     -- sanity-check configuration settings
 547     -- this is currently known at compile time, but might not always be!
 548     when (isJust configErrors) $
 549         throwError (HakeError ("Error in configuration: " ++
 550                                (fromJust configErrors)) 2)
 551
 552     -- Canonicalise directories
 553     abs_sourcedir   <- liftIO $ canonicalizePath $ opt_sourcedir opts'
 554     abs_bfsourcedir <- liftIO $ canonicalizePath $ opt_bfsourcedir opts'
 555     abs_installdir  <- liftIO $ canonicalizePath $ opt_installdir opts'
 556     let opts = opts' { opt_abs_sourcedir   = abs_sourcedir,
 557                        opt_abs_bfsourcedir = abs_bfsourcedir,
 558                        opt_abs_installdir  = abs_installdir }
 559
 560     liftIO $ putStrLn ("Source directory: " ++ opt_sourcedir opts ++
 561                        " (" ++ opt_abs_sourcedir opts ++ ")")
 562     liftIO $ putStrLn ("BF Source directory: " ++ opt_bfsourcedir opts ++
 563                        " (" ++ opt_abs_bfsourcedir opts ++ ")")
 564     liftIO $ putStrLn ("Install directory: " ++ opt_installdir opts ++
 565                        " (" ++ opt_abs_installdir opts ++ ")")
 566
 567     liftIO gcStats
 568
 569     liftIO $ putStrLn "Reading directory tree..."
 570     (allfiles, hakefiles) <- liftIO $ listFiles (opt_sourcedir opts)
 571     let relfiles = map (makeRelative $ opt_sourcedir opts') allfiles
 572
 573     liftIO gcStats
 574
 575     liftIO $ putStrLn $ "Opening " ++ (opt_makefilename opts)
 576     makefile <- liftIO $ openFile(opt_makefilename opts) WriteMode
 577     liftIO $ makefilePreamble makefile opts args
 578     liftIO $ makeHakeDeps makefile opts $ map fst hakefiles
 579
 580     liftIO gcStats
 581
 582     liftIO $ putStrLn $ "Evaluating " ++ show (length hakefiles) ++
 583                         " Hakefiles..."
 584     dirs <- liftIO $ evalHakeFiles makefile opts relfiles hakefiles
 585
 586     liftIO gcStats
 587
 588     liftIO $ putStrLn $ show $ S.size dirs
 589
 590     liftIO $ putStrLn $ "Generating build directory dependencies..."
 591     liftIO $ makeDirectories makefile dirs
 592
 593     liftIO gcStats
 594
 595     return ()
 596
 597 main :: IO ()
 598 main = do
 599     r <- runErrorT $ body `catchError` handleFailure
 600     exitWith ExitSuccess
 601     where
 602         handleFailure (HakeError str n) = do
 603             liftIO $ putStrLn str
 604             liftIO $ exitWith (ExitFailure n)