From d277b075c8d3784896ff4d252a137fd7f5905990 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Fri, 30 Nov 2012 00:53:04 +0100
Subject: [PATCH] Optimise recursive Query filters
Currently, the And and Or filters use very nice code, e.g. in case of
OrFilter:
any id <$> mapM evaluateFilter flts
However, looking at the memory profiles shows that application of
any/id to monadic values via '<$>' does not work nicely, losing the
'early' success property. This results in too much memory being used
for thunks in monadic sequencing.
Rather than trying to add more strictness (not sure exactly how, TBH),
switching these to explicit recursion solves the problem, since we
take the 'early' exit problem in our hands and we are explicit about
it.
Memory usage in case of big (e.g. 1000 'Or' elements) is reduced
significantly, and thus also the runtime.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Michele Tartara <mtartara@google.com>
---
htools/Ganeti/Query/Filter.hs | 22 ++++++++++++++++++----
1 file changed, 18 insertions(+), 4 deletions(-)
diff --git a/htools/Ganeti/Query/Filter.hs b/htools/Ganeti/Query/Filter.hs
index d5e56f708..94f65c9a0 100644
--- a/htools/Ganeti/Query/Filter.hs
+++ b/htools/Ganeti/Query/Filter.hs
@@ -144,14 +144,28 @@ containsFilter (NumericValue val) lst = do
-- | Verifies if a given item passes a filter. The runtime context
-- might be missing, in which case most of the filters will consider
-- this as passing the filter.
+--
+-- Note: we use explicit recursion to reduce unneeded memory use;
+-- 'any' and 'all' do not play nice with monadic values, resulting in
+-- either too much memory use or in too many thunks being created.
evaluateFilter :: ConfigData -> Maybe b -> a
-> Filter (FieldGetter a b)
-> ErrorResult Bool
evaluateFilter _ _ _ EmptyFilter = Ok True
-evaluateFilter c mb a (AndFilter flts) =
- all id <$> mapM (evaluateFilter c mb a) flts
-evaluateFilter c mb a (OrFilter flts) =
- any id <$> mapM (evaluateFilter c mb a) flts
+evaluateFilter c mb a (AndFilter flts) = helper flts
+ where helper [] = Ok True
+ helper (f:fs) = do
+ v <- evaluateFilter c mb a f
+ if v
+ then helper fs
+ else Ok False
+evaluateFilter c mb a (OrFilter flts) = helper flts
+ where helper [] = Ok False
+ helper (f:fs) = do
+ v <- evaluateFilter c mb a f
+ if v
+ then Ok True
+ else helper fs
evaluateFilter c mb a (NotFilter flt) =
not <$> evaluateFilter c mb a flt
evaluateFilter c mb a (TrueFilter getter) =
--
GitLab