Commit 50e3eef4 authored by POTTIER Francois's avatar POTTIER Francois

Added [MySet], where [add] is optimized and has guaranteed no-replacement

semantics.
Used it in [T.M2].
parent c59272d6
......@@ -287,11 +287,6 @@ end = struct
(* We use a map of [target, z] to a map of [future, a] to facts. *)
(* A minor and subtle optimization: we need not use [source] as part
of the key in [M2], because [future] determines [source]. Indeed,
[future] is (a sub-trie of) the trie generated by [init source],
and every trie contains unique stamps. *)
module M1 =
MyMap(struct
type t = Lr1.node * Terminal.t
......@@ -302,7 +297,7 @@ end = struct
end)
module M2 =
MyMap(struct
MySet.Make(struct
type t = fact
let compare fact1 fact2 =
let c = Trie.compare fact1.future fact2.future in
......@@ -312,7 +307,7 @@ end = struct
Terminal.compare a1 a2
end)
let m : fact M2.t M1.t ref =
let m : M2.t M1.t ref =
ref M1.empty
let count = ref 0
......@@ -321,23 +316,17 @@ end = struct
let z = fact.lookahead in
update_ref m (fun m1 ->
M1.update M2.empty id (target fact, z) m1 (fun m2 ->
M2.update None some fact m2 (function
| None ->
incr count;
fact
| Some earlier_fact ->
(* assert (W.length earlier_fact.word <= W.length fact.word); *)
earlier_fact
)
let m2' = M2.add fact m2 in
if m2 != m2' then
incr count;
m2'
)
)
let query target z f =
match M1.find (target, z) !m with
| m2 ->
M2.iter (fun _ fact ->
f fact
) m2
M2.iter f m2
| exception Not_found ->
()
......
module Make (Ord: Map.OrderedType) =
struct
type elt = Ord.t
type t = Empty | Node of t * elt * t * int
(* Sets are represented by balanced binary trees (the heights of the
children differ by at most 2 *)
let height = function
Empty -> 0
| Node(_, _, _, h) -> h
(* Creates a new node with left son l, value v and right son r.
We must have all elements of l < v < all elements of r.
l and r must be balanced and | height l - height r | <= 2.
Inline expansion of height for better speed. *)
let create l v r =
let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in
let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
Node(l, v, r, (if hl >= hr then hl + 1 else hr + 1))
(* Same as create, but performs one step of rebalancing if necessary.
Assumes l and r balanced and | height l - height r | <= 3.
Inline expansion of create for better speed in the most frequent case
where no rebalancing is required. *)
let bal l v r =
let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in
let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
if hl > hr + 2 then begin
match l with
Empty -> invalid_arg "Set.bal"
| Node(ll, lv, lr, _) ->
if height ll >= height lr then
create ll lv (create lr v r)
else begin
match lr with
Empty -> invalid_arg "Set.bal"
| Node(lrl, lrv, lrr, _)->
create (create ll lv lrl) lrv (create lrr v r)
end
end else if hr > hl + 2 then begin
match r with
Empty -> invalid_arg "Set.bal"
| Node(rl, rv, rr, _) ->
if height rr >= height rl then
create (create l v rl) rv rr
else begin
match rl with
Empty -> invalid_arg "Set.bal"
| Node(rll, rlv, rlr, _) ->
create (create l v rll) rlv (create rlr rv rr)
end
end else
Node(l, v, r, (if hl >= hr then hl + 1 else hr + 1))
(* [add x t] guarantees that it returns [t] (physically unchanged)
if [x] is already a member of [t]. *)
let rec add x = function
Empty -> Node(Empty, x, Empty, 1)
| Node(l, v, r, _) as t ->
let c = Ord.compare x v in
if c = 0 then t else
if c < 0 then
let l' = add x l in
if l == l' then t
else bal l' v r
else
let r' = add x r in
if r == r' then t
else bal l v r'
let empty = Empty
let rec find x = function
Empty -> raise Not_found
| Node(l, v, r, _) ->
let c = Ord.compare x v in
if c = 0 then v
else find x (if c < 0 then l else r)
let rec iter f = function
Empty -> ()
| Node(l, v, r, _) -> iter f l; f v; iter f r
let rec for_every cmp t f =
match t with
Empty -> ()
| Node(l, v, r, _) ->
let c = cmp v in
if c = 0 then begin
(* The desired range includes [v] and may include parts of [l] and [r]. *)
for_every cmp l f;
f v;
for_every cmp r f
end
else if c < 0 then
(* The desired range is below [v], but may include parts of [l]. *)
for_every cmp l f
else
(* The desired range is above [v], but may include parts of [l]. *)
for_every cmp r f
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment