Permalink
Browse files

Generate the benchmarks list automatically

  • Loading branch information...
1 parent e0a65b2 commit a179ae10361365b5947b7dbffef36366ba1400c1 @dmpots committed Aug 19, 2010
Showing with 193 additions and 42 deletions.
  1. +131 −0 FibonFind.hs
  2. +15 −11 Setup.hs
  3. +47 −0 benchmarks/Fibon/Benchmarks.hs
  4. +0 −31 lib/Fibon/Benchmarks.hs
View
@@ -0,0 +1,131 @@
+module FibonFind(findLocalBenchmarks) where
+--module Main where
+
+import System.Directory
+import Control.Exception
+import System.FilePath
+import System.IO
+import Data.List
+
+{-
+-- for standalone testing
+main = do
+ findLocalBenchmarks "benchmarks"
+-}
+
+benchmarksModule = ["Fibon", "Benchmarks"]
+benchmarksInstanceModule = "Fibon.Instance"
+
+findLocalBenchmarks :: FilePath -> IO ()
+findLocalBenchmarks baseDir = do
+ let searchPath = join ([pathSeparator]) (baseDir : benchmarksModule)
+ putStr $ "Looking for benchmarks in "++searchPath
+ groups <- bmGroups searchPath
+ bms <- bmInstances searchPath groups
+ putStrLn $ "... found ("++ (show.length$ bms)++")"
+ let allGroups = sort groups
+ allBms = (sort . concat) bms
+ qualifiedBms =
+ concat $ zipWith (\g bs -> map ((,)g) (sort bs)) allGroups bms
+ outFile = searchPath ++ ".hs"
+ putStrLn $ "writing benchmark manifest to "++outFile
+ h <- openFile outFile WriteMode
+ hPutStrLn h moduleHeader
+ hPutStrLn h $ moduleImports (join "." benchmarksModule) qualifiedBms
+ hPutStrLn h ""
+ hPutStrLn h $ benchDataDecl allBms
+ hPutStrLn h ""
+ hPutStrLn h $ groupDataDecl allGroups
+ hPutStrLn h ""
+ hPutStrLn h $ allBenchmarksDecl allBms
+ hPutStrLn h ""
+ hPutStrLn h $ benchGroupDecl qualifiedBms
+ hPutStrLn h ""
+ hPutStrLn h $ benchInstanceDecl qualifiedBms
+ hClose h
+
+bmGroups :: FilePath -> IO [FilePath]
+bmGroups baseDir = do
+ dirs <- try (getDirectoryContents baseDir) :: IO (Either IOError [FilePath])
+ case dirs of
+ Left _ -> return []
+ Right ds -> return $ removeDotDirs ds
+
+bmInstances :: FilePath -> [FilePath] -> IO [[String]]
+bmInstances baseDir groups = do
+ let paths = map (baseDir</>) groups
+ bms <- mapM getDirectoryContents paths
+ return (map removeDotDirs bms)
+
+removeDotDirs :: [FilePath] -> [FilePath]
+removeDotDirs = filter (\d -> d /= "." && d /= "..")
+
+moduleHeader :: String
+moduleHeader = join "\n" [
+ "module "++modName++" (",
+ " FibonBenchmark(..)",
+ " , FibonGroup(..)",
+ " , allBenchmarks",
+ " , benchGroup",
+ " , benchInstance",
+ ")",
+ "where",
+ "import Fibon.InputSize",
+ "import Fibon.BenchmarkInstance"
+ ]
+ where
+ modName = join "." benchmarksModule
+
+moduleImports :: String -> [(String, String)] -> String
+moduleImports baseMod bms = join "\n" imports
+ where
+ imports = map importStmt bms
+ importStmt (g,bm) =
+ "import qualified "
+ ++baseMod++"."++g++"."++bm++"."++benchmarksInstanceModule
+ ++" as "++(importAs g bm)
+
+importAs :: String -> String -> String
+importAs _grp modu = modu ++ "_bm"
+
+groupName :: String -> String
+groupName g = g ++ "Group"
+
+benchDataDecl :: [String] -> String
+benchDataDecl [] = ""
+benchDataDecl bms =
+ "data FibonBenchmark =\n " ++
+ (join ("\n | ") bms) ++
+ "\n deriving(Show, Eq, Ord, Enum)"
+
+groupDataDecl :: [String] -> String
+groupDataDecl [] = ""
+groupDataDecl grps =
+ "data FibonGroup =\n " ++
+ (join ("\n | ") (map groupName grps)) ++
+ "\n deriving(Show, Eq, Ord, Enum)"
+
+allBenchmarksDecl :: [String] -> String
+allBenchmarksDecl bms =
+ "allBenchmarks :: [FibonBenchmark]\n"++
+ "allBenchmarks = [\n "++
+ (join ("\n , ") bms) ++
+ "\n ]"
+
+benchGroupDecl :: [(String, String)] -> String
+benchGroupDecl qBms =
+ "benchGroup :: FibonBenchmark -> FibonGroup\n"++
+ (join ("\n") $ map defn qBms)
+ where
+ defn (g,bm) = "benchGroup " ++ bm ++ " = " ++ (groupName g)
+
+benchInstanceDecl :: [(String, String)] -> String
+benchInstanceDecl qBms =
+ "benchInstance :: FibonBenchmark -> InputSize -> BenchmarkInstance\n"++
+ (join ("\n") $ map defn qBms)
+ where
+ defn (g,bm) = "benchInstance " ++ bm ++ " = " ++ (importAs g bm) ++ ".mkInstance"
+
+join :: String -> [String] -> String
+join s ss = concat (intersperse s ss)
+
View
@@ -5,31 +5,33 @@ import Data.List
import System.Directory
import System.FilePath
import System.IO
+import FibonFind
main = defaultMainWithHooks simpleUserHooks {postConf = writeLocalConf, postClean = deleteLocalConf}
writeLocalConf _ _ _ _ = do
- findLocalConfigModules
+ findLocalConfigModules configDir
+ findLocalBenchmarks benchmarkDir
deleteLocalConf _ _ _ _ = do
- safeDelete importsFileName
- safeDelete modulesFileName
+ safeDelete (importsFileName configDir)
+ safeDelete (modulesFileName configDir)
safeDelete :: FilePath -> IO ()
safeDelete f = do
e <- doesFileExist f
when e (removeFile f)
-findLocalConfigModules :: IO ()
-findLocalConfigModules = do
- fs <- getDirectoryContents configDir
+findLocalConfigModules :: FilePath -> IO ()
+findLocalConfigModules cDir = do
+ fs <- getDirectoryContents cDir
putStr "\nLooking for local configuration modules... "
let modNames = map dropExtension $ filter (".hs" `isSuffixOf`) fs
let imports = map importStmt $ modNames
let modules = map importAs $ modNames
putStrLn $ "found ("++ (show.length$ modNames)++")"
- writeToFile importsFileName imports
- writeToFile modulesFileName modules
+ writeToFile (importsFileName cDir) imports
+ writeToFile (modulesFileName cDir) modules
where
importStmt m = "import qualified "++m++" as " ++importAs m
writeToFile fName contents = do
@@ -42,7 +44,9 @@ findLocalConfigModules = do
importAs :: String -> String
importAs modName = modName++"_Config"
-importsFileName, modulesFileName :: FilePath
+configDir, benchmarkDir :: FilePath
configDir = "config"
-importsFileName = configDir </> "LocalConfigImports.txt"
-modulesFileName = configDir </> "LocalConfigModules.txt"
+benchmarkDir = "benchmarks"
+importsFileName, modulesFileName :: FilePath -> FilePath
+importsFileName baseDir = baseDir </> "LocalConfigImports.txt"
+modulesFileName baseDir = baseDir </> "LocalConfigModules.txt"
@@ -0,0 +1,47 @@
+module Fibon.Benchmarks (
+ FibonBenchmark(..)
+ , FibonGroup(..)
+ , allBenchmarks
+ , benchGroup
+ , benchInstance
+)
+where
+import Fibon.InputSize
+import Fibon.BenchmarkInstance
+import qualified Fibon.Benchmarks.Imaginary.Bernouilli.Fibon.Instance as Bernouilli_bm
+import qualified Fibon.Benchmarks.Real.Mines.Fibon.Instance as Mines_bm
+import qualified Fibon.Benchmarks.Spectral.Ansi.Fibon.Instance as Ansi_bm
+import qualified Fibon.Benchmarks.Spectral.Scc.Fibon.Instance as Scc_bm
+
+data FibonBenchmark =
+ Ansi
+ | Bernouilli
+ | Mines
+ | Scc
+ deriving(Show, Eq, Ord, Enum)
+
+data FibonGroup =
+ ImaginaryGroup
+ | RealGroup
+ | SpectralGroup
+ deriving(Show, Eq, Ord, Enum)
+
+allBenchmarks :: [FibonBenchmark]
+allBenchmarks = [
+ Ansi
+ , Bernouilli
+ , Mines
+ , Scc
+ ]
+
+benchGroup :: FibonBenchmark -> FibonGroup
+benchGroup Bernouilli = ImaginaryGroup
+benchGroup Mines = RealGroup
+benchGroup Ansi = SpectralGroup
+benchGroup Scc = SpectralGroup
+
+benchInstance :: FibonBenchmark -> InputSize -> BenchmarkInstance
+benchInstance Bernouilli = Bernouilli_bm.mkInstance
+benchInstance Mines = Mines_bm.mkInstance
+benchInstance Ansi = Ansi_bm.mkInstance
+benchInstance Scc = Scc_bm.mkInstance
@@ -1,31 +0,0 @@
-module Fibon.Benchmarks (
- FibonBenchmark(..)
- , FibonGroup(..)
- , benchGroup
- , benchInstance
- , allBenchmarks
-)
-where
-import Fibon.InputSize
-import Fibon.BenchmarkInstance
-import Fibon.Benchmarks.Spectral.Scc.Fibon.Instance as Scc_bm
-
-data FibonBenchmark =
- Scc
- deriving(Show, Eq, Ord, Enum)
-
-data FibonGroup =
- SpectralGroup
- | RealGroup
- | ImaginaryGroup
- deriving(Show, Eq, Ord, Enum)
-
-allBenchmarks :: [FibonBenchmark]
-allBenchmarks = [Scc]
-
-benchGroup :: FibonBenchmark -> FibonGroup
-benchGroup Scc = SpectralGroup
-
-benchInstance :: FibonBenchmark -> InputSize -> BenchmarkInstance
-benchInstance Scc = Scc_bm.mkInstance
-

0 comments on commit a179ae1

Please sign in to comment.