diff options
Diffstat (limited to 'src/Logstat/Eval.hs')
-rw-r--r-- | src/Logstat/Eval.hs | 35 |
1 files changed, 12 insertions, 23 deletions
diff --git a/src/Logstat/Eval.hs b/src/Logstat/Eval.hs index c9453b5..8e29818 100644 --- a/src/Logstat/Eval.hs +++ b/src/Logstat/Eval.hs @@ -172,7 +172,9 @@ step stmt st ev = case stmt of let StGroup m = st in case mapM (getField ev) f of Left err -> (st, Left err) - Right v -> (StGroup $ Map.insert v () m, Left Filtered) + Right v -> + let m' = Map.insert v () m + in m' `seq` (StGroup m', Left Filtered) final :: Stmt -> State -> [Event] @@ -197,32 +199,19 @@ final stmt st = case stmt of type Step = [State] -> Event -> ([State], Either EvalError Event) stepL :: [Stmt] -> Step -stepL stmts = - -- "materialize" the statements into a list of (State -> Event -> ..) - -- functions. This hopefully causes the pattern matching on the Stmt value to - -- be performed only once, thus speeding up evaluation. But I obviously need - -- to measure the effect of this optimization to see if it even works at all. - let fs = map step stmts in loop fs - where - loop (f:fns) (st:sts) ev = - case f st ev of - (st', Left err) -> (st':sts, Left err) - (st', Right e) -> let (sts', e') = loop fns sts e in (st':sts', e') - loop _ _ ev = ([], Right ev) +stepL (s:stmts) (st:sts) ev = + case step s st ev of + (st', Left err) -> (st':sts, Left err) + (st', Right e) -> let (sts', e') = stepL stmts sts e in (st':sts', e') +stepL _ _ ev = ([], Right ev) finalL :: [Stmt] -> [State] -> [Either EvalError Event] -finalL stmts = - -- Same thing as in stepL - let fns = zip (stepL' stmts) (map final stmts) in loop fns +finalL = loop where - stepL' :: [Stmt] -> [Step] - stepL' [] = [] - stepL' (_:xs) = stepL xs : stepL' xs - - loop (f:fns) (st:sts) = - let (sts', l1) = steps (fst f) sts (snd f st) - l2 = loop fns sts' + loop (s:stmts) (st:sts) = + let (sts', l1) = steps (stepL stmts) sts (final s st) + l2 = loop stmts sts' in l1 ++ l2 loop _ _ = [] |