From 8c286e59ab0913c0827954210ae6daab52c11bf0 Mon Sep 17 00:00:00 2001 From: David Cock Date: Tue, 18 Aug 2015 09:24:19 +0200 Subject: [PATCH] Replaced old hake Signed-off-by: David Cock --- hake/Hake2.hs | 553 ------------------------------------------- hake/Hakefile | 3 +- hake/Main.hs | 732 +++++++++++++++++++++++++++++++-------------------------- hake/hake.sh | 5 +- 4 files changed, 399 insertions(+), 894 deletions(-) delete mode 100644 hake/Hake2.hs diff --git a/hake/Hake2.hs b/hake/Hake2.hs deleted file mode 100644 index 89aaf1f..0000000 --- a/hake/Hake2.hs +++ /dev/null @@ -1,553 +0,0 @@ -import Control.Monad.Error - -import Data.Dynamic -import Data.List -import Data.Maybe -import qualified Data.Set as S - -import System.Directory -import System.Environment -import System.Exit -import System.FilePath -import System.IO -import System.Mem - -import GHC hiding (Target, Ghc, GhcT, runGhc, runGhcT, FunBind, Match) -import GHC.Paths (libdir) -import Control.Monad.Ghc -import DynFlags (defaultFatalMessager, defaultFlushOut, - xopt_set, ExtensionFlag (Opt_DeriveDataTypeable)) -import GHC.Stats - -import Language.Haskell.Exts - -import RuleDefs -import HakeTypes -import qualified Args -import qualified Config -import qualified Path - -data HakeError = HakeError String Int -instance Error HakeError -type HakeMonad = ErrorT HakeError IO - --- --- Command line options and parsing code --- -data Opts = Opts { opt_makefilename :: String, - opt_installdir :: String, - opt_sourcedir :: String, - opt_bfsourcedir :: String, - opt_usage_error :: Bool, - opt_architectures :: [String], - opt_verbosity :: Integer - } - deriving (Show,Eq) - -parse_arguments :: [String] -> Opts -parse_arguments [] = - Opts { opt_makefilename = "Makefile", - opt_installdir = Config.install_dir, - opt_sourcedir = Config.source_dir, - opt_bfsourcedir = Config.source_dir, - opt_usage_error = False, - opt_architectures = [], - opt_verbosity = 1 } -parse_arguments ("--install-dir" : (s : t)) = - (parse_arguments t) { opt_installdir = s } -parse_arguments ("--source-dir" : s : t) = - (parse_arguments t) { opt_sourcedir = s } -parse_arguments ("--bfsource-dir" : s : t) = - (parse_arguments t) { opt_bfsourcedir = s } -parse_arguments ("--output-filename" : s : t) = - (parse_arguments t) { opt_makefilename = s } -parse_arguments ("--quiet" : t ) = - (parse_arguments t) { opt_verbosity = 0 } -parse_arguments ("--verbose" : t ) = - (parse_arguments t) { opt_verbosity = 2 } -parse_arguments ("--architecture" : a : t ) = - let - o2 = parse_arguments t - arches = (a : opt_architectures o2) - in - o2 { opt_architectures = arches } -parse_arguments _ = - (parse_arguments []) { opt_usage_error = True } - -usage :: String -usage = unlines [ "Usage: hake ", - " --source-dir (required)", - " --bfsource-dir (defaults to source dir)", - " --install-dir (defaults to source dir)", - " --quiet", - " --verbose" - ] - --- check the configuration options, returning an error string if they're insane -configErrors :: Maybe String -configErrors - | unknownArchs /= [] = - Just ("unknown architecture(s) specified: " ++ - (concat $ intersperse ", " unknownArchs)) - | Config.architectures == [] = - Just "no architectures defined" - | Config.lazy_thc && not Config.use_fp = - Just "Config.use_fp must be true to use Config.lazy_thc." - | otherwise = - Nothing - where - unknownArchs = Config.architectures \\ Args.allArchitectures - --- --- Walk all over a directory tree and build a complete list of pathnames --- -listFiles :: FilePath -> IO ([FilePath], [(FilePath, String)]) -listFiles root = do - isdir <- doesDirectoryExist root - if isdir then do - children <- getDirectoryContents root - walkchildren children - else - return ([], []) - where - walkchildren :: [FilePath] -> IO ([FilePath], [(FilePath, String)]) - walkchildren [] = return ([], []) - walkchildren (child:siblings) = do - (allfiles, hakefiles) <- walkchild child - (allfilesS, hakefilesS) <- walkchildren siblings - return $ (allfiles ++ allfilesS, hakefiles ++ hakefilesS) - - walkchild :: FilePath -> IO ([FilePath], [(FilePath, String)]) - walkchild child = do - if ignore child - then return ([], []) - else do - (allfiles, hakefiles) <- listFiles (root child) - hake <- maybeHake child - return $ ((root child) : allfiles, - hake ++ hakefiles) - where - maybeHake "Hakefile" = do - contents <- readFile (root child) - return [(root child, contents)] - maybeHake _ = return [] - - ignore :: FilePath -> Bool - ignore "." = True - ignore ".." = True - ignore "CMakeFiles" = True - ignore ".hg" = True - ignore "build" = True - ignore ".git" = True - ignore _ = False - -instance Show SuccessFlag -instance Show RunResult - -driveGhc :: Opts -> [(FilePath, String)] -> Ghc ([(String, [String] -> HRule)]) -driveGhc o hakefiles = do - -- Set the RTS flags - dflags <- getSessionDynFlags - let dflags' = foldl xopt_set dflags [ Opt_DeriveDataTypeable ] - _ <- setSessionDynFlags dflags'{ - importPaths = module_paths, - hiDir = Just "./hake", - objectDir = Just "./hake" - } - - -- Set compilation targets - targets <- mapM (\m -> guessTarget m Nothing) source_modules - setTargets targets - load LoadAllTargets - - -- Import modules - setContext - ([IIDecl $ simpleImportDecl $ mkModuleName m | - m <- modules] ++ - [IIDecl $ (simpleImportDecl $ mkModuleName m) { - ideclQualified = True - } | m <- qualified_modules]) - - mapM evaluate hakefiles - - where - module_paths = [ (opt_installdir o) "hake", ".", - (opt_bfsourcedir o) "hake" ] - source_modules = [ "HakeTypes", "RuleDefs", "Path", "Args", "Config" ] - modules = [ "Prelude", "HakeTypes", "RuleDefs", "Path", "Args" ] - qualified_modules = [ "Config", "Data.List" ] - - evaluate :: (FilePath, String) -> Ghc ((String, [String] -> HRule)) - evaluate (hake_name, hake_raw) = do - case hake_parse of - Left hake_expr -> do - let hake_wrapped = - prettyPrintWithMode (defaultMode {layout = PPNoLayout}) $ - wrapHake hake_name hake_expr - - val <- dynCompileExpr $ hake_wrapped ++ " :: [String] -> HRule" - liftIO $ putStrLn ( "Success: " ++ hake_name ) - return $ (hake_name, fromDyn val (\_ -> Error "failed")) - Right hake_error -> do - return $ (hake_name, \_ -> Error "failed") - where - hake_parse = parseHake (hake_name, hake_raw) - -evalHakeFiles :: Opts -> [(FilePath, String)] -> - IO ([(String, [String] -> HRule)]) -evalHakeFiles o hakefiles = - defaultErrorHandler defaultFatalMessager defaultFlushOut $ - runGhc (Just libdir) $ - driveGhc o hakefiles - -parseHake :: (FilePath, String) -> Either Exp HakeError -parseHake (filename, contents) = - case result of - ParseOk e -> Left e - ParseFailed loc str -> - Right $ HakeError (show loc ++ ": " ++ str) 2 - where - result = - parseExpWithMode - (defaultParseMode { - parseFilename = filename, - baseLanguage = Haskell2010 }) - contents - -wrapHake :: FilePath -> Exp -> Exp -wrapHake hakefile hake_exp = - Paren ( - Lambda dummy_loc [PVar (Ident "allfiles")] ( - Let (BDecls - [FunBind [Match - dummy_loc - (Ident "find") - [PVar (Ident "fn"), PVar (Ident "arg")] - Nothing - (UnGuardedRhs - (Paren (App (App (App (Var (UnQual (Ident "fn"))) - (Var (UnQual (Ident "allfiles")))) - (Lit (String hakefile))) - (Var (UnQual (Ident "arg")))))) - (BDecls [])], - - FunBind [Match - dummy_loc - (Ident "build") - [PVar (Ident "a")] - Nothing - (UnGuardedRhs - (App (App (App (Paren (App (Var (UnQual (Ident "buildFunction"))) - (Var (UnQual (Ident "a"))))) - (Var (UnQual (Ident "allfiles")))) - (Lit (String hakefile))) - (Var (UnQual (Ident "a"))))) - (BDecls [])] - ]) - (Paren (App (Con (UnQual (Ident "Rules"))) - hake_exp)) - )) - where - dummy_loc = SrcLoc { srcFilename = "", - srcLine = 0, srcColumn = 0 } - -makefilePreamble :: Handle -> Opts -> [String] -> IO () -makefilePreamble h opts args = - mapM_ (hPutStrLn h) - ([ "# This Makefile is generated by Hake. Do not edit!", - "# ", - "# Hake was invoked with the following command line args:" ] ++ - [ "# " ++ a | a <- args ] ++ - [ "# ", - "SRCDIR=" ++ (opt_sourcedir opts), - "HAKE_ARCHS=" ++ (concat $ intersperse " " Config.architectures), - "include ./symbolic_targets.mk" ]) - --- a rule is included if it has only "special" architectures and enabled architectures -allowedArchs :: [String] -> Bool -allowedArchs = all (\a -> a `elem` (Config.architectures ++ specialArchitectures)) - where specialArchitectures = ["", "src", "hake", "root", "tools", "docs"] - -makefileSection :: Handle -> Opts -> [FilePath] -> - (String, [String] -> HRule) -> IO (S.Set FilePath) -makefileSection h opts allfiles (hake_name, rule_schema) = do - hPutStrLn h $ "# From: " ++ hake_name ++ "\n" - makefileRule h $ - resolveRelativePaths opts (rule_schema allfiles) hake_name - -makefileRule :: Handle -> HRule -> IO (S.Set FilePath) -makefileRule h (Error s) = do - hPutStrLn h $ "$(error " ++ s ++ ")\n" - return S.empty -makefileRule h (Rules rules) = do - dir_lists <- mapM (makefileRule h) rules - return $ S.unions dir_lists -makefileRule h (Include token) = do - when (allowedArchs [frArch token]) $ - mapM_ (hPutStrLn h) [ - "ifeq ($(MAKECMDGOALS),clean)", - "else ifeq ($(MAKECMDGOALS),rehake)", - "else ifeq ($(MAKECMDGOALS),Makefile)", - "else", - "include " ++ (formatToken token), - "endif", - "" ] - return S.empty -makefileRule h (HakeTypes.Rule tokens) = - if allowedArchs (map frArch tokens) - then makefileRuleInner h tokens False - else return S.empty -makefileRule h (Phony name double_colon tokens) = do - hPutStrLn h $ ".PHONY: " ++ name - makefileRuleInner h (Target "build" name : tokens) double_colon - -printTokens :: Handle -> S.Set RuleToken -> IO () -printTokens h tokens = - S.foldr (\t m -> hPutStr h (formatToken t) >> m) (return ()) tokens - -printDirs :: Handle -> S.Set FilePath -> IO () -printDirs h dirs = - S.foldr (\d m -> hPutStr h (d ++ " ") >> m) (return ()) dirs - -makefileRuleInner :: Handle -> [RuleToken] -> Bool -> IO (S.Set FilePath) -makefileRuleInner h tokens double_colon = do - if S.null (ruleOutputs compiledRule) - then do - hPutStr h "# hake: omitted rule with no output: " - doBody - else do - printTokens h $ ruleOutputs compiledRule - if double_colon then hPutStr h ":: " else hPutStr h ": " - printTokens h $ ruleDepends compiledRule - printDirs h $ ruleDirs compiledRule - when (not (S.null (rulePreDepends compiledRule))) $ do - hPutStr h " | " - printTokens h $ rulePreDepends compiledRule - hPutStrLn h "" - doBody - where - compiledRule = compileRule tokens - - doBody :: IO (S.Set FilePath) - doBody = do - when (ruleBody compiledRule /= []) $ do - hPutStr h "\t" - mapM_ (hPutStr h . formatToken) $ ruleBody compiledRule - hPutStrLn h "\n" - return $ ruleDirs compiledRule - ---- ---- Functions to resolve relative path names in rules. ---- ---- First, the outer function: resolve path names in an HRule. The ---- third argument, 'root', is frequently the pathname of the Hakefile ---- relative to the source tree - since relative pathnames in ---- Hakefiles are interpreted relative to the Hakefile location. ---- -resolveRelativePaths :: Opts -> HRule -> String -> HRule -resolveRelativePaths o (Rules hrules) root - = Rules [ resolveRelativePaths o r root | r <- hrules ] -resolveRelativePaths o (HakeTypes.Rule tokens) root - = HakeTypes.Rule [ resolveRelativePath o t root | t <- tokens ] -resolveRelativePaths o (Include token) root - = Include ( resolveRelativePath o token root ) -resolveRelativePaths o (Error s) root - = Error s -resolveRelativePaths o (Phony name dbl tokens) root - = Phony name dbl [ resolveRelativePath o t root | t <- tokens ] - ---- Now resolve at the level of individual rule tokens. At this ---- level, we need to take into account the tree (source, build, or ---- install). -resolveRelativePath :: Opts -> RuleToken -> String -> RuleToken -resolveRelativePath o (In t a f) root = - (In t a (resolveRelativePathName o t a f root)) -resolveRelativePath o (Out a f) root = - (Out a (resolveRelativePathName o BuildTree a f root)) -resolveRelativePath o (Dep t a f) root = - (Dep t a (resolveRelativePathName o t a f root)) -resolveRelativePath o (NoDep t a f) root = - (NoDep t a (resolveRelativePathName o t a f root)) -resolveRelativePath o (PreDep t a f) root = - (PreDep t a (resolveRelativePathName o t a f root)) -resolveRelativePath o (Target a f) root = - (Target a (resolveRelativePathName o BuildTree a f root)) -resolveRelativePath _ (Str s) _ = (Str s) -resolveRelativePath _ (NStr s) _ = (NStr s) -resolveRelativePath _ (ErrorMsg s) _ = (ErrorMsg s) -resolveRelativePath _ NL _ = NL - ---- Now we get down to the nitty gritty. We have, in order: ---- o: The options in force. ---- t: The tree (source, build, or install) ---- a: The architecture (e.g. armv7) ---- p: The pathname we want to resolve to a full path, and ---- h: The dirname of the Hakefile in which it occurs. ---- If the tree is SrcTree or the architecture is "root", everything ---- is relative to the top-level directory for that tree. Otherwise, ---- it's relative to the top-level directory plus the architecture. -resolveRelativePathName :: Opts -> TreeRef -> String -> String -> String -> String - -resolveRelativePathName o SrcTree "root" f h = - resolveRelativePathName' ((opt_sourcedir o)) f h -resolveRelativePathName o BuildTree "root" f h = - resolveRelativePathName' "." f h -resolveRelativePathName o InstallTree "root" f h = - resolveRelativePathName' ((opt_installdir o)) f h - -resolveRelativePathName o SrcTree a f h = - resolveRelativePathName' (opt_sourcedir o) f h -resolveRelativePathName o BuildTree a f h = - resolveRelativePathName' ("." a) f h -resolveRelativePathName o InstallTree a f h = - resolveRelativePathName' ((opt_installdir o) a) f h - ---- This is where the work is done: take 'hd' (pathname relative to ---- us of the Hakefile) and resolve the filename we're interested in ---- relative to this. This gives us a pathname relative to some root ---- of some architecture tree, then return this relative to the actual ---- tree we're interested in. It's troubling that this takes more ---- bytes to explain than to code. ---- d: Pathname of top directory of the tree (source, build, install) ---- f: Filename we are interested in, relative to 'root' below ---- hd: Directory containing the Hakefile ---- -resolveRelativePathName' d f hd = - let af = Path.relToFile f hd - rf = Path.makeRel $ Path.relToDir af "/" - in Path.relToDir rf d - -makeHakeDeps :: Handle -> Opts -> [String] -> IO () -makeHakeDeps h o l = do - makefileRule h rule - hPutStrLn h ".DELETE_ON_ERROR:\n" -- this applies to all targets in the Makefile - where - hake = resolveRelativePath o (In InstallTree "root" "/hake/hake") "" - makefile = resolveRelativePath o (Out "root" (opt_makefilename o)) "/Hakefile" - rule = HakeTypes.Rule - ( [ hake, - Str "--source-dir", Str (opt_sourcedir o), - Str "--install-dir", Str (opt_installdir o), - Str "--output-filename", makefile - ] ++ - [ Dep SrcTree "root" h | h <- l ] - ) - -makeDirectories :: Handle -> S.Set FilePath -> IO () -makeDirectories h dirs = do - hPutStrLn h "# Directories follow" - mapM_ (makeDir h) (S.toList (S.delete ("." ".marker") dirs)) - -makeDir :: Handle -> FilePath -> IO () -makeDir h dir = do - hPutStrLn h $ "hake_dirs: " ++ dir ++ "\n" - hPutStrLn h $ dir ++ ":" - hPutStrLn h $ "\tmkdir -p " ++ (takeDirectory dir) - hPutStrLn h $ "\ttouch " ++ dir - hPutStrLn h "" - -scanTokens :: [RuleToken] -> (S.Set RuleToken, S.Set RuleToken, - S.Set RuleToken, [RuleToken], - S.Set FilePath) -scanTokens [] = (S.empty, S.empty, S.empty, [], S.empty) -scanTokens (t:ts) = - case t of - Out _ f -> (S.insert t outs, deps, predeps, body', - S.insert (dirOf f) dirs) - Target _ f -> (S.insert t outs, deps, predeps, body', - S.insert (dirOf f) dirs) - In _ _ _ -> (outs, S.insert t deps, predeps, body', dirs) - Dep _ _ _ -> (outs, S.insert t deps, predeps, body', dirs) - PreDep _ _ _ -> (outs, deps, S.insert t predeps, body', dirs) - _ -> (outs, deps, predeps, body', dirs) - where - (outs, deps, predeps, body, dirs) = scanTokens ts - body' = if inRule t then t:body else body - - dirOf :: FilePath -> FilePath - dirOf f = (takeDirectory f) ".marker" - -data CompiledRule = - CompiledRule { - ruleOutputs :: S.Set RuleToken, - ruleDepends :: S.Set RuleToken, - rulePreDepends :: S.Set RuleToken, - ruleBody :: [RuleToken], - ruleDirs :: S.Set FilePath - } - -compileRule :: [RuleToken] -> CompiledRule -compileRule tokens - = CompiledRule { - ruleOutputs = outs, - ruleDepends = deps, - rulePreDepends = predeps, - ruleBody = body, - ruleDirs = dirs - } - where - (outs, deps, predeps, body, dirs) = scanTokens tokens - -gcStats :: IO () -gcStats = do - performGC - gc_stats <- getGCStats - putStrLn $ show (currentBytesUsed gc_stats) ++ " - " ++ - show (numGcs gc_stats) ++ " - " ++ - show (maxBytesUsed gc_stats) ++ " - " ++ - show (wallSeconds gc_stats) - -body :: HakeMonad () -body = do - -- parse arguments; architectures default to config file - args <- liftIO $ System.Environment.getArgs - let o1 = parse_arguments args - al = if opt_architectures o1 == [] - then Config.architectures - else opt_architectures o1 - opts = o1 { opt_architectures = al } - - when (opt_usage_error opts) $ - throwError (HakeError usage 1) - - -- sanity-check configuration settings - -- this is currently known at compile time, but might not always be! - when (isJust configErrors) $ - throwError (HakeError ("Error in configuration: " ++ - (fromJust configErrors)) 2) - - liftIO $ putStrLn ("Source directory: " ++ opt_sourcedir opts) - liftIO $ putStrLn ("BF Source directory: " ++ opt_bfsourcedir opts) - liftIO $ putStrLn ("Install directory: " ++ opt_installdir opts) - - liftIO gcStats - - liftIO $ putStrLn "Reading directory tree..." - (allfiles, hakefiles) <- liftIO $ listFiles (opt_sourcedir opts) - - liftIO gcStats - - rules <- liftIO $ evalHakeFiles opts hakefiles - liftIO $ putStrLn $ show (length rules) - - liftIO gcStats - - liftIO $ putStrLn $ "Generating " ++ (opt_makefilename opts) - makefile <- liftIO $ openFile(opt_makefilename opts) WriteMode - liftIO $ makefilePreamble makefile opts args - liftIO $ makeHakeDeps makefile opts $ map fst hakefiles - dirs <- liftIO $ mapM (makefileSection makefile opts allfiles) rules - liftIO $ makeDirectories makefile (S.unions dirs) - - liftIO gcStats - - return () - -main :: IO () -main = do - r <- runErrorT $ body `catchError` handleFailure - exitWith ExitSuccess - where - handleFailure (HakeError str n) = do - liftIO $ putStrLn str - liftIO $ exitWith (ExitFailure n) diff --git a/hake/Hakefile b/hake/Hakefile index a0d8897..b118019 100644 --- a/hake/Hakefile +++ b/hake/Hakefile @@ -25,8 +25,7 @@ in Str "-outputdir", NoDep BuildTree "hake" "/", NStr "-i", NoDep SrcTree "src" "", NStr "-i", NoDep BuildTree "hake" "/", - --In SrcTree "src" "Main.hs", - In SrcTree "src" "Hake2.hs", + In SrcTree "src" "Main.hs", Dep InstallTree "" "Config.hs", Str "$(LDFLAGS)" ] diff --git a/hake/Main.hs b/hake/Main.hs index e301ff4..9626f79 100644 --- a/hake/Main.hs +++ b/hake/Main.hs @@ -1,37 +1,35 @@ -{- - Hake: a meta build system for Barrelfish +import Control.Monad.Error - Copyright (c) 2009, ETH Zurich. - All rights reserved. - - This file is distributed under the terms in the attached LICENSE file. - If you do not find this file, copies can be found by writing to: - ETH Zurich D-INFK, Universitätstasse 6, CH-8092 Zurich. Attn: Systems Group. --} - - - -module Main where +import Data.Dynamic +import Data.List +import Data.Maybe +import qualified Data.Set as S -import System.Environment -import System.IO import System.Directory +import System.Environment import System.Exit -import GHC hiding (Target) -import GHC.Paths ( libdir ) -import DynFlags ( defaultFatalMessager, defaultFlushOut, - xopt_set, - ExtensionFlag (Opt_DeriveDataTypeable) ) -import Data.Dynamic -import Data.Maybe -import Data.List -import Control.Monad +import System.FilePath +import System.IO +import System.Mem + +import GHC hiding (Target, Ghc, GhcT, runGhc, runGhcT, FunBind, Match) +import GHC.Paths (libdir) +import Control.Monad.Ghc +import DynFlags (defaultFatalMessager, defaultFlushOut, + xopt_set, ExtensionFlag (Opt_DeriveDataTypeable)) +import GHC.Stats + +import Language.Haskell.Exts import RuleDefs import HakeTypes -import qualified Path import qualified Args import qualified Config +import qualified Path + +data HakeError = HakeError String Int +instance Error HakeError +type HakeMonad = ErrorT HakeError IO -- -- Command line options and parsing code @@ -85,58 +83,261 @@ usage = unlines [ "Usage: hake ", " --verbose" ] --- --- Handy path operator --- -infix 4 ./. -root ./. path = Path.relToDir path root - +-- check the configuration options, returning an error string if they're insane +configErrors :: Maybe String +configErrors + | unknownArchs /= [] = + Just ("unknown architecture(s) specified: " ++ + (concat $ intersperse ", " unknownArchs)) + | Config.architectures == [] = + Just "no architectures defined" + | Config.lazy_thc && not Config.use_fp = + Just "Config.use_fp must be true to use Config.lazy_thc." + | otherwise = + Nothing + where + unknownArchs = Config.architectures \\ Args.allArchitectures -- -- Walk all over a directory tree and build a complete list of pathnames -- -listFilesR :: FilePath -> IO [FilePath] -listFilesR path = let - isDODD :: String -> Bool - isDODD f = not $ (isSuffixOf "/." f) - || (isSuffixOf "/.." f) - || (isSuffixOf "CMakeFiles" f) - || (isPrefixOf (path ++ "/.hg") f) - || (isPrefixOf (path ++ "/build") f) - || (isPrefixOf (path ++ "/.git") f) - - listDirs :: [FilePath] -> IO [FilePath] - listDirs = filterM doesDirectoryExist - - listFiles :: [FilePath] -> IO [FilePath] - listFiles = filterM doesFileExist - - joinFN :: String -> String -> FilePath - -- joinFN p1 p2 = joinPath [p1, p2] - joinFN p1 p2 = p1 ++ "/" ++ p2 - - in do - allfiles <- getDirectoryContents path - no_dots <- filterM (return . isDODD) (map (joinFN path) allfiles) - dirs <- listDirs no_dots - subdirfiles <- (mapM listFilesR dirs >>= return . concat) - files <- listFiles no_dots - return $ files ++ subdirfiles +listFiles :: FilePath -> IO ([FilePath], [(FilePath, String)]) +listFiles root = do + isdir <- doesDirectoryExist root + if isdir then do + children <- getDirectoryContents root + walkchildren children + else + return ([], []) + where + walkchildren :: [FilePath] -> IO ([FilePath], [(FilePath, String)]) + walkchildren [] = return ([], []) + walkchildren (child:siblings) = do + (allfiles, hakefiles) <- walkchild child + (allfilesS, hakefilesS) <- walkchildren siblings + return $ (allfiles ++ allfilesS, hakefiles ++ hakefilesS) + + walkchild :: FilePath -> IO ([FilePath], [(FilePath, String)]) + walkchild child = do + if ignore child + then return ([], []) + else do + (allfiles, hakefiles) <- listFiles (root child) + hake <- maybeHake child + return $ ((root child) : allfiles, + hake ++ hakefiles) + where + maybeHake "Hakefile" = do + contents <- readFile (root child) + return [(root child, contents)] + maybeHake _ = return [] + + ignore :: FilePath -> Bool + ignore "." = True + ignore ".." = True + ignore "CMakeFiles" = True + ignore ".hg" = True + ignore "build" = True + ignore ".git" = True + ignore _ = False + +instance Show SuccessFlag +instance Show RunResult + +driveGhc :: Opts -> [FilePath] -> [(FilePath, String)] -> + Ghc ([(String, HRule)]) +driveGhc o allfiles hakefiles = do + -- Set the RTS flags + dflags <- getSessionDynFlags + let dflags' = foldl xopt_set dflags [ Opt_DeriveDataTypeable ] + _ <- setSessionDynFlags dflags'{ + importPaths = module_paths, + hiDir = Just "./hake", + objectDir = Just "./hake" + } + + -- Set compilation targets + targets <- mapM (\m -> guessTarget m Nothing) source_modules + setTargets targets + load LoadAllTargets + + -- Import modules + setContext + ([IIDecl $ simpleImportDecl $ mkModuleName m | + m <- modules] ++ + [IIDecl $ (simpleImportDecl $ mkModuleName m) { + ideclQualified = True + } | m <- qualified_modules]) + + mapM evaluate hakefiles --- --- Return a list of pairs of (Hakefile name, contents) --- -readHakeFiles :: [FilePath] -> IO [ (String,String) ] -readHakeFiles [] = return [] -readHakeFiles (h:hs) = do { r <- readFile h; - rs <- readHakeFiles hs; - return ((h,r):rs) - } --- --- Look for Hakefiles in a list of path names --- -hakeFiles :: [FilePath] -> [String] -hakeFiles f = [ fp | fp <- f, isSuffixOf "/Hakefile" fp ] + where + module_paths = [ (opt_installdir o) "hake", ".", + (opt_bfsourcedir o) "hake" ] + source_modules = [ "HakeTypes", "RuleDefs", "Path", "Args", "Config" ] + modules = [ "Prelude", "HakeTypes", "RuleDefs", "Path", "Args" ] + qualified_modules = [ "Config", "Data.List" ] + + evaluate :: (FilePath, String) -> Ghc ((String, HRule)) + evaluate (hake_name, hake_raw) = do + case hake_parse of + Left hake_expr -> do + let hake_wrapped = + prettyPrintWithMode (defaultMode {layout = PPNoLayout}) $ + wrapHake hake_name hake_expr + + val <- dynCompileExpr $ hake_wrapped ++ " :: [String] -> HRule" + liftIO $ putStrLn ( "Success: " ++ hake_name ) + let rule = fromDyn val (\_ -> Error "failed") + let resolved_rule = + resolveRelativePaths o (rule allfiles) hake_name + return $ (hake_name, resolved_rule) + Right hake_error -> do + return $ (hake_name, Error "failed") + where + hake_parse = parseHake (hake_name, hake_raw) + +evalHakeFiles :: Opts -> [FilePath] -> [(FilePath, String)] -> + IO ([(String, HRule)]) +evalHakeFiles o allfiles hakefiles = + defaultErrorHandler defaultFatalMessager defaultFlushOut $ + runGhc (Just libdir) $ + driveGhc o allfiles hakefiles + +parseHake :: (FilePath, String) -> Either Exp HakeError +parseHake (filename, contents) = + case result of + ParseOk e -> Left e + ParseFailed loc str -> + Right $ HakeError (show loc ++ ": " ++ str) 2 + where + result = + parseExpWithMode + (defaultParseMode { + parseFilename = filename, + baseLanguage = Haskell2010 }) + contents + +wrapHake :: FilePath -> Exp -> Exp +wrapHake hakefile hake_exp = + Paren ( + Lambda dummy_loc [PVar (Ident "allfiles")] ( + Let (BDecls + [FunBind [Match + dummy_loc + (Ident "find") + [PVar (Ident "fn"), PVar (Ident "arg")] + Nothing + (UnGuardedRhs + (Paren (App (App (App (Var (UnQual (Ident "fn"))) + (Var (UnQual (Ident "allfiles")))) + (Lit (String hakefile))) + (Var (UnQual (Ident "arg")))))) + (BDecls [])], + + FunBind [Match + dummy_loc + (Ident "build") + [PVar (Ident "a")] + Nothing + (UnGuardedRhs + (App (App (App (Paren (App (Var (UnQual (Ident "buildFunction"))) + (Var (UnQual (Ident "a"))))) + (Var (UnQual (Ident "allfiles")))) + (Lit (String hakefile))) + (Var (UnQual (Ident "a"))))) + (BDecls [])] + ]) + (Paren (App (Con (UnQual (Ident "Rules"))) + hake_exp)) + )) + where + dummy_loc = SrcLoc { srcFilename = "", + srcLine = 0, srcColumn = 0 } + +makefilePreamble :: Handle -> Opts -> [String] -> IO () +makefilePreamble h opts args = + mapM_ (hPutStrLn h) + ([ "# This Makefile is generated by Hake. Do not edit!", + "# ", + "# Hake was invoked with the following command line args:" ] ++ + [ "# " ++ a | a <- args ] ++ + [ "# ", + "SRCDIR=" ++ (opt_sourcedir opts), + "HAKE_ARCHS=" ++ (concat $ intersperse " " Config.architectures), + "include ./symbolic_targets.mk" ]) + +-- a rule is included if it has only "special" architectures and enabled architectures +allowedArchs :: [String] -> Bool +allowedArchs = all (\a -> a `elem` (Config.architectures ++ specialArchitectures)) + where specialArchitectures = ["", "src", "hake", "root", "tools", "docs"] + +makefileSection :: Handle -> Opts -> [FilePath] -> + (String, HRule) -> IO (S.Set FilePath) +makefileSection h opts allfiles (hake_name, rule) = do + hPutStrLn h $ "# From: " ++ hake_name ++ "\n" + makefileRule h rule + +makefileRule :: Handle -> HRule -> IO (S.Set FilePath) +makefileRule h (Error s) = do + hPutStrLn h $ "$(error " ++ s ++ ")\n" + return S.empty +makefileRule h (Rules rules) = do + dir_lists <- mapM (makefileRule h) rules + return $ S.unions dir_lists +makefileRule h (Include token) = do + when (allowedArchs [frArch token]) $ + mapM_ (hPutStrLn h) [ + "ifeq ($(MAKECMDGOALS),clean)", + "else ifeq ($(MAKECMDGOALS),rehake)", + "else ifeq ($(MAKECMDGOALS),Makefile)", + "else", + "include " ++ (formatToken token), + "endif", + "" ] + return S.empty +makefileRule h (HakeTypes.Rule tokens) = + if allowedArchs (map frArch tokens) + then makefileRuleInner h tokens False + else return S.empty +makefileRule h (Phony name double_colon tokens) = do + hPutStrLn h $ ".PHONY: " ++ name + makefileRuleInner h (Target "build" name : tokens) double_colon + +printTokens :: Handle -> S.Set RuleToken -> IO () +printTokens h tokens = + S.foldr (\t m -> hPutStr h (formatToken t) >> m) (return ()) tokens + +printDirs :: Handle -> S.Set FilePath -> IO () +printDirs h dirs = + S.foldr (\d m -> hPutStr h (d ++ " ") >> m) (return ()) dirs + +makefileRuleInner :: Handle -> [RuleToken] -> Bool -> IO (S.Set FilePath) +makefileRuleInner h tokens double_colon = do + if S.null (ruleOutputs compiledRule) + then do + hPutStr h "# hake: omitted rule with no output: " + doBody + else do + printTokens h $ ruleOutputs compiledRule + if double_colon then hPutStr h ":: " else hPutStr h ": " + printTokens h $ ruleDepends compiledRule + printDirs h $ ruleDirs compiledRule + when (not (S.null (rulePreDepends compiledRule))) $ do + hPutStr h " | " + printTokens h $ rulePreDepends compiledRule + hPutStrLn h "" + doBody + where + compiledRule = compileRule tokens + + doBody :: IO (S.Set FilePath) + doBody = do + when (ruleBody compiledRule /= []) $ do + hPutStr h "\t" + mapM_ (hPutStr h . formatToken) $ ruleBody compiledRule + hPutStrLn h "\n" + return $ ruleDirs compiledRule --- --- Functions to resolve relative path names in rules. @@ -149,8 +350,8 @@ hakeFiles f = [ fp | fp <- f, isSuffixOf "/Hakefile" fp ] resolveRelativePaths :: Opts -> HRule -> String -> HRule resolveRelativePaths o (Rules hrules) root = Rules [ resolveRelativePaths o r root | r <- hrules ] -resolveRelativePaths o (Rule tokens) root - = Rule [ resolveRelativePath o t root | t <- tokens ] +resolveRelativePaths o (HakeTypes.Rule tokens) root + = HakeTypes.Rule [ resolveRelativePath o t root | t <- tokens ] resolveRelativePaths o (Include token) root = Include ( resolveRelativePath o token root ) resolveRelativePaths o (Error s) root @@ -200,9 +401,9 @@ resolveRelativePathName o InstallTree "root" f h = resolveRelativePathName o SrcTree a f h = resolveRelativePathName' (opt_sourcedir o) f h resolveRelativePathName o BuildTree a f h = - resolveRelativePathName' ("." ./. a) f h + resolveRelativePathName' ("." a) f h resolveRelativePathName o InstallTree a f h = - resolveRelativePathName' ((opt_installdir o) ./. a) f h + resolveRelativePathName' ((opt_installdir o) a) f h --- This is where the work is done: take 'hd' (pathname relative to --- us of the Hakefile) and resolve the filename we're interested in @@ -219,283 +420,140 @@ resolveRelativePathName' d f hd = rf = Path.makeRel $ Path.relToDir af "/" in Path.relToDir rf d --- --- Generating a list of build directories --- -makeDirectories :: [(String, HRule)] -> String -makeDirectories r = - let alldirs = makeDirs1 (Rules [ rl | (f,rl) <- r ]) - marker d = d ./. ".marker" - in unlines ([ "# Directories follow" ] ++ - [ "hake_dirs: " ++ (marker d) ++ "\n\n" ++ - (marker d) ++ ": \n" ++ - "\tmkdir -p " ++ d ++ "\n" ++ - "\ttouch " ++ (marker d) ++ "\n" - | d <- nub alldirs]) - -makeDirs1 :: HRule -> [String] -makeDirs1 (Rules hrules) = concat [ makeDirs1 r | r <- hrules] -makeDirs1 (Include tok) = - case tokDir tok of - Nothing -> [] - Just d -> [d] -makeDirs1 (Rule toks) = [d | Just d <- [ tokDir t | t <- toks ]] -makeDirs1 (Error s) = [] -makeDirs1 (Phony name dbl toks) = [d | Just d <- [ tokDir t | t <- toks ]] - -tokDir :: RuleToken -> Maybe String -tokDir (In t a f) = tokDir1 f -tokDir (Out a f) = tokDir1 f -tokDir (Dep t a f) = tokDir1 f -tokDir (NoDep t a f) = tokDir1 f -tokDir (PreDep t a f) = tokDir1 f -tokDir (Target a f) = tokDir1 f -tokDir (Str s) = Nothing -tokDir (NStr s) = Nothing -tokDir (ErrorMsg s) = Nothing -tokDir NL = Nothing - -tokDir1 f - | (Path.dirname f) `Path.isBelow` "." = Just (Path.dirname f) - | otherwise = Nothing - --- --- filter rules by the set of architectures in Config.architectures --- -filterRuleByArch :: HRule -> Maybe HRule -filterRuleByArch (Rule toks) = if allowedArchs (map frArch toks) then Just (Rule toks) else Nothing -filterRuleByArch (Include tok) = if allowedArchs [frArch tok] then Just (Include tok) else Nothing -filterRuleByArch (Rules rules) = Just (Rules (catMaybes $ map filterRuleByArch rules)) -filterRuleByArch x = Just x - --- a rule is included if it has only "special" architectures and enabled architectures -allowedArchs :: [String] -> Bool -allowedArchs = all (\a -> a `elem` (Config.architectures ++ specialArchitectures)) - where specialArchitectures = ["", "src", "hake", "root", "tools", "docs"] - --- --- Functions to format rules as Makefile rules --- -makeMakefile :: [(String, HRule)] -> String -makeMakefile r = - unlines $ intersperse "" [makeMakefileSection f rl | (f,rl) <- r] - -makeMakefileSection :: String -> HRule -> String -makeMakefileSection fname rules = - "# From: " ++ fname ++ "\n\n" ++ makeMakeRules rules - --- Format a rule or rules, of any type (including errors, inclusions, --- etc.). See makeMakeRules1 below for how to format rule tokens --- properly -makeMakeRules :: HRule -> String -makeMakeRules (Rules hrules) - = unlines [ s | s <- [ makeMakeRules h | h <- hrules ], s /= "" ] -makeMakeRules (Include token) = unlines [ - "ifeq ($(MAKECMDGOALS),clean)", - "else ifeq ($(MAKECMDGOALS),rehake)", - "else ifeq ($(MAKECMDGOALS),Makefile)", - "else", - "include " ++ (formatToken token), - "endif"] -makeMakeRules (Error s) = "$(error " ++ s ++ ")\n" -makeMakeRules (Phony name dbl tokens) - = ".PHONY: " ++ name ++ "\n" ++ makeMakeRules1 ([ Target "build" name ] ++ tokens) dbl -makeMakeRules (Rule tokens) = makeMakeRules1 tokens False - --- Now we get down to brass tacks. Format a rule proper. Sort out --- which tokens needs to be in the rule head, dependencies, body, etc. --- `dbl` specifies a double-colon rule, which is typically used for --- Phony rules generated as part of the help system. -makeMakeRules1 :: [RuleToken] -> Bool -> String -makeMakeRules1 tokens dbl = - let outs = nub [ f | (Out a f) <- tokens ] - ++ [ f | (Target a f) <- tokens ] - dirs = nub [ (Path.dirname f) ./. ".marker" | f <- outs ] - deps = nub [ f | (In t a f) <- tokens ] ++ [ f | (Dep t a f) <- tokens ] - predeps = nub [ f | (PreDep t a f) <- tokens ] - spaceSep :: [ String ] -> String - spaceSep sl = concat (intersperse " " sl) - ruleBody = (concat[ formatToken t | t <- tokens, inRule t ]) - in if outs == [] then - ("# hake: omitted rule with no output: " ++ ruleBody) - else - (spaceSep outs) ++ (if dbl then ":: " else ": ") - ++ - -- It turns out that if you add 'dirs' here, in an attempt to - -- get Make to build the directories as well, it goes a bit - -- pear-shaped: whenever the directory "changes" it goes out of - -- date, so you end up rebuilding dependencies every time. - (spaceSep (deps ++ dirs)) - ++ - (if (predeps == []) then "" else " | " ++ spaceSep (predeps)) - ++ "\n" - ++ - (if (ruleBody == "") then "" else "\t" ++ ruleBody ++ "\n") - - -preamble :: Opts -> [String] -> String -preamble opts args = - unlines ( [ "# This Makefile is generated by Hake. Do not edit!", - "# ", - "# Hake was invoked with the following command line args:" ] ++ - [ "# " ++ a | a <- args ] ++ - [ "# ", - "SRCDIR=" ++ (opt_sourcedir opts), - "HAKE_ARCHS=" ++ (concat $ intersperse " " Config.architectures), - "include ./symbolic_targets.mk" ] ) - -stripSrcDir :: String -> String -stripSrcDir s = Path.removePrefix Config.source_dir s - -hakeModule :: [String] -> [(String,String)] -> String -hakeModule allfiles hakefiles = - let unqual_imports = ["RuleDefs", "HakeTypes", "Path", "Args" ] - qual_imports = ["Config", "Data.List" ] - relfiles = [ stripSrcDir f | f <- allfiles ] - wrap1 n c = wrapLet "build a" - ("(buildFunction a) allfiles " ++ (show n) ++ " a") - c - wrap n c = "(" ++ (show n) ++ ", " - ++ wrapLet "find fn arg" - ("(fn allfiles " ++ (show n) ++ " arg)") - ("Rules (" ++ (wrap1 n c) ++ ")") - ++ ")" - flatten :: [String] -> String - flatten s = foldl (++) "" (intersperse ",\n" s) - addHeader (fn,fc) = (fn, "{-# LINE 1 \"" ++ fn ++ "\" #-}\n" ++ fc) - files = flatten [ wrap (stripSrcDir fn) fc | (fn,fc) <- map addHeader hakefiles ] - in - unlines ( [ "module Hakefiles where {" ] - ++ - [ "import " ++ i ++ ";" | i <- unqual_imports ] - ++ - [ "import qualified " ++ i ++ ";" | i <- qual_imports ] - ++ - [ "allfiles = " ++ (show relfiles) ++ ";" ] - ++ - [ "hf = [" ] - ) ++ files ++ "];\n}" - -wrapLet :: String -> String -> String -> String -wrapLet var expr body = - "(let " ++ var ++ " = " ++ expr ++ " in\n" ++ body ++ ")" - -evalHakeFiles :: Opts -> [String] -> [(String,String)] - -> IO [(String,HRule)] -evalHakeFiles o allfiles hakefiles = - let imports = [ "Hakefiles"] - all_imports = ("Prelude":"HakeTypes":imports) - moddirs = [ (opt_installdir o) ./. "hake", - ".", - (opt_bfsourcedir o) ./. "hake" ] - in do - defaultErrorHandler defaultFatalMessager defaultFlushOut $ do - runGhc (Just libdir) $ do - dflags <- getSessionDynFlags - let dflags1 = foldl xopt_set dflags [ Opt_DeriveDataTypeable ] - _ <- setSessionDynFlags dflags1{ - importPaths = moddirs, - hiDir = Just "./hake", - objectDir = Just "./hake" - } - targets <- mapM (\m -> guessTarget m Nothing) imports - setTargets targets - load LoadAllTargets - setContext [(IIDecl . simpleImportDecl) (mkModuleName m) | m <- (all_imports)] - val <- dynCompileExpr "Hakefiles.hf :: [(String, HRule)]" - return (fromDyn val [("failed",Error "failed")]) - --- --- Generate dependencies of the Makefile on all the Hakefiles --- ---resolveRelativePaths o (Rules hrules) root ---- resolveRelativePath o (In t a f) root = -makeHakeDeps :: Opts -> [ String ] -> String -makeHakeDeps o l = - let hake = resolveRelativePath o (In InstallTree "root" "/hake/hake") "" +makeHakeDeps :: Handle -> Opts -> [String] -> IO () +makeHakeDeps h o l = do + makefileRule h rule + hPutStrLn h ".DELETE_ON_ERROR:\n" -- this applies to all targets in the Makefile + where + hake = resolveRelativePath o (In InstallTree "root" "/hake/hake") "" makefile = resolveRelativePath o (Out "root" (opt_makefilename o)) "/Hakefile" - rule = Rule ( [ hake, + rule = HakeTypes.Rule + ( [ hake, Str "--source-dir", Str (opt_sourcedir o), Str "--install-dir", Str (opt_installdir o), Str "--output-filename", makefile ] ++ [ Dep SrcTree "root" h | h <- l ] ) - in - (makeMakeRules rule) - ++ ".DELETE_ON_ERROR:\n\n" -- this applies to all targets in the Makefile - -makeHakeDeps1 :: Opts -> [ String ] -> String -makeHakeDeps1 _ l = - "Makefile: ./hake/hake " - ++ concat (intersperse " " l) - ++ "\n\t./hake/hake Makefile\n" - ++ ".DELETE_ON_ERROR:\n\n" -- this applies to all targets in the Makefile --- check the configuration options, returning an error string if they're insane -configErrors :: Maybe String -configErrors - | unknownArchs /= [] = Just ("unknown architecture(s) specified: " - ++ (concat $ intersperse ", " unknownArchs)) - | Config.architectures == [] = Just "no architectures defined" - | Config.lazy_thc && not Config.use_fp = Just "Config.use_fp must be true to use Config.lazy_thc." - | otherwise = Nothing +makeDirectories :: Handle -> S.Set FilePath -> IO () +makeDirectories h dirs = do + hPutStrLn h "# Directories follow" + mapM_ (makeDir h) (S.toList (S.delete ("." ".marker") dirs)) + +makeDir :: Handle -> FilePath -> IO () +makeDir h dir = do + hPutStrLn h $ "hake_dirs: " ++ dir ++ "\n" + hPutStrLn h $ dir ++ ":" + hPutStrLn h $ "\tmkdir -p " ++ (takeDirectory dir) + hPutStrLn h $ "\ttouch " ++ dir + hPutStrLn h "" + +scanTokens :: [RuleToken] -> (S.Set RuleToken, S.Set RuleToken, + S.Set RuleToken, [RuleToken], + S.Set FilePath) +scanTokens [] = (S.empty, S.empty, S.empty, [], S.empty) +scanTokens (t:ts) = + case t of + Out _ f -> (S.insert t outs, deps, predeps, body', dirs' f) + Target _ f -> (S.insert t outs, deps, predeps, body', dirs' f) + In _ _ f -> (outs, S.insert t deps, predeps, body', dirs' f) + Dep _ _ f -> (outs, S.insert t deps, predeps, body', dirs' f) + PreDep _ _ f -> (outs, deps, S.insert t predeps, body', dirs' f) + NoDep _ _ f -> (outs, deps, predeps, body', dirs' f) + _ -> (outs, deps, predeps, body', dirs) where - unknownArchs = Config.architectures \\ Args.allArchitectures - - ---- ---- Convert a Hakefile name to one relative to the root of the source tree. ---- -strip_hfn :: Opts -> String -> String -strip_hfn opts f = Path.removePrefix (opt_sourcedir opts) f - -main :: IO() -main = do + (outs, deps, predeps, body, dirs) = scanTokens ts + body' = if inRule t then t:body else body + dirs' f = if Path.isBelow (takeDirectory f) "." && + takeDirectory f /= "." + then S.insert (dirOf f) dirs else dirs + + dirOf :: FilePath -> FilePath + dirOf f = (takeDirectory f) ".marker" + + +data CompiledRule = + CompiledRule { + ruleOutputs :: S.Set RuleToken, + ruleDepends :: S.Set RuleToken, + rulePreDepends :: S.Set RuleToken, + ruleBody :: [RuleToken], + ruleDirs :: S.Set FilePath + } + +compileRule :: [RuleToken] -> CompiledRule +compileRule tokens + = CompiledRule { + ruleOutputs = outs, + ruleDepends = deps, + rulePreDepends = predeps, + ruleBody = body, + ruleDirs = dirs + } + where + (outs, deps, predeps, body, dirs) = scanTokens tokens + +gcStats :: IO () +gcStats = do + performGC + gc_stats <- getGCStats + putStrLn $ show (currentBytesUsed gc_stats) ++ " - " ++ + show (numGcs gc_stats) ++ " - " ++ + show (maxBytesUsed gc_stats) ++ " - " ++ + show (wallSeconds gc_stats) + +body :: HakeMonad () +body = do -- parse arguments; architectures default to config file - args <- System.Environment.getArgs + args <- liftIO $ System.Environment.getArgs let o1 = parse_arguments args al = if opt_architectures o1 == [] then Config.architectures else opt_architectures o1 opts = o1 { opt_architectures = al } - if opt_usage_error opts then do - hPutStrLn stderr usage - exitWith $ ExitFailure 1 - else do + + when (opt_usage_error opts) $ + throwError (HakeError usage 1) -- sanity-check configuration settings -- this is currently known at compile time, but might not always be! - if isJust configErrors then do - hPutStrLn stderr $ "Error in configuration: " ++ (fromJust configErrors) - exitWith $ ExitFailure 2 - else do - - hPutStrLn stdout ("Source directory: " ++ opt_sourcedir opts) - hPutStrLn stdout ("BF Source directory: " ++ opt_bfsourcedir opts) - hPutStrLn stdout ("Install directory: " ++ opt_installdir opts) - - hPutStrLn stdout "Reading directory tree..." - l <- listFilesR (opt_sourcedir opts) - hPutStrLn stdout "Reading Hakefiles..." - hfl <- readHakeFiles $ hakeFiles l - hPutStrLn stdout "Writing HakeFile module..." - modf <- openFile ("Hakefiles.hs") WriteMode - hPutStrLn modf $ hakeModule l hfl - hClose modf - hPutStrLn stdout "Evaluating Hakefiles..." - inrules <- evalHakeFiles opts l hfl - hPutStrLn stdout "Done!" - -- filter out rules for unsupported architectures and resolve relative paths - let rules = - ([(f, resolveRelativePaths opts (fromJust (filterRuleByArch rl)) (strip_hfn opts f)) - | (f,rl) <- inrules, isJust (filterRuleByArch rl) ]) - hPutStrLn stdout $ "Generating " ++ (opt_makefilename opts) ++ " - this may take some time (and RAM)..." - makef <- openFile(opt_makefilename opts) WriteMode - hPutStrLn makef $ preamble opts args - -- let hfl2 = [ strip_hfn opts (fst h) | h <- hfl ] - hPutStrLn makef $ makeHakeDeps opts $ map fst hfl - hPutStrLn makef $ makeMakefile rules - hPutStrLn makef $ makeDirectories rules - hClose makef + when (isJust configErrors) $ + throwError (HakeError ("Error in configuration: " ++ + (fromJust configErrors)) 2) + + liftIO $ putStrLn ("Source directory: " ++ opt_sourcedir opts) + liftIO $ putStrLn ("BF Source directory: " ++ opt_bfsourcedir opts) + liftIO $ putStrLn ("Install directory: " ++ opt_installdir opts) + + liftIO gcStats + + liftIO $ putStrLn "Reading directory tree..." + (allfiles, hakefiles) <- liftIO $ listFiles (opt_sourcedir opts) + + liftIO gcStats + + rules <- liftIO $ evalHakeFiles opts allfiles hakefiles + liftIO $ putStrLn $ show (length rules) + + liftIO gcStats + + liftIO $ putStrLn $ "Generating " ++ (opt_makefilename opts) + makefile <- liftIO $ openFile(opt_makefilename opts) WriteMode + liftIO $ makefilePreamble makefile opts args + liftIO $ makeHakeDeps makefile opts $ map fst hakefiles + dirs <- liftIO $ mapM (makefileSection makefile opts allfiles) rules + liftIO $ makeDirectories makefile (S.unions dirs) + + liftIO gcStats + + return () + +main :: IO () +main = do + r <- runErrorT $ body `catchError` handleFailure exitWith ExitSuccess + where + handleFailure (HakeError str n) = do + liftIO $ putStrLn str + liftIO $ exitWith (ExitFailure n) diff --git a/hake/hake.sh b/hake/hake.sh index 04ecc04..3ce5497 100755 --- a/hake/hake.sh +++ b/hake/hake.sh @@ -156,6 +156,7 @@ fi echo "Building hake..." ghc -O --make -XDeriveDataTypeable \ -package ghc \ + -package ghc-mtl \ -package ghc-paths \ -o hake/hake \ -outputdir hake \ @@ -163,7 +164,6 @@ ghc -O --make -XDeriveDataTypeable \ -ihake \ -rtsopts=all \ -threaded \ - -with-rtsopts="-K32m" \ $SRCDIR/hake/Main.hs $LDFLAGS || exit 1 # -eventlog \ @@ -175,7 +175,8 @@ fi echo "Running hake..." #./hake/hake --output-filename Makefile --source-dir "$SRCDIR" +RTS -s -N -K64M -A64M -ls -lf || exit -./hake/hake --output-filename Makefile --source-dir "$SRCDIR" +RTS -N -K64M -A64M || exit +#./hake/hake --output-filename Makefile --source-dir "$SRCDIR" +RTS -N -K64M -A64M || exit +./hake/hake --output-filename Makefile --source-dir "$SRCDIR" +RTS -T || exit echo "Now running initial make to build dependencies." echo " (remove the '-j 4' if your system has trouble handling this" -- 1.7.2.5