Skip to content

Commit

Permalink
Merge aeed08a into 8fa668b
Browse files Browse the repository at this point in the history
  • Loading branch information
@bobzhang
bobzhang committed Jan 5, 2018
2 parents 8fa668b + aeed08a commit 69c90ec
Show file tree
Hide file tree
Showing 15 changed files with 511 additions and 230 deletions.
6 changes: 4 additions & 2 deletions jscomp/others/bs_Set.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,13 +69,15 @@ let addArray (type elt) (type id) (m : (elt,id) t) e =
let dict, data = B.(dict m, data m) in
let module M = (val dict) in
let newData = I.addArray0 ~cmp:M.cmp data e in
B.bag ~dict ~data:newData
if newData == data then m
else B.bag ~dict ~data:newData

let removeArray (type elt) (type id) (m : (elt,id) t) e =
let dict, data = B.(dict m, data m) in
let module M = (val dict) in
let newData = I.removeArray0 ~cmp:M.cmp data e in
B.bag ~dict ~data:newData
if newData == data then m
else B.bag ~dict ~data:newData

let singleton dict e =
B.bag ~dict
Expand Down
157 changes: 67 additions & 90 deletions jscomp/others/bs_internalAVLset.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,11 +7,12 @@ type 'elt node = {
}
[@@bs.deriving abstract]

module A = Bs_Array

external toOpt : 'a Js.null -> 'a option = "#null_to_opt"
external return : 'a -> 'a Js.null = "%identity"
external empty : 'a Js.null = "#null"

external unsafeCoerce : 'a Js.null -> 'a = "%identity"
type ('elt, 'id) t0 = 'elt node Js.null
(* Sets are represented by balanced binary trees (the heights of the
children differ by at most 2 *)
Expand Down Expand Up @@ -52,77 +53,54 @@ let heightGe l r =
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. *)
(* FIXME: bal should return [node] instead of [_ t0] *)
(* TODO: inline all [create] operation, save duplicated [h] calcuation *)
let bal l v r =
let hl = match toOpt l with None -> 0 | Some n -> h n in
let hr = match toOpt r with None -> 0 | Some n -> h n in
if hl > hr + 2 then begin
match toOpt l with
| None -> assert false
| Some n (* Node(ll, lv, lr, _) *) ->
let ll,lv,lr = left n, key n, right n in
if heightGe ll lr then
create ll lv (create lr v r)
else begin
match toOpt lr with
None -> assert false
| Some n (* (lrl, lrv, lrr, _) *) ->
let lrl, lrv, lrr = left n, key n, right n in
create (create ll lv lrl) lrv (create lrr v r)
end
let n = unsafeCoerce l in (* [l] could not be empty *)
let ll,lv,lr = left n, key n, right n in
if heightGe ll lr then
create ll lv (create lr v r)
else begin
let n = unsafeCoerce lr in (* [lr] could not be empty*)
let lrl, lrv, lrr = left n, key n, right n in
create (create ll lv lrl) lrv (create lrr v r)
end
end else if hr > hl + 2 then begin
match toOpt r with
None -> assert false
| Some n (* (rl, rv, rr, _) *) ->
let rl,rv,rr = left n, key n, right n in
if heightGe rr rl then
create (create l v rl) rv rr
else begin
match toOpt rl with
None -> assert false
| Some n (* (rll, rlv, rlr, _)*) ->
let rll, rlv, rlr = left n, key n, right n in
create (create l v rll) rlv (create rlr rv rr)
end
let n = unsafeCoerce r in (* [r] could not be empty *)
let rl,rv,rr = left n, key n, right n in
if heightGe rr rl then
create (create l v rl) rv rr
else begin
let n = unsafeCoerce rl in (* [rl] could not be empty *)
let rll, rlv, rlr = left n, key n, right n in
create (create l v rll) rlv (create rlr rv rr)
end
end else
return @@ node ~left:l ~key:v ~right:r ~h:(if hl >= hr then hl + 1 else hr + 1)

let singleton0 x = return @@ node ~left:empty ~key:x ~right:empty ~h:1

