module HSBencher.Internal.BenchSpace
(BenchSpace(..), enumerateBenchSpace,
benchSpaceSize,
filterBenchmarks, filterBenchmark,
disjunctiveNF)
where
import Data.Maybe
import Data.List
import HSBencher.Types
benchSpaceSize :: BenchSpace a -> Int
benchSpaceSize Set{} = 1
benchSpaceSize (And x) = product $ map benchSpaceSize x
benchSpaceSize (Or x) = sum $ map benchSpaceSize x
enumerateBenchSpace :: BenchSpace a -> [ [(a,ParamSetting)] ]
enumerateBenchSpace bs =
case bs of
Set m p -> [ [(m,p)] ]
Or ls -> concatMap enumerateBenchSpace ls
And ls -> loop ls
where
loop [] = [ [] ]
loop [lst] = enumerateBenchSpace lst
loop (hd:tl) =
let confs = enumerateBenchSpace hd in
[ c++r | c <- confs
, r <- loop tl ]
filterBenchmarks :: [String]
-> [Benchmark DefaultParamMeaning] -> [Benchmark DefaultParamMeaning]
filterBenchmarks [] = id
filterBenchmarks patterns = mapMaybe fn
where
fn b = case filterBenchmark patterns b of
Benchmark{configs} | configs == Or[] -> Nothing
| otherwise -> Just b
filterBenchmark :: [String]
-> Benchmark DefaultParamMeaning -> Benchmark DefaultParamMeaning
filterBenchmark patterns orig@Benchmark{target,cmdargs,progname,configs} =
let unmet = [ pat | pat <- patterns
, not (isInfixOf pat target ||
isInfixOf pat (fromMaybe "" progname) ||
any (isInfixOf pat) cmdargs) ]
newcfgs = filtConfigs unmet configs
in orig { configs = newcfgs }
filtConfigs :: Show a => [String] -> BenchSpace a -> BenchSpace a
filtConfigs pats bs =
let Or ls = disjunctiveNF bs
in Or [ And as | And as <- ls, andMatch pats as ]
andMatch :: Show a => [String] -> [BenchSpace a] -> Bool
andMatch pats0 ls = null (f pats0 ls)
where
f [] _ = []
f pats [] = pats
f pats (x@Set{} : rst) = let pats' = g pats x
in f pats' rst
f _ (And{} : _) = error "BenchSpace.hs/andMatch: internal invariant broken."
f _ (Or{} : _) = error "BenchSpace.hs/andMatch: internal invariant broken."
g [] Set{} = []
g (hd:pats) (Set ls1 ls2) =
if isInfixOf hd (show ls1) || isInfixOf hd (show ls2)
then g pats (Set ls1 ls2)
else hd : g pats (Set ls1 ls2)
g _ (And{}) = error "BenchSpace.hs/andMatch: internal invariant broken."
g _ (Or{} ) = error "BenchSpace.hs/andMatch: internal invariant broken."
disjunctiveNF :: BenchSpace a -> BenchSpace a
disjunctiveNF = Or . map And . loop
where
loop bs =
case bs of
Set _ _ -> [[bs]]
And [] -> [[]]
And (h:t) -> [ x++y | x <- loop h
, y <- loop (And t) ]
Or ls -> concatMap loop ls
_bp1 :: BenchSpace DefaultParamMeaning
_bp1 = (And [Set (Variant "Reduce") (RuntimeArg "Reduce"),
Set NoMeaning (RuntimeArg "r6") ])
_t1 :: BenchSpace DefaultParamMeaning
_t1 = filtConfigs ["Reduce", "r6"] _bp1
_t2 :: BenchSpace DefaultParamMeaning
_t2 = filtConfigs ["Reduce", "r6"] (Or [ _bp1, Set NoMeaning (RuntimeEnv "FOO" "r6") ])