[Add analyse Roman Leshchinskiy **20091124113107 Ignore-this: 6b1397886aabc7d3746eff084889c8e5 ] addfile ./Analyse.hs hunk ./Analyse.hs 1 +module Main where + +import Criterion.Measurement ( secs ) +import qualified Data.Map as M +import Data.List ( nub ) +import Text.Read +import System.Environment ( getArgs ) +import Control.Monad ( liftM ) + +main = do + [file] <- getArgs + bs <- readLog file + putStrLn "" + putStrLn $ htmlTable + $ fmap secs + $ mkTable bs + putStrLn "" + +data Cfg = Cfg { + cfgLibrary :: String + , cfgSubsystem :: String + , cfgDatatype :: String + } + deriving ( Eq, Ord ) + +instance Show Cfg where + showsPrec _ cfg = showString (cfgLibrary cfg) + . sub (cfgSubsystem cfg) + . showChar '.' . showString (cfgDatatype cfg) + where + sub "" = id + sub s = showChar '.' . showString s + +data Entry a = Entry { + eCfg :: Cfg + , eName :: String + , eData :: a + } + +data Table a = Table { + tRows :: [String] + , tColumns :: [Cfg] + , tCells :: M.Map String (Row a) + } +type Row a = M.Map Cfg a + +instance Functor Table where + fmap f t = t { tCells = fmap (fmap f) (tCells t) } + +mkTable :: [Entry a] -> Table a +mkTable es = Table { + tRows = nub $ map eName es + , tColumns = nub $ map eCfg es + , tCells = M.fromListWith M.union [(eName e, unit e) | e <- es] + } + where + unit e = M.singleton (eCfg e) (eData e) + +cells :: Table a -> [(String, [Maybe a])] +cells (Table { tRows = names + , tColumns = cfgs + , tCells = t }) = concatMap row_cells names + where + row_cells name = case M.lookup name t of + Just row -> [(name, map (cell row) cfgs)] + Nothing -> [] + + cell row cfg = M.lookup cfg row + +htmlTable :: Table String -> String +htmlTable t = concat + [ "" + , tr $ concatMap th ("" : map show (tColumns t)) + , concatMap (tr . row) (cells t) + , "

" + ] + where + row (s, cs) = th s ++ concatMap cell cs + cell Nothing = td "" + cell (Just s) = td s + + tr s = "" ++ s ++ "" + + th s = "" ++ s ++ "" + td s = "" ++ s ++ "" + + + +newtype Benchmark = Benchmark { unBenchmark :: Entry Double } + +readLog :: FilePath -> IO [Entry Double] +readLog file = (proc_lines . lines) `liftM` readFile file + where + proc_lines (h : r) + | h == header = map (unBenchmark . read) r + | otherwise = error "Invalid file" + + header = "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB" + + +instance Read Benchmark where + readPrec = do + tag <- readPrec + comma + mean <- readPrec + comma + readPrec :: ReadPrec Double -- meanlb + comma + readPrec :: ReadPrec Double -- meanub + comma + readPrec :: ReadPrec Double -- stddev + comma + readPrec :: ReadPrec Double -- stddevlb + comma + readPrec :: ReadPrec Double -- stddevub + case split_tag tag of + (library, subsystem, datatype, name) + -> return $ Benchmark + $ Entry { + eCfg = Cfg { cfgLibrary = library + , cfgSubsystem = subsystem + , cfgDatatype = datatype + } + , eName = name + , eData = mean + } + where + comma = do + c <- get + if c == ',' then return () else pfail + + split_tag s = case split '/' s of + [library,subsystem,datatype,benchmark] + -> (library,subsystem,datatype,benchmark) + [library,datatype,benchmark] + -> (library,"",datatype,benchmark) + + split c xs = case span (/= c) xs of + (ys,[]) -> [ys] + (ys, _ : zs) -> ys : split c zs + hunk ./kernels.cabal 25 +Executable analyse + Main-Is: Analyse.hs + + Build-Depends: + base >= 3 && < 5, + criterion, + containers +