Commit 2ccc81cd authored by Andreas Klebinger's avatar Andreas Klebinger

Remove some hopefully dead code

parent 91d05cca
......@@ -2,6 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
module Main(main) where
......@@ -12,6 +13,7 @@ import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Control.Monad.IO.Class
import qualified Data.Map.Strict as M
import qualified System.Directory as IO
import qualified System.FilePath as FP
......@@ -31,8 +33,10 @@ import Measurements (Measurements, Label(..))
import qualified ParseResults
import qualified CachegrindParse
import qualified PerfStatParse
-- import Utils
-- import Debug.Trace
import Debug.Trace
import Control.DeepSeq
-- | A handy shortcut.
ml :: String -> Label
......@@ -43,11 +47,34 @@ ml = Ms.mkLabel
-- | These are directories that contain tests.
testRoots :: [String]
testRoots = words "imaginary spectral real shootout parallel gc smp"
testRoots = words "imaginary spectral real shootout parallel gc smp"
-- | These tests are run by default
defaultRoots :: [String]
defaultRoots = words "imaginary spectral real shootout"
defaultNoFibHcOpts :: [String]
defaultNoFibHcOpts = words "-O2 -Wno-tabs"
{- Note [Target Dependencies]
~~~~~~~~~~~~~~~~~~~~~~~~~~
The main build targets are the "*.results.tsv" files
which will contain compile and runtime metrics.
The results.tsv files depend on the benchmark configuration "config.txt"
and the actual executable.
The config files only depend on the (static) makefiles. They main work to create
them is done by convertConfig.
The executable depends on the ".depends" file which also gives us a list of
require object files, and their dependencies which it also depends on.
For there it's fairly straight forward.
-}
-- -- | These are tests that are under testRoots, but should be skipped (all are skipped by the Makefile system)
-- disabledTests :: [TestName]
-- disabledTests =
......@@ -124,6 +151,7 @@ main = do
removeDirectoryRecursive output
tests' <- getTestDirs tests
-- printM $ tests'
putStrLn $ "Running: " ++ unwords (map unTestName tests')
let shakeOpts = shakeOptions
......@@ -189,8 +217,8 @@ buildRules nofib@Build{..} = do
| t <- tests
, fname <- results
]
liftIO $ print out
liftIO $ print results'
-- liftIO $ print out
-- liftIO $ print results'
need results'
xs <- mapM readFileLines results'
writeFileLines out (concat xs)
......@@ -222,6 +250,9 @@ buildRules nofib@Build{..} = do
cmd_ ghcPkg "init" pkgdb
return [ "-package-db", pkgdb, "-no-user-package-db" ]
-- Build all package dependencies. Write .stamp file to indicate
-- this has been done afterwards. There is currently only one
-- .stamp file per build directory.
buildDepsStamp %> \out -> do
configs <- mapM (getTestConfig nofib) tests
let deps = foldMap (\config -> words $ config "SRC_DEPS") configs
......@@ -243,13 +274,47 @@ buildRules nofib@Build{..} = do
x:_ -> "MAIN = " ++ x
writeFileLines out $ mainMod : convertConfig src
-- Link executable
-- 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"
-- 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"]
-- printM $ "output:" ++ output
-- haskell object files from .depends file
deps <- readFile' $ replaceFileName out ".depends"
let objs = nub [ if isLower $ head $ takeFileName x then replaceExtension out "o" else output </> x
| x <- words deps, takeExtension x == ".o"]
need objs
let test = unoutput out
-- 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"]
-- As I understand it the make build system defaults to scanning the benchmark folder
-- for source files. So we do the same.
-- srcs <- if null make_srcs
-- then do
-- printM $ "DIR:" ++ dir
-- printM "NoSRCS"
-- files <- liftIO $ IO.listDirectory dir
-- liftIO $ mapM_ print files
-- filterM isSrcFile $ map (dir </>) files
-- else
-- printM "SRCS" >>
-- return make_srcs
-- let objs = map oFromSrc srcs
-- printM "USED_SRCS"
-- liftIO $ mapM_ putStrLn srcs
liftIO $ print "OBJS"
liftIO $ mapM_ putStrLn objs
need $ nub objs
-- Metrics from object file compilations
objectResults <- forM objs $ \o -> do
......@@ -277,6 +342,7 @@ buildRules nofib@Build{..} = do
let test = unoutput o
dir = testDir test
obj = output </> dir
printM "readConfig"
config <- readConfig' $ obj </> "config.txt"
liftIO $ print "FooBar"
......@@ -291,8 +357,6 @@ buildRules nofib@Build{..} = do
-- Figure out build dependencies
need $ [obj </> ".depends"]
deps <- readFileLines $ obj </> ".depends"
liftIO $ print "deps:"
liftIO $ print deps
let mkNeed rhs =
if takeExtension rhs `elem` [".h",".hs",".lhs"]
......@@ -416,8 +480,7 @@ runTest :: Nofib
-> Action ()
runTest nofib@Build{..} runMode resultsTsv = do
-- Build executable first
need [takeDirectory resultsTsv </> "config.txt"]
need [replaceExtensions resultsTsv exe]
need [takeDirectory resultsTsv </> "config.txt", replaceExtensions resultsTsv exe]
let test = testFromResultTsv nofib resultsTsv :: TestName
-- Construct benchmark invocation
......@@ -455,7 +518,8 @@ getTestConfig Build{..} test =
getTestCompileArgs :: Nofib -> TestName -> Action [String]
getTestCompileArgs nofib test = do
config <- getTestConfig nofib test
return $ words (config "SRC_HC_OPTS")
return $ defaultNoFibHcOpts
++ words (config "SRC_HC_OPTS")
++ [ "-package-env", "-" ]
++ concat [ ["-package", pkg] | pkg <- words (config "SRC_DEPS") ]
......@@ -505,6 +569,16 @@ 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
......@@ -524,7 +598,7 @@ convertConfig xs =
, let (a,b) = separate x
, a `elem` keep
]
keep = words "PROG_ARGS SRC_HC_OPTS SLOW_OPTS NORM_OPTS FAST_OPTS STDIN_FILE SRC_DEPS SUBDIRS"
keep = words "PROG_ARGS SRCS SRC_HC_OPTS SLOW_OPTS NORM_OPTS FAST_OPTS STDIN_FILE SRC_DEPS SUBDIRS"
separate x = (name,rest)
where (name,x2) = span (\c -> isAlpha c || c == '_') x
......@@ -534,7 +608,9 @@ convertConfig xs =
-- | Read a configuration file (new format) into a function supplying options.
readConfig :: FilePath -> IO (String -> String)
readConfig x = do
-- printM $ "readConfig:" ++ x
src <- fuseLines <$> readFile x
-- !_ <- return $ length src
let res = [ (reverse $ dropWhile isSpace $ reverse a, dropWhile isSpace $ drop 1 b)
| y <- lines src
, let (a,b) = break (== '=') y
......@@ -555,6 +631,7 @@ fuseLines (x:xs) =
-- | readConfig lifted into the Action monad.
readConfig' :: FilePath -> Action (String -> String)
readConfig' x = do
-- printM $ "readConfig':" ++ x
need [x]
liftIO $ readConfig x
......@@ -573,3 +650,5 @@ removeDirectoryRecursive x = do
b <- IO.doesDirectoryExist x
when b $ IO.removeDirectoryRecursive x
printM :: (MonadIO m, Show a) => a -> m ()
printM x = liftIO $ print x
\ No newline at end of file
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
module RunnerTypes where
......@@ -17,6 +18,9 @@ import Development.Shake.FilePath hiding (exe)
import qualified Measurements as Ms
import GHC.Generics
import Control.DeepSeq
import GHC.Read as R
import Text.Read.Lex as L
import Text.ParserCombinators.ReadPrec (pfail)
......@@ -29,7 +33,7 @@ import Text.ParserCombinators.ReadPrec (pfail)
-- * A subpath eg. "real/eff"
-- * A fully qualified path e.g. "spectral/simple"
newtype TestName = TestName { unTestName :: String }
deriving (Show, Eq, Ord, IsString)
deriving (Show, Eq, Ord, IsString, Generic, NFData)
-- | The directory which the given test lives in
testDir :: TestName -> FilePath
......
module Utils (fuseConts) where
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, [])
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