Commit 98aeb07c authored by Andreas Klebinger's avatar Andreas Klebinger

wip: Remove MAIN logic

parent 2ccc81cd
......@@ -34,7 +34,7 @@ import qualified ParseResults
import qualified CachegrindParse
import qualified PerfStatParse
-- import Utils
import Utils
import Debug.Trace
import Control.DeepSeq
......@@ -190,6 +190,8 @@ buildRules nofib@Build{..} = do
let resultDir :: TestName -> FilePath
resultDir (TestName t) = output </> t
-- Well turn _make/test/gc/linear/Matlib.o into gc/linear
-- that is it gives us the test part of the path
unoutput :: String -> TestName
unoutput =
let f path
......@@ -258,8 +260,8 @@ buildRules nofib@Build{..} = do
let deps = foldMap (\config -> words $ config "SRC_DEPS") configs
-- TODO: Invoking cabal in the way we do without any package argument fails.
root <- liftIO $ IO.makeAbsolute buildDepsRoot
unless (null deps) $ cmd_ "cabal" ("--store-dir=" <> root) "v2-install" "--lib" "-w" compiler "--allow-newer" deps
-- cmd_ "cabal" ("--store-dir=" <> root) "v2-install" "--lib" "-w" compiler "--allow-newer" deps
unless (null deps)
$ cmd_ "cabal" ("--store-dir=" <> root) "v2-install" "--lib" "-w" compiler "--allow-newer" deps ("-j"<> show threads)
liftIO $ writeFile out ""
-- Benchmark rules
......@@ -276,24 +278,30 @@ buildRules nofib@Build{..} = do
-- Main.exe : Link object files
["//Main" <.> exe, "//Main.link.tsv"] &%> \[out, resultsTsv] -> do
let test = unoutput out :: TestName
-- dir = testDir test :: FilePath
-- !config <- getTestConfig nofib test
-- let make_srcs = words $ config "SRCS"
src_dir = testDir test -- eg. spectral/simple
obj_dir = output </> src_dir -- eg. _make/foo/spectral/simple
config <- getTestConfig nofib test
let config_srcs = words $ config "SRCS"
-- let isSrcFile f = do
-- is_file <- doesFileExist f
-- let is_src = takeExtension f `elem` [".hs", ".lhs", ".c"]
-- return $! is_file && is_src
need [replaceFileName out ".depends"]
-- need [replaceFileName out ".depends"]
-- printM $ "output:" ++ output
-- haskell object files from .depends file
deps <- readFile' $ replaceFileName out ".depends"
-- printM $ "deps:" ++ show deps
-- printM $ "words:" ++ show (words deps)
let objs = nub [ output </> x
-- Foo.o => _make/test/bench/Foo.o
| x <- words deps, takeExtension x == ".o"]
objs <-
if null config_srcs
then do
deps <- readFile' $ replaceFileName out ".depends"
return $ nub
[ output </> x -- Foo.o => _make/test/bench/Foo.o
| x <- words deps, takeExtension x == ".o"]
else do
map (obj_dir </>) <$> mapM oFromSrc config_srcs
-- As I understand it the make build system defaults to scanning the benchmark folder
-- for source files. So we do the same.
......@@ -336,37 +344,54 @@ buildRules nofib@Build{..} = do
<> Ms.singleton (testLabel test <> ml "executable size") (realToFrac execSize)
-- Compile object code
["//*.o","//*.hi","//*.o.compile.tsv"] &%> \[o, _hi, resultsTsv] -> do
["_make//*.o","_make//*.hi","_make//*.o.compile.tsv"] &%> \[o, _hi, resultsTsv] -> do
liftIO $ print o
let test = unoutput o
dir = testDir test
obj = output </> dir
let test = unoutput o -- eg. TestName "spectral/simple"
src_dir = testDir test -- eg. spectral/simple
obj_dir = output </> src_dir -- eg. _make/foo/spectral/simple
o_name = drop (length obj_dir + 1) o -- eg. Main.o
printM "readConfig"
config <- readConfig' $ obj </> "config.txt"
config <- readConfig' $ obj_dir </> "config.txt"
printM $ "o:" ++ o
printM $ "test:" ++ show test
printM $ "obj_dir:" ++ obj_dir
printM $ "src_dir:" ++ src_dir
printM $ "o_name:" ++ o_name
-- Needed for build dependencies/src files
need $ [obj_dir </> ".depends"]
-- But we only care about lines starting with the current .o file
deps <- filter (\x -> head (words x) `equalFilePath` (src_dir </> o_name)) <$>
readFileLines (obj_dir </> ".depends")
printM $ "deps:"
printM $ deps
liftIO $ print "FooBar"
-- Figure out source location
let modName =
let x = dropExtension $ drop (length obj + 1) o
in if x == "Main" then dropExtension $ config "MAIN" else x
src <- do b <- doesFileExist $ dir </> modName <.> "hs"
return $ dir </> modName <.> (if b then "hs" else "lhs")
-- For Main.o it's recording in .config
-- For haskell sources in .depends
-- Otherwise it should be foo.c for any foo.o
let src = fromMaybe (getCSrc o_name src_dir)
(getMainSrc o_name src_dir config <|> getHaskellSrcFromDeps (src_dir </> o_name) deps)
printM $ "src1:" ++ src
-- src <- do b <- doesFileExist $ src_dir </> o_name <.> "hs"
-- return $ src_dir </> o_name <.> (if b then "hs" else "lhs")
printM $ "mod_name:" ++ o_name
printM $ "src:" ++ src
-- Figure out build dependencies
need $ [obj </> ".depends"]
deps <- readFileLines $ obj </> ".depends"
-- Figure out build dependencies
let mkNeed rhs =
if takeExtension rhs `elem` [".h",".hs",".lhs"]
if takeExtension rhs `elem` [".hs",".lhs"]
then replaceExtension rhs ".o"
else output </> rhs
let needs = [ mkNeed r
| lhs:":":rhss <- map words $ deps
, -- equalFilePath is required so that foo/bar and foo\bar match.
-- This can happen on windows.
equalFilePath (dir </> modName <.> "o") lhs
equalFilePath (src_dir </> o_name) lhs
, r <- rhss
-- For a dependency of Main.o : Main.hs there is nothing to do
, not (equalFilePath r src)
......@@ -380,7 +405,7 @@ buildRules nofib@Build{..} = do
let ghc_rts_args = [ "+RTS", "--machine-readable", "-t"++o++".stats" ]
compileArgs <- getTestCompileArgs nofib test
deps_args <- buildDepsArgs test
() <- cmd compiler $ ["-Rghc-timing","-c",src,"-w","-i"++obj,"-odir="++obj,"-hidir="++obj]
() <- cmd compiler $ ["-Rghc-timing","-c",src,"-w","-i"++obj_dir,"-odir="++obj_dir,"-hidir="++obj_dir]
++ compileArgs ++ compiler_args ++ deps_args ++ ghc_rts_args
-- Measure code size
......@@ -396,13 +421,17 @@ buildRules nofib@Build{..} = do
-- Compute build dependencies
"//.depends" %> \out -> do
let test = unoutput out
src_dir = testDir test -- eg. spectral/simple
config <- readConfig' $ takeDirectory out </> "config.txt"
compileArgs <- getTestCompileArgs nofib test
deps_args <- buildDepsArgs test
hs_files <- map (src_dir </>) <$> getDirectoryFiles src_dir ["//*.hs", "//*.lhs"]
cmd_ compiler $
[ "-w"
, "-M",testDir test </> config "MAIN"
, "-i" ++ testDir test
, "-M",unwords hs_files--src_dir </> config "MAIN"
, "-i" ++ src_dir
, "-dep-makefile=" ++ out
, "-dep-suffix", ""
] ++ compileArgs ++
......@@ -482,16 +511,17 @@ runTest nofib@Build{..} runMode resultsTsv = do
-- Build executable first
need [takeDirectory resultsTsv </> "config.txt", replaceExtensions resultsTsv exe]
let test = testFromResultTsv nofib resultsTsv :: TestName
src_dir = testDir test
-- Construct benchmark invocation
(stdin, args) <- liftIO $ getTestCmdline nofib test
executable <- liftIO $ IO.canonicalizePath $ output </> testDir test </> "Main" <.> exe
executable <- liftIO $ IO.canonicalizePath $ output </> src_dir </> "Main" <.> exe
-- Create stats.0, stats.1, etc.
let doRun :: Int -> Action ()
doRun n = do
let rtsStatsOut = executable <.> "stats" <.> show n
cmd_ (Cwd $ testDir test) (EchoStdout False) (StdinBS stdin)
cmd_ (Cwd $ src_dir) (EchoStdout False) (StdinBS stdin)
(getWrapperArgs runMode $ n)
executable args "+RTS" rts_args "--machine-readable" ("-t"++rtsStatsOut)
......@@ -569,16 +599,6 @@ readRtsStats fname = do
rtsStats <- ParseResults.parseRtsStats <$> readFile fname
return $ Ms.fromList $ map (first Ms.mkLabel) $ M.toList rtsStats
-- | Turn Foo.[hs|lhs|c] into Foo.o
oFromSrc :: FilePath -> FilePath
oFromSrc src
| (file,ext) <- splitExtension src
, ext `elem` [".hs", ".lhs", ".c"]
= addExtension file "o"
| otherwise
= fail $ "Failed to derive object file name from:" ++ src
---------------------------------------------------------------------
-- CONFIGURATION UTILITIES
......
module Utils (fuseConts) where
module Utils where
import Control.Monad
import System.FilePath as IO
import Development.Shake
import Prelude hiding (lines)
-- If we have "foo\\\n bar" we want to interpret this as a single line "foo bar"
-- so this is what we do here.
-- Lines are usually short so the performance shouldn't really matter.
maybeCont :: String -> Maybe String
maybeCont s
| "\n\\" <- take 2 (reverse s)
, cont <- reverse $ drop 2 (reverse s)
= Just cont
| otherwise
= Nothing
fuseConts :: [String] -> [String]
fuseConts [] = []
fuseConts xs
| (conts, xs') <- grabConts xs []
= concat conts : fuseConts xs'
where
grabConts :: [String] -> [String] -> ([String], [String])
grabConts (x:xs) r
| Just c <- maybeCont x
= grabConts xs (c:r)
| otherwise
= (reverse r, (x:xs))
grabConts [] r = (reverse r, [])
-------------------------------------------------------------------------------
-- Finding source files for a given .o file
-------------------------------------------------------------------------------
-- | dropPathPrefix "foo" "foo/bar" == "bar"
dropPathPrefix :: [Char] -> [Char] -> FilePath
dropPathPrefix prefix path =
let path_segments = splitPath path
prefix_segments = splitPath prefix
filter_segments (pre:pres) (seg:segs)
| equalFilePath pre seg
= filter_segments pres segs
filter_segments _ segs = segs
in joinPath $ filter_segments prefix_segments path_segments
-- | Try to find the source in the .depends file
--
-- E.g. gc/linear/Matrix.o => Just gc/linear/Matrix.lhs
getHaskellSrcFromDeps :: String -> [String] -> Maybe String
getHaskellSrcFromDeps _ [] = Nothing
getHaskellSrcFromDeps o_file (x:xs)
-- Look for Foo.o : Foo.[l]hs
| (lhs : ":" : rhs : _) <- words x
, dropExtension lhs `equalFilePath` dropExtension rhs
= Just rhs
| otherwise = getHaskellSrcFromDeps o_file xs
-- There is always one Main.o file for which the source file is recorded
-- in the .config file
getMainSrc :: String -> String -> (String -> String) -> Maybe String
getMainSrc "Main.o" dir config = Just $! (dir </> (config "MAIN"))
getMainSrc _ _ _ = Nothing
-- | Generic case, for foo.o look for foo.c
--
-- Haskell source files should be recorded in the .depends file
-- so only C files should remain.
-- No maybe as a source file is required. We just
-- fail if we can't find it.
getCSrc :: String -> String -> String
getCSrc o_file dir = dir </> replaceExtension o_file ".c"
-------------------------------------------------------------------------------
-- Deriving the name of the .o file a given source file
-------------------------------------------------------------------------------
-- | Turn Foo.[hs|lhs|c] into Foo.o
oFromSrc :: FilePath -> Action FilePath
oFromSrc src = do
let (file,ext) = splitExtension src
unless (ext `elem` [".hs", ".lhs", ".c"]) $
putWarn $ "Unknown source type " ++ ext
return $ replaceExtension file "o"
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