(* Beware: those two functions assume that the added v is *strictly*
smaller (or bigger) than all the present elements in the tree; it
does not test for equality with the current min (or max) element.
Indeed, they are only used during the "join" operation which
(* [addMinElement v n] and [addMaxElement v n]
assume that the added v is *strictly*
smaller (or bigger) than all the present elements in the tree.
They are only used during the "join" operation which
respects this precondition.
*)

let rec add_min_element v n =
let rec addMinElement v n =
match toOpt n with
| None -> singleton0 v
| Some n (* (l, x, r, h)*) ->
bal (add_min_element v (left n)) (key n) (right n)
| Some n ->
bal (addMinElement v (left n)) (key n) (right n)

let rec add_max_element v n =
let rec addMaxElement v n =
match toOpt n with
| None -> singleton0 v
| Some n (* (l, x, r, h)*) ->
bal (left n) (key n) (add_max_element v (right n))

(* Same as create and bal, but no assumptions are made on the
relative heights of l and r. *)

let rec join ln v rn =
match (toOpt ln, toOpt rn) with
(None, _) -> add_min_element v rn (* could be inlined *)
| (_, None) -> add_max_element v ln (* could be inlined *)
| Some l, Some r ->
let lh = h l in
let rh = h r in
if lh > rh + 2 then bal (left l) (key l) (join (right l) v rn) else
if rh > lh + 2 then bal (join ln v (left r)) (key r) (right r) else
create ln v rn
| Some n ->
bal (left n) (key n) (addMaxElement v (right n))

(* Smallest and greatest element of a set *)
let rec min0Aux n =
match toOpt (left n) with
| None -> key n
Expand All @@ -143,7 +121,7 @@ let rec max0Aux n =
| None -> key n
| Some n -> max0Aux n

let maxOpt0 n =
let maxOpt0 n =
match toOpt n with
| None -> None
| Some n -> Some (max0Aux n)
Expand All @@ -152,46 +130,53 @@ let maxNull0 n =
match toOpt n with
| None -> Js.null
| Some n -> return (max0Aux n)
(* Remove the smallest element of the given set *)

let rec removeMinAux n =
let rec removeMinAuxWithRef n v =
let rn, ln = right n, left n in
match toOpt ln with
| None -> rn
| Some ln -> bal (removeMinAux ln) (key n) rn
| None -> v:= key n ; rn
| Some ln -> bal (removeMinAuxWithRef ln v) (key n) rn



(* Merge two trees l and r into one.
All elements of l must precede the elements of r.
Assume | height l - height r | <= 2. *)

let merge t1 t2 =
match (toOpt t1, toOpt t2) with
(None, _) -> t2
| (_, None) -> t1
| (_, Some t2n) -> bal t1 (min0Aux t2n) (removeMinAux t2n)
(* [join ln v rn] return a balanced tree simliar to [create ln v rn]
bal, but no assumptions are made on the
relative heights of [ln] and [rn]. *)

(* Merge two trees l and r into one.
All elements of l must precede the elements of r.
let rec join ln v rn =
match (toOpt ln, toOpt rn) with
(None, _) -> addMinElement v rn
| (_, None) -> addMaxElement v ln
| Some l, Some r ->
let lh = h l in
let rh = h r in
if lh > rh + 2 then bal (left l) (key l) (join (right l) v rn) else
if rh > lh + 2 then bal (join ln v (left r)) (key r) (right r) else
create ln v rn

(* [concat l r]
No assumption on the heights of l and r. *)

let concat t1 t2 =
match (toOpt t1, toOpt t2) with
(None, _) -> t2
| (_, None) -> t1
| (_, Some t2n) -> join t1 (min0Aux t2n) (removeMinAux t2n)
| (_, Some t2n) ->
let v = ref (key t2n ) in
let t2r = removeMinAuxWithRef t2n v in
join t1 !v t2r

(* Implementation of the set operations *)

let empty0 = empty

let isEmpty0 n = match toOpt n with Some _ -> false | None -> true

let rec cons_enum s e =
let rec toEnum s e =
match toOpt s with
None -> e
| Some n (* Node(l, v, r, _) *)
-> cons_enum (left n) (More( key n, right n, e))
| Some n
-> toEnum (left n) (More( key n, right n, e))


let rec iter0 n f =
Expand All @@ -200,6 +185,7 @@ let rec iter0 n f =
| Some n ->
iter0 (left n) f; f (key n) [@bs]; iter0 (right n) f


let rec fold0 s accu f =
match toOpt s with
| None -> accu
Expand Down Expand Up @@ -268,17 +254,17 @@ let rec length0 n =
| Some n ->
cardinalAux n

let rec elements_aux accu n =
let rec toListAux accu n =
match toOpt n with
| None -> accu
| Some n ->
let l,k,r = left n, key n, right n in
elements_aux
(k :: elements_aux accu r)
toListAux
(k :: toListAux accu r)
l

let toList0 s =
elements_aux [] s
toListAux [] s

let rec checkInvariant (v : _ t0) =
match toOpt v with
Expand All @@ -288,7 +274,7 @@ let rec checkInvariant (v : _ t0) =
let diff = height l - height r in
diff <=2 && diff >= -2 && checkInvariant l && checkInvariant r

module A = Bs_Array


let rec fillArray n i arr =
let l,v,r = left n, key n, right n in
Expand All @@ -304,8 +290,7 @@ let rec fillArray n i arr =
| Some r ->
fillArray r rnext arr

(* TODO: binary search tree to array efficiency
*)

let toArray0 n =
match toOpt n with
| None -> [||]
Expand All @@ -317,7 +302,7 @@ let toArray0 n =



external unsafeCoerce : 'a Js.null -> 'a = "%identity"


(*
L rotation, return root node
Expand Down Expand Up @@ -387,14 +372,6 @@ let balMutate nt =
nt
end

(* let rec removeMinAuxMutate n =
let rn, ln = right n, left n in
match toOpt ln with
| None -> rn
| Some ln ->
leftSet n (removeMinAuxMutate ln);
return (balMutate n) *)



let rec removeMinAuxMutateWithRoot nt n =
Expand Down Expand Up @@ -434,6 +411,6 @@ let rec ofSortedArrayAux arr off len =
create left mid right



let ofSortedArrayUnsafe0 arr =
ofSortedArrayAux arr 0 (A.length arr)
26 changes: 16 additions & 10 deletions jscomp/others/bs_internalSet.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ let rec splitAux ~cmp (n : _ N.node) x : _ * bool * _ =
let split0 ~cmp (t : _ t0) x : _ t0 * bool * _ t0 =
match N.toOpt t with
None ->
N.(empty, false, empty)
N.empty, false, N.empty
| Some n ->
splitAux ~cmp n x

Expand All @@ -76,7 +76,15 @@ let rec remove0 ~cmp (t : _ t0) x : _ t0 =
| Some n ->
let l,v,r = N.(left n , key n, right n) in
let c = (Bs_Cmp.getCmp cmp) x v [@bs] in
if c = 0 then N.merge l r else
if c = 0 then
match N.toOpt l, N.toOpt r with
| (None, _) -> r
| (_, None) -> l
| (_, Some rn) ->
let v = ref (N.key rn) in
let r = N.removeMinAuxWithRef rn v in
N.bal l !v r
else
if c < 0 then
let ll = remove0 ~cmp l x in
if ll == l then t
Expand Down Expand Up @@ -150,7 +158,7 @@ let rec diff0 ~cmp s1 s2 =



let rec compare_aux ~cmp e1 e2 =
let rec compareAux ~cmp e1 e2 =
match (e1, e2) with
(End, End) -> 0
| (End, _) -> -1
Expand All @@ -159,21 +167,19 @@ let rec compare_aux ~cmp e1 e2 =
let c = (Bs_Cmp.getCmp cmp) v1 v2 [@bs] in
if c <> 0
then c
else compare_aux ~cmp (N.cons_enum r1 e1) (N.cons_enum r2 e2)
else compareAux ~cmp (N.toEnum r1 e1) (N.toEnum r2 e2)

let cmp0 ~cmp s1 s2 =
compare_aux ~cmp (N.cons_enum s1 End) (N.cons_enum s2 End)
compareAux ~cmp (N.toEnum s1 End) (N.toEnum s2 End)

let eq0 ~cmp s1 s2 =
cmp0 ~cmp s1 s2 = 0

let rec subset0 ~cmp (s1 : _ t0) (s2 : _ t0) =
match N.(toOpt s1, toOpt s2) with
None, _ ->
true
| _, None ->
false
| Some t1 , Some t2 (* Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) *) ->
| None, _ -> true
| _, None -> false
| Some t1 , Some t2 ->
let l1,v1,r1 = N.(left t1, key t1, right t1) in
let l2,v2,r2 = N.(left t2, key t2, right t2) in
let c = (Bs_Cmp.getCmp cmp) v1 v2 [@bs] in
Expand Down

0 comments on commit 69c90ec

Please sign in to comment.