module HSBencher.Internal.BenchSpace
(BenchSpace(..), enumerateBenchSpace,
benchSpaceSize,
filterBenchmarks, filterBenchmark,
disjunctiveNF)
where
import Data.Maybe
import qualified Data.Set as S
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
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)
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
addAnd :: BenchSpace meaning -> BenchSpace meaning -> BenchSpace meaning
addAnd (Or []) _ = Or []
addAnd x (And ls) = And (x:ls)
addAnd x y = And [x,y]
addOr :: BenchSpace t -> BenchSpace t -> BenchSpace t
addOr (Or []) rst = rst
addOr x (Or ls) = Or (x:ls)
addOr x rst = Or [x,rst]
mkOr :: [BenchSpace meaning] -> BenchSpace meaning
mkOr [] = Or []
mkOr (x : tl) = addOr x (mkOr tl)
intersections :: Ord a => [S.Set a] -> S.Set a
intersections [] = error "No set intersection of the empty list"
intersections [s] = s
intersections (s1:sets) = S.intersection s1 (intersections sets)
bp1 :: BenchSpace DefaultParamMeaning
bp1 = (And [Set (Variant "Reduce") (RuntimeArg "Reduce"),
Set NoMeaning (RuntimeArg "r6") ])
t1 = filtConfigs ["Reduce", "r6"] bp1
t2 = filtConfigs ["Reduce", "r6"] (Or [ bp1, Set NoMeaning (RuntimeEnv "FOO" "r6") ])