Commit 3b4210fa authored by Ben Gamari's avatar Ben Gamari 🐢

Write results to file

parent 64e48129
...@@ -11,6 +11,7 @@ import Data.List ...@@ -11,6 +11,7 @@ import Data.List
import Data.Maybe import Data.Maybe
import Data.Time.Clock import Data.Time.Clock
import qualified System.Directory as IO import qualified System.Directory as IO
import qualified Data.ByteString.Char8 as BS
import System.Exit import System.Exit
import System.Info import System.Info
import System.IO import System.IO
...@@ -179,6 +180,8 @@ main = do ...@@ -179,6 +180,8 @@ main = do
-- --
-- * .hi/.o - files produced by ghc -c. -- * .hi/.o - files produced by ghc -c.
-- --
-- * .result - the stdout and stderr output from the build
--
-- Most complication comes from modules not named Main, which still produce -- Most complication comes from modules not named Main, which still produce
-- Main.o object files (I think ghc -M gets these wrong). -- Main.o object files (I think ghc -M gets these wrong).
buildRules :: Nofib -> Rules () buildRules :: Nofib -> Rules ()
...@@ -190,6 +193,15 @@ buildRules Build{..} = do ...@@ -190,6 +193,15 @@ buildRules Build{..} = do
want $ concat want $ concat
[ [s </> "Main" <.> exe, s </> "config.txt"] | t <- tests, let s = output </> t] [ [s </> "Main" <.> exe, s </> "config.txt"] | t <- tests, let s = output </> t]
"//all-results" %> \out -> do
let results = [ s </> "Main" <.> exe <.> "result"
| t <- tests
, let s = output </> t
]
need results
xs <- mapM readFileLines results
writeFileLines out (concat xs)
"//config.txt" %> \out -> do "//config.txt" %> \out -> do
let dir = unoutput out let dir = unoutput out
src <- readFileLines $ dir </> "Makefile" src <- readFileLines $ dir </> "Makefile"
...@@ -200,7 +212,7 @@ buildRules Build{..} = do ...@@ -200,7 +212,7 @@ buildRules Build{..} = do
x:_ -> "MAIN = " ++ x x:_ -> "MAIN = " ++ x
writeFileLines out $ mainMod : convertConfig src writeFileLines out $ mainMod : convertConfig src
("//Main" <.> exe) %> \out -> do ["//Main" <.> exe, "//Main" <.> exe <.> "result"] &%> \[out, result] -> do
deps <- readFile' $ replaceExtension out "deps" deps <- readFile' $ replaceExtension out "deps"
let os = nub [ if isLower $ head $ takeFileName x then replaceExtension out "o" else output </> x let os = nub [ if isLower $ head $ takeFileName x then replaceExtension out "o" else output </> x
| x <- words deps, takeExtension x == ".o"] | x <- words deps, takeExtension x == ".o"]
...@@ -209,13 +221,26 @@ buildRules Build{..} = do ...@@ -209,13 +221,26 @@ buildRules Build{..} = do
let dir = unoutput out let dir = unoutput out
obj = takeDirectory out obj = takeDirectory out
name = takeFileName dir name = takeFileName dir
putNormal $ "==nofib== " ++ name ++ " : time to link " ++ name ++ " follows..." resultHdl <- liftIO $ openFile result WriteMode
withResource r 1 $
cmd_ compiler $ ["-Rghc-timing","-rtsopts","-o", out] ++ os ++ way ++ words (config "SRC_HC_OPTS") -- Add results from object compilation to results output
putNormal $ "==nofib== " ++ name ++ ": size of " ++ name ++ " follows..." forM os $ \o -> do
cmd_ "size" [out] ls <- liftIO $ BS.readFile (o <.> "result")
liftIO $ BS.hPutStr resultHdl ls
["//*.o","//*.hi"] &%> \[o,hi] -> do
-- Link executable
liftIO $ hPutStrLn resultHdl $ "==nofib== " ++ name ++ " : time to link " ++ name ++ " follows..."
Stdouterr out_err <- withResource r 1 $
cmd compiler $ ["-Rghc-timing","-rtsopts","-o", out] ++ os ++ way ++ words (config "SRC_HC_OPTS")
liftIO $ BS.hPutStr resultHdl out_err
liftIO $ hPutStrLn resultHdl $ "==nofib== " ++ name ++ ": size of " ++ name ++ " follows..."
-- Report executable size
Stdout out_err <- cmd "size" [out]
liftIO $ BS.hPutStr resultHdl out_err
liftIO $ hClose resultHdl
["//*.o","//*.hi","//*.o.result"] &%> \[o,hi,result] -> do
let dir = unoutput o let dir = unoutput o
obj = output </> dir obj = output </> dir
config <- readConfig' $ obj </> "config.txt" config <- readConfig' $ obj </> "config.txt"
...@@ -227,11 +252,15 @@ buildRules Build{..} = do ...@@ -227,11 +252,15 @@ buildRules Build{..} = do
need [ if takeExtension r `elem` [".h",".hs",".lhs"] then r else output </> r need [ if takeExtension r `elem` [".h",".hs",".lhs"] then r else output </> r
| lhs:":":rhs <- map words $ deps, dir </> mod <.> "o" == lhs, r <- rhs] | lhs:":":rhs <- map words $ deps, dir </> mod <.> "o" == lhs, r <- rhs]
let name = takeFileName dir let name = takeFileName dir
putNormal $ "==nofib== " ++ name ++ " : time to compile " ++ mod ++ " follows..." resultHdl <- liftIO $ openFile result WriteMode
cmd_ compiler $ ["-Rghc-timing","-c",src,"-w","-i"++obj,"-odir="++obj,"-hidir="++obj] ++ liftIO $ hPutStrLn resultHdl $ "==nofib== " ++ name ++ " : time to compile " ++ mod ++ " follows..."
Stdouterr out_err <- cmd compiler $ ["-Rghc-timing","-c",src,"-w","-i"++obj,"-odir="++obj,"-hidir="++obj] ++
way ++ words (config "SRC_HC_OPTS") way ++ words (config "SRC_HC_OPTS")
putNormal $ "==nofib== " ++ name ++ ": size of " ++ takeFileName o ++ " follows..." liftIO $ BS.hPutStr resultHdl out_err
cmd_ "size" [o] liftIO $ hPutStrLn resultHdl $ "==nofib== " ++ name ++ ": size of " ++ takeFileName o ++ " follows..."
Stdout out_err <- cmd "size" [o]
liftIO $ BS.hPutStr resultHdl out_err
liftIO $ hClose resultHdl
"//Main.deps" %> \out -> do "//Main.deps" %> \out -> do
let dir = unoutput out let dir = unoutput out
......
...@@ -18,6 +18,7 @@ executable nofib-run ...@@ -18,6 +18,7 @@ executable nofib-run
other-extensions: RecordWildCards, DeriveDataTypeable other-extensions: RecordWildCards, DeriveDataTypeable
build-depends: base >=4.11 && <4.12, build-depends: base >=4.11 && <4.12,
time >=1.8 && <1.9, time >=1.8 && <1.9,
bytestring,
directory >=1.3 && <1.4, directory >=1.3 && <1.4,
process >=1.6 && <1.7, process >=1.6 && <1.7,
cmdargs, cmdargs,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment