- node_summaries: (int, int16_unsigned_elt, c_layout) Array1.t;
- }
-
- let dummy_form = Ata.Formula.stay State.dummy
-
- let get_form fetch_trans_cache auto tag q =
- let phi =
- incr fetch_trans_cache_access;
- Cache.N2.find fetch_trans_cache (tag.QName.id :> int) (q :> int)
- in
- if phi == dummy_form then
- let phi = Ata.get_form auto tag q in
- let () =
- Cache.N2.add
- fetch_trans_cache
- (tag.QName.id :> int)
- (q :> int) phi
- in phi
- else begin
- incr fetch_trans_cache_hit;
- phi
- end
-
-
- let eval_form phi fcs nss ps ss summary =
- let open Ata in
- let rec loop phi =
- begin match Formula.expr phi with
- | Boolean.False -> false
- | Boolean.True -> true
- | Boolean.Atom (a, b) ->
- begin
- let open NodeSummary in
- match a.Atom.node with
- | Move (m, q) ->
- b && StateSet.mem q (
- match m with
- `First_child -> fcs
- | `Next_sibling -> nss
- | `Parent | `Previous_sibling -> ps
- | `Stay -> ss
- )
- | Is_first_child -> b == is_left summary
- | Is_next_sibling -> b == is_right summary
- | Is k -> b == (k == kind summary)
- | Has_first_child -> b == has_left summary
- | Has_next_sibling -> b == has_right summary
- end
- | Boolean.And(phi1, phi2) -> loop phi1 && loop phi2
- | Boolean.Or (phi1, phi2) -> loop phi1 || loop phi2
- end
- in
- loop phi
-
-
- let eval_trans_aux auto trans_cache tag summary fcs nss ps sat todo =
- StateSet.fold (fun q (a_sat) ->
- let phi =
- get_form trans_cache auto tag q
- in
- if eval_form phi fcs nss ps a_sat summary then
- StateSet.add q a_sat
- else a_sat
- ) todo sat
-
-
- let rec eval_trans_fix auto trans_cache tag summary fcs nss ps sat todo =
- let new_sat =
- eval_trans_aux auto trans_cache tag summary fcs nss ps sat todo
- in
- if new_sat == sat then sat else
- eval_trans_fix auto trans_cache tag summary fcs nss ps new_sat todo
-
-
- let eval_trans auto fetch_trans_cache eval_cache tag summary fcs nss ps ss todo =
- let fcsid = (fcs.StateSet.id :> int) in
- let nssid = (nss.StateSet.id :> int) in
- let psid = (ps.StateSet.id :> int) in
- let ssid = (ss.StateSet.id :> int) in
- let tagid = (tag.QName.id :> int) in
- let res = Cache.N6.find eval_cache tagid summary ssid fcsid nssid psid in
- incr eval_trans_cache_access;
- if res != dummy_set then begin incr eval_trans_cache_hit; res end
- else let new_sat =
- eval_trans_fix auto fetch_trans_cache tag summary fcs nss ps ss todo
- in
- Cache.N6.add eval_cache tagid summary ssid fcsid nssid psid new_sat;
- new_sat
-
-
-module Make (T : Tree.S) =
- struct
+ node_summaries: (int, int16_unsigned_elt, c_layout) Array1.t;
+ stats : stats;
+}
+
+let dummy_form = Ata.Formula.stay State.dummy
+
+let get_form run tag q =
+ let auto = run.auto in
+ let fetch_trans_cache = run.fetch_trans_cache in
+ let stats = run.stats in
+ let phi =
+ stats.fetch_trans_cache_access <- stats.fetch_trans_cache_access + 1;
+ Cache.N2.find fetch_trans_cache (tag.QName.id :> int) (q :> int)
+ in
+ if phi == dummy_form then
+ let phi = Ata.get_form auto tag q in
+ let () =
+ Cache.N2.add
+ fetch_trans_cache
+ (tag.QName.id :> int)
+ (q :> int) phi
+ in phi
+ else begin
+ stats.fetch_trans_cache_hit <- stats.fetch_trans_cache_hit + 1;
+ phi
+ end
+
+
+let eval_form phi fcs nss ps ss summary =
+ let open Ata in
+ let rec loop phi =
+ begin match Formula.expr phi with
+ | Boolean.False -> false
+ | Boolean.True -> true
+ | Boolean.Atom (a, b) ->
+ begin
+ let open NodeSummary in
+ match a.Atom.node with
+ | Move (m, q) ->
+ b && StateSet.mem q (
+ match m with
+ `First_child -> fcs
+ | `Next_sibling -> nss
+ | `Parent | `Previous_sibling -> ps
+ | `Stay -> ss
+ )
+ | Is_first_child -> b == is_left summary
+ | Is_next_sibling -> b == is_right summary
+ | Is k -> b == (k == kind summary)
+ | Has_first_child -> b == has_left summary
+ | Has_next_sibling -> b == has_right summary
+ end
+ | Boolean.And(phi1, phi2) -> loop phi1 && loop phi2
+ | Boolean.Or (phi1, phi2) -> loop phi1 || loop phi2
+ end
+ in
+ loop phi
+
+
+let eval_trans_aux run tag summary fcs nss ps sat todo =
+ StateSet.fold (fun q (a_sat) ->
+ let phi =
+ get_form run tag q
+ in
+ if eval_form phi fcs nss ps a_sat summary then
+ StateSet.add q a_sat
+ else a_sat
+ ) todo sat
+
+
+let rec eval_trans_fix run tag summary fcs nss ps sat todo =
+ let new_sat =
+ eval_trans_aux run tag summary fcs nss ps sat todo
+ in
+ if new_sat == sat then sat else
+ eval_trans_fix run tag summary fcs nss ps new_sat todo
+
+
+let eval_trans run trans_cache tag summary fcs nss ps ss todo =
+ let stats = run.stats in
+ let fcsid = (fcs.StateSet.id :> int) in
+ let nssid = (nss.StateSet.id :> int) in
+ let psid = (ps.StateSet.id :> int) in
+ let ssid = (ss.StateSet.id :> int) in
+ let tagid = (tag.QName.id :> int) in
+
+ let res = Cache.N6.find trans_cache tagid summary ssid fcsid nssid psid in
+ stats.eval_trans_cache_access <- 1 + stats.eval_trans_cache_access;
+ if res != dummy_set then begin
+ stats.eval_trans_cache_hit <- 1 + stats.eval_trans_cache_hit;
+ res
+ end else let new_sat =
+ eval_trans_fix run tag summary fcs nss ps ss todo
+ in
+ Cache.N6.add trans_cache tagid summary ssid fcsid nssid psid new_sat;
+ new_sat
+
+
+module Make (T : Tree.S) (L : Node_list.S with type node = T.node) =
+struct