let dispatch max_depth max_split p =
let rec nb_splits = ref 1
and concat depth pol orig d1 b1 d2 b2 =
let rec incr_depth kid =
match orig, kid with
| _, Pnamed(_,p) -> incr_depth p
| Por _, Por _ -> depth
| Pand _, Pand _ -> depth
| _, _ -> depth + 1
in
if (!nb_splits >= max_split) || ((depth >= max_depth) && (max_depth <> 0))
then Bag.elt (if pol then orig else (p_not orig))
else (incr nb_splits ; Bag.concat (d1 (incr_depth b1) b1) (d2 (incr_depth b2) b2))
and choose p bag =
let nb = !nb_splits + (Bag.length bag) - 1
in if nb >= max_split
then Bag.elt p
else (nb_splits := nb ; bag)
and concat_if depth pol orig d c p q =
if (!nb_splits >= max_split) || ((depth >= max_depth) && (max_depth <> 0))
then Bag.elt (if pol then orig else (p_not orig))
else (incr nb_splits ;
Bag.concat
(Bag.map (fun p -> p_implies (p_eq c e_true) p) (d (depth+1) p))
(Bag.map (fun q -> p_implies (p_eq c e_false) q) (d (depth+1) q)))
and dispatch_neg depth = function
| Pfalse -> Bag.empty
| Pnot p -> dispatch_pos depth p
| (Ptrue|Pand _|Piff _|Papp _ |Pforall _) as p -> Bag.elt (p_not p)
| Por(p,q) as full -> concat depth false full dispatch_neg p dispatch_neg q
| Pimplies(h,p)as full -> concat depth false full dispatch_pos h dispatch_neg p
| Pif(c,p,q) as full -> concat_if depth false full dispatch_neg c p q
| Pnamed(a,p) -> Bag.map (fun p -> Pnamed(a,p)) (dispatch_neg depth p)
| Pexists(x,p) -> Bag.map (p_forall x) (dispatch_neg depth p)
| Plet(x,t,p) -> Bag.map (p_let x t) (dispatch_neg depth p)
and dispatch_pos depth = function
| Ptrue -> Bag.empty
| Pnot p -> dispatch_neg depth p
| Papp( "included" , [a;b]) as p -> choose p (StoreInclusion.included a b)
| Papp( "zs_incl" , [a;b]) as p -> choose p (RuntimeInclusion.included a b)
| (Pfalse|Por _|Piff _|Papp _ |Pexists _) as p -> Bag.elt p
| Pimplies(h,p) -> Bag.map (fun p -> p_implies h p) (dispatch_pos depth p)
| Pand(p,q) as full -> concat depth true full dispatch_pos p dispatch_pos q
| Pif(c,p,q) as full -> concat_if depth true full dispatch_pos c p q
| Pnamed(a,p) -> Bag.map (fun p -> Pnamed(a,p)) (dispatch_pos depth p)
| Pforall(x,p) -> Bag.map (p_forall x) (dispatch_pos depth p)
| Plet(x,t,p) -> Bag.map (p_let x t) (dispatch_pos depth p)
in
dispatch_pos 1 p