Source file Belt_internalSetString.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
type value = string

module S = Belt_SortArrayString
module N = Belt_internalAVLset
module A = Belt_Array

type t = value N.t

let rec has (t : t) (x : value) =
  match N.toOpt t with
  | None -> false
  | Some n ->
      let v = N.value n in
      x = v || has (if x < v then N.left n else N.right n) x

let rec compareAux e1 e2 =
  match (e1, e2) with
  | h1 :: t1, h2 :: t2 ->
      let (k1 : value), k2 = (N.value h1, N.value h2) in
      if k1 = k2 then compareAux (N.stackAllLeft (N.right h1) t1) (N.stackAllLeft (N.right h2) t2)
      else if k1 < k2 then -1
      else 1
  | _, _ -> 0

let cmp s1 s2 =
  let len1, len2 = (N.size s1, N.size s2) in
  if len1 = len2 then compareAux (N.stackAllLeft s1 []) (N.stackAllLeft s2 []) else if len1 < len2 then -1 else 1

let eq (s1 : t) s2 = cmp s1 s2 = 0

let rec subset (s1 : t) (s2 : t) =
  match
    let open N in
    (toOpt s1, toOpt s2)
  with
  | None, _ -> true
  | _, None -> false
  | Some t1, Some t2 ->
      let l1, v1, r1 =
        let open N in
        (left t1, value t1, right t1)
      in
      let l2, v2, r2 =
        let open N in
        (left t2, value t2, right t2)
      in
      if v1 = v2 then subset l1 l2 && subset r1 r2
      else if v1 < v2 then
        subset
          (let open N in
           create l1 v1 empty)
          l2
        && subset r1 s2
      else
        subset
          (let open N in
           create empty v1 r1)
          r2
        && subset l1 s2

let rec get (n : t) (x : value) =
  match N.toOpt n with
  | None -> None
  | Some t ->
      let v = N.value t in
      if x = v then Some v else get (if x < v then N.left t else N.right t) x

let rec getUndefined (n : t) (x : value) =
  match N.toOpt n with
  | None -> Js.undefined
  | Some t ->
      let v = N.value t in
      if x = v then Js.Undefined.return v else getUndefined (if x < v then N.left t else N.right t) x

let rec getExn (n : t) (x : value) =
  match N.toOpt n with
  | None -> raise Stdlib.Not_found (* like Melange *)
  | Some t ->
      let v = N.value t in
      if x = v then v else getExn (if x < v then N.left t else N.right t) x

let rec addMutate t (x : value) =
  match N.toOpt t with
  | None -> N.singleton x
  | Some nt ->
      let k = N.value nt in
      if x = k then t
      else
        let l, r =
          let open N in
          (left nt, right nt)
        in
        if x < k then N.leftSet nt (addMutate l x) else N.rightSet nt (addMutate r x);
        N.return (N.balMutate nt)

let fromArray (xs : value array) =
  let len = A.length xs in
  if len = 0 then N.empty
  else
    let next = ref (S.strictlySortedLength xs) in
    let result =
      ref
        (if !next >= 0 then N.fromSortedArrayAux xs 0 !next
         else (
           next := - !next;
           N.fromSortedArrayRevAux xs (!next - 1) !next))
    in
    for i = !next to len - 1 do
      result := addMutate !result (A.getUnsafe xs i)
    done;
    !result