> module Benchmark      (  time, timeIt,  showMilliSeconds,
>                          benchmark
>                       )
> where



> import LibCPUTime



> import IOSupport
> import Support



> time                  :: IO a -> IO ()
> time cmd              =  timeIt cmd                           >>= \t ->
>                          putLine (showMilliSeconds t)



> timeIt                :: IO a -> IO Integer
> timeIt cmd            =  getCPUTime                           >>= \t1 ->
>                          cmd                                  >>
>                          getCPUTime                           >>= \t2 ->
>                          return (milliSeconds (t2 - t1))
>     where
>     milliSeconds t    =  (t + 500000) `div` 1000000



> showMilliSeconds              :: Integer -> String
> showMilliSeconds t            =  show (t `div` 1000) ++ "." ++ frac
>     where ms                  =  t `mod` 1000
>           frac | ms < 10      =  "00" ++ show ms
>                | ms < 100     =  "0"  ++ show ms
>                | otherwise    =          show ms



> benchmark competitors generators context seed =
>     putTitle "Running programs"                               >>
>     accumulate [
>         accumulate [
>             putStr ("** Running " ++ strc
>                     ++ " on " ++ strg ++ "\n")                >>
>             timeIt ((print . context. c. g) seed)
>         | (strc,c)<-competitors ]
>     | (strg,g)<-generators ]                                  >>= \rts ->
>     newLine                                                   >>
>     putTitle "Results"                                        >>
>     printResult (show seed) (map fst competitors)
>                             (map fst generators) rts



> putTitle s    =  putLine (cjustifyWith '*' 78 "")             >>
>                  putLine (cjustifyWith '*' 78 (" "++s++" "))  >>
>                  putLine (cjustifyWith '*' 78 "")             >>
>                  newLine



> printResult cor col0 row0 results     =
>     putStr (formatTable table)                                >>
>     newLine
>     where
>     table                     =
>         (cor : col0 ++ ["*best*"]) :
>         [ e0 : [ showMilliSeconds e | e<-col ] ++ [ bestOf (zip col0 col) ]
>         | (e0, col)<-zip row0 results ]



> bestOf                =  fst . foldl1 min2
>     where
>     min2 p@(_,a) q@(_,b)
>         | a<=b        =  p
>         | otherwise   =  q



> formatTable           :: [[String]] -> String
> formatTable table     =  unlines (map (concat . intersperse "|") lines)
>     where lines       =  transpose [
>                              [ " " 
>                                ++ rjustify (maximum [ length e | e<-col ]) e
>                                ++ " "
>                              | e<-col ]
>                          | col<-table ]