diff --git a/belt-cppo/belt_Set.cppo.res b/belt-cppo/belt_Set.cppo.res new file mode 100644 index 0000000..2ef4124 --- /dev/null +++ b/belt-cppo/belt_Set.cppo.res @@ -0,0 +1,233 @@ +#ifdef TYPE_INT +module I = Belt_internalSetInt +#elif defined TYPE_STRING +module I = Belt_internalSetString +#else +[%error "unknown type"] +#endif + +module N = Belt_internalAVLset +module A = Belt_Array + +type value = I.value +type t = I.t + +let empty = None +let isEmpty = N.isEmpty +let minimum = N.minimum +let minUndefined = N.minUndefined +let maximum = N.maximum +let maxUndefined = N.maxUndefined + +let forEach = N.forEach +let forEachU = N.forEachU +let reduce = N.reduce +let reduceU = N.reduceU +let every = N.every +let everyU = N.everyU +let some = N.some +let someU = N.someU +let keep = N.keepShared +let keepU = N.keepSharedU +let partition = N.partitionShared +let partitionU = N.partitionSharedU + +let size = N.size +let toList = N.toList +let toArray = N.toArray +let fromSortedArrayUnsafe = N.fromSortedArrayUnsafe +let checkInvariantInternal = N.checkInvariantInternal + +let rec add = (t: t, x: value): t => + switch t { + | None => N.singleton(x) + | Some(nt) => + let v = nt.value + if x == v { + t + } else { + let {N.left: l, right: r} = nt + if x < v { + let ll = add(l, x) + if ll === l { + t + } else { + N.bal(ll, v, r) + } + } else { + let rr = add(r, x) + if rr === r { + t + } else { + N.bal(l, v, rr) + } + } + } + } + +let mergeMany = (h, arr) => { + let len = A.length(arr) + let v = ref(h) + for i in 0 to len - 1 { + let key = A.getUnsafe(arr, i) + v.contents = add(v.contents, key) + } + v.contents +} + +let rec remove = (t: t, x: value): t => + switch t { + | None => t + | Some(n) => + let {N.left: l, value: v, right: r} = n + if x == v { + switch (l, r) { + | (None, _) => r + | (_, None) => l + | (_, Some(rn)) => + let v = ref(rn.value) + let r = N.removeMinAuxWithRef(rn, v) + N.bal(l, v.contents, r) + } + } else if x < v { + let ll = remove(l, x) + if ll === l { + t + } else { + N.bal(ll, v, r) + } + } else { + let rr = remove(r, x) + if rr === r { + t + } else { + N.bal(l, v, rr) + } + } + } + +let removeMany = (h, arr) => { + let len = A.length(arr) + let v = ref(h) + for i in 0 to len - 1 { + let key = A.getUnsafe(arr, i) + v.contents = remove(v.contents, key) + } + v.contents +} + +let fromArray = I.fromArray +let cmp = I.cmp +let eq = I.eq +let get = I.get +let getUndefined = I.getUndefined +let getExn = I.getExn +let subset = I.subset +let has = I.has + +let rec splitAuxNoPivot = (n: N.node<_>, x: value): (t, t) => { + let {N.left: l, value: v, right: r} = n + if x == v { + (l, r) + } else if x < v { + switch l { + | None => (None, Some(n)) + | Some(l) => + let (ll, rl) = splitAuxNoPivot(l, x) + (ll, N.joinShared(rl, v, r)) + } + } else { + switch r { + | None => (Some(n), None) + | Some(r) => + let (lr, rr) = splitAuxNoPivot(r, x) + (N.joinShared(l, v, lr), rr) + } + } +} + +let rec splitAuxPivot = (n: N.node<_>, x: value, pres): (t, t) => { + let {N.left: l, value: v, right: r} = n + if x == v { + pres.contents = true + (l, r) + } else if x < v { + switch l { + | None => (None, Some(n)) + | Some(l) => + let (ll, rl) = splitAuxPivot(l, x, pres) + (ll, N.joinShared(rl, v, r)) + } + } else { + switch r { + | None => (Some(n), None) + | Some(r) => + let (lr, rr) = splitAuxPivot(r, x, pres) + (N.joinShared(l, v, lr), rr) + } + } +} + +let split = (t: t, x: value) => + switch t { + | None => ((None, None), false) + | Some(n) => + let pres = ref(false) + let v = splitAuxPivot(n, x, pres) + (v, pres.contents) + } + +let rec union = (s1: t, s2: t) => + switch (s1, s2) { + | (None, _) => s2 + | (_, None) => s1 + | (Some(n1), Some(n2)) /* (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) */ => + let (h1, h2) = (n1.height, n2.height) + if h1 >= h2 { + if h2 == 1 { + add(s1, n2.value) + } else { + let {N.left: l1, value: v1, right: r1} = n1 + let (l2, r2) = splitAuxNoPivot(n2, v1) + N.joinShared(union(l1, l2), v1, union(r1, r2)) + } + } else if h1 == 1 { + add(s2, n1.value) + } else { + let {N.left: l2, value: v2, right: r2} = n2 + let (l1, r1) = splitAuxNoPivot(n1, v2) + N.joinShared(union(l1, l2), v2, union(r1, r2)) + } + } + +let rec intersect = (s1: t, s2: t) => + switch (s1, s2) { + | (None, _) | (_, None) => None + | (Some(n1), Some(n2)) /* (Node(l1, v1, r1, _), t2) */ => + let {N.left: l1, value: v1, right: r1} = n1 + let pres = ref(false) + let (l2, r2) = splitAuxPivot(n2, v1, pres) + let ll = intersect(l1, l2) + let rr = intersect(r1, r2) + if pres.contents { + N.joinShared(ll, v1, rr) + } else { + N.concatShared(ll, rr) + } + } + +let rec diff = (s1: t, s2: t) => + switch (s1, s2) { + | (None, _) | (_, None) => s1 + | (Some(n1), Some(n2)) /* (Node(l1, v1, r1, _), t2) */ => + let {N.left: l1, value: v1, right: r1} = n1 + let pres = ref(false) + let (l2, r2) = splitAuxPivot(n2, v1, pres) + let ll = diff(l1, l2) + let rr = diff(r1, r2) + if pres.contents { + N.concatShared(ll, rr) + } else { + N.joinShared(ll, v1, rr) + } + } diff --git a/belt-cppo/belt_Set.cppo.resi b/belt-cppo/belt_Set.cppo.resi new file mode 100644 index 0000000..ab3719d --- /dev/null +++ b/belt-cppo/belt_Set.cppo.resi @@ -0,0 +1,169 @@ +/* Copyright (C) 2017 Authors of ReScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +/*** +This module is [`Belt.Set`]() specialized with value type to be a primitive type. +It is more efficient in general, the API is the same with [`Belt_Set`]() except its value type is fixed, +and identity is not needed(using the built-in one) + +**See** [`Belt.Set`]() +*/ + +#ifdef TYPE_STRING +/** The type of the set elements. */ +type value = string +#elif defined TYPE_INT +/** The type of the set elements. */ +type value = int +#else +[%error "unknown type"] +#endif + +/** The type of sets. */ +type t + +let empty: t + +let fromArray: array => t + +let fromSortedArrayUnsafe: array => t + +let isEmpty: t => bool + +let has: (t, value) => bool + +/** +`add(s, x)` If `x` was already in `s`, `s` is returned unchanged. +*/ +let add: (t, value) => t + +let mergeMany: (t, array) => t + +/** +`remove(m, x)` If `x` was not in `m`, `m` is returned reference unchanged. +*/ +let remove: (t, value) => t + +let removeMany: (t, array) => t + +let union: (t, t) => t + +let intersect: (t, t) => t + +let diff: (t, t) => t + +/** +`subset(s1, s2)` tests whether the set `s1` is a subset of the set `s2`. +*/ +let subset: (t, t) => bool + +/** +Total ordering between sets. Can be used as the ordering function for doing sets +of sets. +*/ +let cmp: (t, t) => int + +/** +`eq(s1, s2)` tests whether the sets `s1` and `s2` are equal, that is, contain +equal elements. +*/ +let eq: (t, t) => bool + +let forEachU: (t, value => unit) => unit + +/** +`forEach(s, f)` applies `f` in turn to all elements of `s`. In increasing order +*/ +let forEach: (t, value => unit) => unit + +let reduceU: (t, 'a, ('a, value) => 'a) => 'a + +/** Iterate in increasing order. */ +let reduce: (t, 'a, ('a, value) => 'a) => 'a + +let everyU: (t, value => bool) => bool + +/** +`every(p, s)` checks if all elements of the set satisfy the predicate `p`. Order +unspecified. +*/ +let every: (t, value => bool) => bool + +let someU: (t, value => bool) => bool + +/** +`some(p, s)` checks if at least one element of the set satisfies the predicate +`p`. Oder unspecified. +*/ +let some: (t, value => bool) => bool + +let keepU: (t, value => bool) => t + +/** +`keep(p, s)` returns the set of all elements in `s` that satisfy predicate `p`. +*/ +let keep: (t, value => bool) => t + +let partitionU: (t, value => bool) => (t, t) + +/** +`partition(p, s)` returns a pair of sets `(s1, s2)`, where `s1` is the set of +all the elements of `s` that satisfy the predicate `p`, and `s2` is the set of +all the elements of `s` that do not satisfy `p`. +*/ +let partition: (t, value => bool) => (t, t) + +let size: t => int + +/** In increasing order */ +let toList: t => list + +let toArray: t => array + +let minimum: t => option + +let minUndefined: t => Js.undefined + +let maximum: t => option + +let maxUndefined: t => Js.undefined + +let get: (t, value) => option + +let getUndefined: (t, value) => Js.undefined + +let getExn: (t, value) => value + +/** +`split(x, s)` returns a triple `(l, present, r)`, where `l` is the set of +elements of `s` that are strictly less than `x`;`r` is the set of elements of +`s` that are strictly greater than `x`; `present` is `false` if `s` contains no +element equal to `x`, or `true` if `s` contains an element equal to `x`. +*/ +let split: (t, value) => ((t, t), bool) + +/** +**raise** when invariant is not held +*/ +let checkInvariantInternal: t => unit diff --git a/belt-cppo/hashmap.cppo.res b/belt-cppo/hashmap.cppo.res new file mode 100644 index 0000000..e5de8ed --- /dev/null +++ b/belt-cppo/hashmap.cppo.res @@ -0,0 +1,225 @@ +/* ********************************************************************* */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../LICENSE. */ +/* */ +/* ********************************************************************* */ + +/* Adapted by Hongbo Zhang, Authors of ReScript 2017 */ + +#ifdef TYPE_STRING +type key = string +type seed = int +external caml_hash_mix_string: (seed, string) => seed = "?hash_mix_string" +external final_mix: seed => seed = "?hash_final_mix" +let hash = (s: key) => final_mix(caml_hash_mix_string(0, s)) +#elif defined TYPE_INT +type key = int +type seed = int +external caml_hash_mix_int: (seed, int) => seed = "?hash_mix_int" +external final_mix: seed => seed = "?hash_final_mix" +let hash = (s: key) => final_mix(caml_hash_mix_int(0, s)) +#else +[%error "unknown type"] +#endif + +module N = Belt_internalBuckets +module C = Belt_internalBucketsType +module A = Belt_Array + +type t<'b> = N.t + +let rec copyBucketReHash = (~h_buckets, ~ndata_tail, old_bucket: C.opt>) => + switch C.toOpt(old_bucket) { + | None => () + | Some(cell) => + let nidx = land(hash(cell.key), A.length(h_buckets) - 1) + let v = C.return(cell) + switch C.toOpt(A.getUnsafe(ndata_tail, nidx)) { + | None => A.setUnsafe(h_buckets, nidx, v) + | Some(tail) => tail.N.next = v /* cell put at the end */ + } + A.setUnsafe(ndata_tail, nidx, v) + copyBucketReHash(~h_buckets, ~ndata_tail, cell.next) + } + +let resize = h => { + let odata = h.C.buckets + let osize = A.length(odata) + let nsize = osize * 2 + if nsize >= osize { + /* no overflow */ + let h_buckets = A.makeUninitialized(nsize) + let ndata_tail = A.makeUninitialized(nsize) /* keep track of tail */ + h.C.buckets = h_buckets /* so that indexfun sees the new bucket count */ + for i in 0 to osize - 1 { + copyBucketReHash(~h_buckets, ~ndata_tail, A.getUnsafe(odata, i)) + } + for i in 0 to nsize - 1 { + switch C.toOpt(A.getUnsafe(ndata_tail, i)) { + | None => () + | Some(tail) => tail.next = C.emptyOpt + } + } + } +} + +let rec replaceInBucket = (key: key, info, cell) => + if cell.N.key == key { + cell.N.value = info + false + } else { + switch C.toOpt(cell.next) { + | None => true + | Some(cell) => replaceInBucket(key, info, cell) + } + } + +let set = (h, key: key, value) => { + let h_buckets = h.C.buckets + let buckets_len = A.length(h_buckets) + let i = land(hash(key), buckets_len - 1) + let l = A.getUnsafe(h_buckets, i) + switch C.toOpt(l) { + | None => + A.setUnsafe(h_buckets, i, C.return({N.key, value, next: C.emptyOpt})) + h.C.size = h.C.size + 1 + | Some(bucket) => + if replaceInBucket(key, value, bucket) { + A.setUnsafe(h_buckets, i, C.return({N.key, value, next: l})) + h.C.size = h.C.size + 1 + } + } + if h.C.size > lsl(buckets_len, 1) { + resize(h) + } +} + +let rec removeInBucket = (h, h_buckets, i, key: key, prec, buckets) => + switch C.toOpt(buckets) { + | None => () + | Some(cell) => + let cell_next = cell.N.next + if cell.N.key == key { + prec.N.next = cell_next + h.C.size = h.C.size - 1 + } else { + removeInBucket(h, h_buckets, i, key, cell, cell_next) + } + } + +let remove = (h, key) => { + let h_buckets = h.C.buckets + let i = land(hash(key), A.length(h_buckets) - 1) + let bucket = A.getUnsafe(h_buckets, i) + switch C.toOpt(bucket) { + | None => () + | Some(cell) => + if cell.N.key == key { + A.setUnsafe(h_buckets, i, cell.next) + h.C.size = h.C.size - 1 + } else { + removeInBucket(h, h_buckets, i, key, cell, cell.next) + } + } +} + +let rec getAux = (key: key, buckets) => + switch C.toOpt(buckets) { + | None => None + | Some(cell) => + if key == cell.N.key { + Some(cell.N.value) + } else { + getAux(key, cell.next) + } + } + +let get = (h, key: key) => { + let h_buckets = h.C.buckets + let nid = land(hash(key), A.length(h_buckets) - 1) + switch C.toOpt(A.getUnsafe(h_buckets, nid)) { + | None => None + | Some(cell1) => + if key == cell1.N.key { + Some(cell1.N.value) + } else { + switch C.toOpt(cell1.N.next) { + | None => None + | Some(cell2) => + if key == cell2.N.key { + Some(cell2.N.value) + } else { + switch C.toOpt(cell2.N.next) { + | None => None + | Some(cell3) => + if key == cell3.N.key { + Some(cell3.N.value) + } else { + getAux(key, cell3.N.next) + } + } + } + } + } + } +} + +let rec memInBucket = (key: key, cell) => + cell.N.key == key || + switch C.toOpt(cell.next) { + | None => false + | Some(nextCell) => memInBucket(key, nextCell) + } + +let has = (h, key) => { + let h_buckets = h.C.buckets + let nid = land(hash(key), A.length(h_buckets) - 1) + let bucket = A.getUnsafe(h_buckets, nid) + switch C.toOpt(bucket) { + | None => false + | Some(bucket) => memInBucket(key, bucket) + } +} + +let make = (~hintSize) => C.make(~hintSize, ~hash=(), ~eq=()) +let clear = C.clear +let size = h => h.C.size +let forEachU = N.forEachU +let forEach = N.forEach +let reduceU = N.reduceU +let reduce = N.reduce +let logStats = N.logStats +let keepMapInPlaceU = N.keepMapInPlaceU +let keepMapInPlace = N.keepMapInPlace +let toArray = N.toArray +let copy = N.copy +let keysToArray = N.keysToArray +let valuesToArray = N.valuesToArray +let getBucketHistogram = N.getBucketHistogram +let isEmpty = C.isEmpty + +let fromArray = arr => { + let len = A.length(arr) + let v = make(~hintSize=len) + for i in 0 to len - 1 { + let (k, value) = A.getUnsafe(arr, i) + set(v, k, value) + } + v +} + +/* TOOD: optimize heuristics for resizing */ +let mergeMany = (h, arr) => { + let len = A.length(arr) + for i in 0 to len - 1 { + let (k, v) = A.getUnsafe(arr, i) + set(h, k, v) + } +} diff --git a/belt-cppo/hashmap.cppo.resi b/belt-cppo/hashmap.cppo.resi new file mode 100644 index 0000000..7939741 --- /dev/null +++ b/belt-cppo/hashmap.cppo.resi @@ -0,0 +1,47 @@ +#ifdef TYPE_STRING +type key = string +#elif defined TYPE_INT +type key = int +#else +[%error "unknown type"] +#endif + +type t<'b> + +let make: (~hintSize: int) => t<'b> + +let clear: t<'b> => unit + +let isEmpty: t<_> => bool + +/** +`setDone(tbl, k, v)` if `k` does not exist, add the binding `k,v`, otherwise, +update the old value with the new `v` +*/ +let set: (t<'a>, key, 'a) => unit + +let copy: t<'a> => t<'a> +let get: (t<'a>, key) => option<'a> + +let has: (t<'b>, key) => bool + +let remove: (t<'a>, key) => unit + +let forEachU: (t<'b>, (key, 'b) => unit) => unit +let forEach: (t<'b>, (key, 'b) => unit) => unit + +let reduceU: (t<'b>, 'c, ('c, key, 'b) => 'c) => 'c +let reduce: (t<'b>, 'c, ('c, key, 'b) => 'c) => 'c + +let keepMapInPlaceU: (t<'a>, (key, 'a) => option<'a>) => unit +let keepMapInPlace: (t<'a>, (key, 'a) => option<'a>) => unit + +let size: t<_> => int + +let toArray: t<'a> => array<(key, 'a)> +let keysToArray: t<'a> => array +let valuesToArray: t<'a> => array<'a> +let fromArray: array<(key, 'a)> => t<'a> +let mergeMany: (t<'a>, array<(key, 'a)>) => unit +let getBucketHistogram: t<_> => array +let logStats: t<_> => unit diff --git a/belt-cppo/hashset.cppo.res b/belt-cppo/hashset.cppo.res new file mode 100644 index 0000000..af73488 --- /dev/null +++ b/belt-cppo/hashset.cppo.res @@ -0,0 +1,164 @@ +#ifdef TYPE_STRING +type key = string +type seed = int +external caml_hash_mix_string: (seed, string) => seed = "?hash_mix_string" +external final_mix: seed => seed = "?hash_final_mix" +let hash = (s: key) => final_mix(caml_hash_mix_string(0, s)) +#elif defined TYPE_INT +type key = int +type seed = int +external caml_hash_mix_int: (seed, int) => seed = "?hash_mix_int" +external final_mix: seed => seed = "?hash_final_mix" +let hash = (s: key) => final_mix(caml_hash_mix_int(0, s)) +#else +[%error "unknown type"] +#endif + +module N = Belt_internalSetBuckets +module C = Belt_internalBucketsType +module A = Belt_Array + +type t = N.t + +let rec copyBucket = (~h_buckets, ~ndata_tail, old_bucket) => + switch C.toOpt(old_bucket) { + | None => () + | Some(cell) => + let nidx = land(hash(cell.N.key), A.length(h_buckets) - 1) + let v = C.return(cell) + switch C.toOpt(A.getUnsafe(ndata_tail, nidx)) { + | None => A.setUnsafe(h_buckets, nidx, v) + | Some(tail) => tail.N.next = v /* cell put at the end */ + } + A.setUnsafe(ndata_tail, nidx, v) + copyBucket(~h_buckets, ~ndata_tail, cell.N.next) + } + +let tryDoubleResize = h => { + let odata = h.C.buckets + let osize = A.length(odata) + let nsize = osize * 2 + if nsize >= osize { + /* no overflow */ + let h_buckets = A.makeUninitialized(nsize) + let ndata_tail = A.makeUninitialized(nsize) /* keep track of tail */ + h.C.buckets = h_buckets /* so that indexfun sees the new bucket count */ + for i in 0 to osize - 1 { + copyBucket(~h_buckets, ~ndata_tail, A.getUnsafe(odata, i)) + } + for i in 0 to nsize - 1 { + switch C.toOpt(A.getUnsafe(ndata_tail, i)) { + | None => () + | Some(tail) => tail.N.next = C.emptyOpt + } + } + } +} + +let rec removeBucket = (h, h_buckets, i, key: key, prec, cell) => { + let cell_next = cell.N.next + if cell.N.key == key { + prec.N.next = cell_next + h.C.size = h.C.size - 1 + } else { + switch C.toOpt(cell_next) { + | None => () + | Some(cell_next) => removeBucket(h, h_buckets, i, key, cell, cell_next) + } + } +} + +let remove = (h, key: key) => { + let h_buckets = h.C.buckets + let i = land(hash(key), A.length(h_buckets) - 1) + let l = A.getUnsafe(h_buckets, i) + switch C.toOpt(l) { + | None => () + | Some(cell) => + let next_cell = cell.N.next + if cell.N.key == key { + h.C.size = h.C.size - 1 + A.setUnsafe(h_buckets, i, next_cell) + } else { + switch C.toOpt(next_cell) { + | None => () + | Some(next_cell) => removeBucket(h, h_buckets, i, key, cell, next_cell) + } + } + } +} + +let rec addBucket = (h, key: key, cell) => + if cell.N.key != key { + let n = cell.N.next + switch C.toOpt(n) { + | None => + h.C.size = h.C.size + 1 + cell.N.next = C.return({N.key, next: C.emptyOpt}) + | Some(n) => addBucket(h, key, n) + } + } + +let add = (h, key: key) => { + let h_buckets = h.C.buckets + let buckets_len = A.length(h_buckets) + let i = land(hash(key), buckets_len - 1) + let l = A.getUnsafe(h_buckets, i) + switch C.toOpt(l) { + | None => + A.setUnsafe(h_buckets, i, C.return({N.key, next: C.emptyOpt})) + h.C.size = h.C.size + 1 + | Some(cell) => addBucket(h, key, cell) + } + if h.C.size > lsl(buckets_len, 1) { + tryDoubleResize(h) + } +} + +let rec memInBucket = (key: key, cell) => + cell.N.key == key || + switch C.toOpt(cell.N.next) { + | None => false + | Some(nextCell) => memInBucket(key, nextCell) + } + +let has = (h, key) => { + let h_buckets = h.C.buckets + let nid = land(hash(key), A.length(h_buckets) - 1) + let bucket = A.getUnsafe(h_buckets, nid) + switch C.toOpt(bucket) { + | None => false + | Some(bucket) => memInBucket(key, bucket) + } +} + +let make = (~hintSize) => C.make(~hintSize, ~hash=(), ~eq=()) + +let clear = C.clear +let size = h => h.C.size +let forEachU = N.forEachU +let forEach = N.forEach +let reduceU = N.reduceU +let reduce = N.reduce +let logStats = N.logStats +let toArray = N.toArray +let copy = N.copy +let getBucketHistogram = N.getBucketHistogram +let isEmpty = C.isEmpty + +let fromArray = arr => { + let len = A.length(arr) + let v = C.make(~hintSize=len, ~hash=(), ~eq=()) + for i in 0 to len - 1 { + add(v, A.getUnsafe(arr, i)) + } + v +} + +/* TOOD: optimize heuristics for resizing */ +let mergeMany = (h, arr) => { + let len = A.length(arr) + for i in 0 to len - 1 { + add(h, A.getUnsafe(arr, i)) + } +} diff --git a/belt-cppo/hashset.cppo.resi b/belt-cppo/hashset.cppo.resi new file mode 100644 index 0000000..429fcc9 --- /dev/null +++ b/belt-cppo/hashset.cppo.resi @@ -0,0 +1,74 @@ +/* Copyright (C) 2017 Authors of ReScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +/*** +This module is [`Belt.HashSet`]() specialized with key type to be a primitive type. + +It is more efficient in general, the API is the same with [`Belt.HashSet`]() except its key type is fixed, +and identity is not needed(using the built-in one) + +**See** [`Belt.HashSet`]() +*/ + +#ifdef TYPE_STRING +type key = string +#elif defined TYPE_INT +type key = int +#else +[%error "unknown type"] +#endif + +type t + +let make: (~hintSize: int) => t + +let clear: t => unit + +let isEmpty: t => bool + +let add: (t, key) => unit + +let copy: t => t + +let has: (t, key) => bool + +let remove: (t, key) => unit + +let forEachU: (t, key => unit) => unit +let forEach: (t, key => unit) => unit + +let reduceU: (t, 'c, ('c, key) => 'c) => 'c +let reduce: (t, 'c, ('c, key) => 'c) => 'c + +let size: t => int + +let logStats: t => unit + +let toArray: t => array + +let fromArray: array => t + +let mergeMany: (t, array) => unit + +let getBucketHistogram: t => array diff --git a/belt-cppo/internal_map.cppo.res b/belt-cppo/internal_map.cppo.res new file mode 100644 index 0000000..dae22e1 --- /dev/null +++ b/belt-cppo/internal_map.cppo.res @@ -0,0 +1,294 @@ +@@config({flags: ["-bs-noassertfalse"]}) + +#ifdef TYPE_STRING +type key = string +#elif defined TYPE_INT +type key = int +#else +[%error "unknown type"] +#endif + +module N = Belt_internalAVLtree +module A = Belt_Array +module S = Belt_SortArray + +type t<'a> = N.t + +let rec add = (t, x: key, data: _) => + switch t { + | None => N.singleton(x, data) + | Some(n) => + let k = n.N.key + if x == k { + Some(N.updateValue(n, data)) + } else { + let v = n.N.value + if x < k { + N.bal(add(n.N.left, x, data), k, v, n.N.right) + } else { + N.bal(n.N.left, k, v, add(n.N.right, x, data)) + } + } + } + +let rec get = (n, x: key) => + switch n { + | None => None + | Some(n) => + let v = n.N.key + if x == v { + Some(n.N.value) + } else { + get( + if x < v { + n.N.left + } else { + n.N.right + }, + x, + ) + } + } + +let rec getUndefined = (n, x: key) => + switch n { + | None => Js.undefined + | Some(n) => + let v = n.N.key + if x == v { + Js.Undefined.return(n.N.value) + } else { + getUndefined( + if x < v { + n.N.left + } else { + n.N.right + }, + x, + ) + } + } + +let rec getExn = (n, x: key) => + switch n { + | None => raise(Not_found) + | Some(n) => + let v = n.N.key + if x == v { + n.N.value + } else { + getExn( + if x < v { + n.N.left + } else { + n.N.right + }, + x, + ) + } + } + +let rec getWithDefault = (n, x: key, def) => + switch n { + | None => def + | Some(n) => + let v = n.N.key + if x == v { + n.N.value + } else { + getWithDefault( + if x < v { + n.N.left + } else { + n.N.right + }, + x, + def, + ) + } + } + +let rec has = (n, x: key) => + switch n { + | None => false + | Some(n) /* Node(l, v, d, r, _) */ => + let v = n.N.key + x == v || + has( + if x < v { + n.N.left + } else { + n.N.right + }, + x, + ) + } + +let rec remove = (n, x: key) => + switch n { + | None => n + | Some(n) => + let {N.left: l, key: v, right: r} = n + if x == v { + switch (l, r) { + | (None, _) => r + | (_, None) => l + | (_, Some(rn)) => + let (kr, vr) = (ref(rn.key), ref(rn.value)) + let r = N.removeMinAuxWithRef(rn, kr, vr) + N.bal(l, kr.contents, vr.contents, r) + } + } else if x < v { + open N + bal(remove(l, x), v, n.value, r) + } else { + open N + bal(l, v, n.value, remove(r, x)) + } + } + +let rec splitAux = (x: key, n: N.node<_>): (t<_>, option<_>, t<_>) => { + let {N.left: l, key: v, value: d, right: r} = n + if x == v { + (l, Some(d), r) + } else if x < v { + switch l { + | None => (None, None, Some(n)) + | Some(l) => + let (ll, pres, rl) = splitAux(x, l) + (ll, pres, N.join(rl, v, d, r)) + } + } else { + switch r { + | None => (Some(n), None, None) + | Some(r) => + let (lr, pres, rr) = splitAux(x, r) + (N.join(l, v, d, lr), pres, rr) + } + } +} + +let split = (x: key, n) => + switch n { + | None => (None, None, None) + | Some(n) => splitAux(x, n) + } + +let rec mergeU = (s1, s2, f) => + switch (s1, s2) { + | (None, None) => None + | (Some(n) /* (Node (l1, v1, d1, r1, h1), _) */, _) + if n.N.height >= + switch s2 { + | None => 0 + | Some(n) => n.N.height + } => + let {N.left: l1, key: v1, value: d1, right: r1} = n + let (l2, d2, r2) = split(v1, s2) + N.concatOrJoin(mergeU(l1, l2, f), v1, f(v1, Some(d1), d2), mergeU(r1, r2, f)) + | (_, Some(n)) /* Node (l2, v2, d2, r2, h2) */ => + let {N.left: l2, key: v2, value: d2, right: r2} = n + let (l1, d1, r1) = split(v2, s1) + N.concatOrJoin(mergeU(l1, l2, f), v2, f(v2, d1, Some(d2)), mergeU(r1, r2, f)) + | _ => assert(false) + } + +let merge = (s1, s2, f) => mergeU(s1, s2, (a, b, c) => f(a, b, c)) + +let rec compareAux = (e1, e2, vcmp) => + switch (e1, e2) { + | (list{h1, ...t1}, list{h2, ...t2}) => + let c = Pervasives.compare((h1.N.key: key), h2.N.key) + if c == 0 { + let cx = vcmp(h1.N.value, h2.N.value) + if cx == 0 { + compareAux(N.stackAllLeft(h1.N.right, t1), N.stackAllLeft(h2.N.right, t2), vcmp) + } else { + cx + } + } else { + c + } + | (_, _) => 0 + } + +let cmpU = (s1, s2, cmp) => { + let (len1, len2) = (N.size(s1), N.size(s2)) + if len1 == len2 { + compareAux(N.stackAllLeft(s1, list{}), N.stackAllLeft(s2, list{}), cmp) + } else if len1 < len2 { + -1 + } else { + 1 + } +} + +let cmp = (s1, s2, f) => cmpU(s1, s2, (a, b) => f(a, b)) + +let rec eqAux = (e1, e2, eq) => + switch (e1, e2) { + | (list{h1, ...t1}, list{h2, ...t2}) => + if (h1.N.key: key) == h2.N.key && eq(h1.N.value, h2.N.value) { + eqAux(N.stackAllLeft(h1.N.right, t1), N.stackAllLeft(h2.N.right, t2), eq) + } else { + false + } + | (_, _) => true + } /* end */ + +let eqU = (s1, s2, eq) => { + let (len1, len2) = (N.size(s1), N.size(s2)) + if len1 == len2 { + eqAux(N.stackAllLeft(s1, list{}), N.stackAllLeft(s2, list{}), eq) + } else { + false + } +} + +let eq = (s1, s2, f) => eqU(s1, s2, (a, b) => f(a, b)) + +let rec addMutate = (t: t<_>, x, data): t<_> => + switch t { + | None => N.singleton(x, data) + | Some(nt) => + let k = nt.N.key + + /* let c = (Belt_Cmp.getCmpInternal cmp) x k [@bs] in */ + if x == k { + nt.N.key = x + nt.value = data + Some(nt) + } else { + let (l, r) = (nt.N.left, nt.N.right) + if x < k { + let ll = addMutate(l, x, data) + nt.left = ll + } else { + nt.right = addMutate(r, x, data) + } + Some(N.balMutate(nt)) + } + } + +let fromArray = (xs: array<(key, _)>) => { + let len = A.length(xs) + if len == 0 { + None + } else { + let next = ref(S.strictlySortedLengthU(xs, ((x0, _), (y0, _)) => x0 < y0)) + + let result = ref( + if next.contents >= 0 { + N.fromSortedArrayAux(xs, 0, next.contents) + } else { + next.contents = -next.contents + N.fromSortedArrayRevAux(xs, next.contents - 1, next.contents) + }, + ) + for i in next.contents to len - 1 { + let (k, v) = A.getUnsafe(xs, i) + result.contents = addMutate(result.contents, k, v) + } + result.contents + } +} diff --git a/belt-cppo/internal_set.cppo.res b/belt-cppo/internal_set.cppo.res new file mode 100644 index 0000000..944ec29 --- /dev/null +++ b/belt-cppo/internal_set.cppo.res @@ -0,0 +1,171 @@ +#ifdef TYPE_STRING +type value = string +module S = Belt_SortArrayString +#elif defined TYPE_INT +type value = int +module S = Belt_SortArrayInt +#else +[%error "unknown type"] +#endif + +module N = Belt_internalAVLset +module A = Belt_Array + +type t = N.t + +let rec has = (t: t, x: value) => + switch t { + | None => false + | Some(n) => + let v = n.value + x == v || + has( + if x < v { + n.left + } else { + n.right + }, + x, + ) + } + +let rec compareAux = (e1, e2) => + switch (e1, e2) { + | (list{h1, ...t1}, list{h2, ...t2}) => + let (k1: value, k2) = (h1.N.value, h2.N.value) + if k1 == k2 { + compareAux(N.stackAllLeft(h1.right, t1), N.stackAllLeft(h2.right, t2)) + } else if k1 < k2 { + -1 + } else { + 1 + } + | (_, _) => 0 + } + +let cmp = (s1, s2) => { + let (len1, len2) = (N.size(s1), N.size(s2)) + if len1 == len2 { + compareAux(N.stackAllLeft(s1, list{}), N.stackAllLeft(s2, list{})) + } else if len1 < len2 { + -1 + } else { + 1 + } +} + +let eq = (s1: t, s2) => cmp(s1, s2) == 0 + +/* This algorithm applies to BST, it does not need to be balanced tree */ +let rec subset = (s1: t, s2: t) => + switch (s1, s2) { + | (None, _) => true + | (_, None) => false + | (Some(t1), Some(t2)) /* Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) */ => + let {N.left: l1, value: v1, right: r1} = t1 + let {N.left: l2, value: v2, right: r2} = t2 + if v1 == v2 { + subset(l1, l2) && subset(r1, r2) + } else if v1 < v2 { + subset(N.create(l1, v1, None), l2) && subset(r1, s2) + } else { + subset(N.create(None, v1, r1), r2) && subset(l1, s2) + } + } + +let rec get = (n: t, x: value) => + switch n { + | None => None + | Some(t) => + let v = t.value + if x == v { + Some(v) + } else { + get( + if x < v { + t.left + } else { + t.right + }, + x, + ) + } + } + +let rec getUndefined = (n: t, x: value) => + switch n { + | None => Js.undefined + | Some(t) => + let v = t.value + if x == v { + Js.Undefined.return(v) + } else { + getUndefined( + if x < v { + t.left + } else { + t.right + }, + x, + ) + } + } + +let rec getExn = (n: t, x: value) => + switch n { + | None => raise(Not_found) + | Some(t) => + let v = t.value + if x == v { + v + } else { + getExn( + if x < v { + t.left + } else { + t.right + }, + x, + ) + } + } + +/* ************************************************************************** */ +let rec addMutate = (t, x: value) => + switch t { + | None => N.singleton(x) + | Some(nt) => + let k = nt.N.value + if x == k { + t + } else { + let {N.left: l, right: r} = nt + if x < k { + nt.left = addMutate(l, x) + } else { + nt.right = addMutate(r, x) + } + Some(N.balMutate(nt)) + } + } + +let fromArray = (xs: array) => { + let len = A.length(xs) + if len == 0 { + None + } else { + let next = ref(S.strictlySortedLength(xs)) + let result = ref( + if next.contents >= 0 { + N.fromSortedArrayAux(xs, 0, next.contents) + } else { + next.contents = -next.contents + N.fromSortedArrayRevAux(xs, next.contents - 1, next.contents) + }, + ) + for i in next.contents to len - 1 { + result.contents = addMutate(result.contents, A.getUnsafe(xs, i)) + } + result.contents + } +} diff --git a/belt-cppo/map.cppo.res b/belt-cppo/map.cppo.res new file mode 100644 index 0000000..6afc30b --- /dev/null +++ b/belt-cppo/map.cppo.res @@ -0,0 +1,199 @@ +#ifdef TYPE_STRING +type key = string +module I = Belt_internalMapString +#elif defined TYPE_INT +type key = int +module I = Belt_internalMapInt +#else +[%error "unknown type"] +#endif + +module N = Belt_internalAVLtree +module A = Belt_Array + +type t<'a> = N.t + +let empty = None +let isEmpty = N.isEmpty +/* let singleton = N.singleton */ + +let minKey = N.minKey +let minKeyUndefined = N.minKeyUndefined +let maxKey = N.maxKey +let maxKeyUndefined = N.maxKeyUndefined +let minimum = N.minimum +let minUndefined = N.minUndefined +let maximum = N.maximum +let maxUndefined = N.maxUndefined +let forEachU = N.forEachU +let forEach = N.forEach +let mapU = N.mapU +let map = N.map +let mapWithKeyU = N.mapWithKeyU +let mapWithKey = N.mapWithKey +let reduceU = N.reduceU +let reduce = N.reduce +let everyU = N.everyU +let every = N.every +let someU = N.someU +let some = N.some +let keepU = N.keepSharedU +let keep = N.keepShared +let partitionU = N.partitionSharedU +let partition = N.partitionShared +let size = N.size +let toList = N.toList +let toArray = N.toArray +let keysToArray = N.keysToArray +let valuesToArray = N.valuesToArray +let checkInvariantInternal = N.checkInvariantInternal + +let rec set = (t, newK: key, newD: _) => + switch t { + | None => N.singleton(newK, newD) + | Some(n) => + let k = n.N.key + if newK == k { + Some(N.updateValue(n, newD)) + } else { + let v = n.N.value + if newK < k { + N.bal(set(n.N.left, newK, newD), k, v, n.N.right) + } else { + N.bal(n.N.left, k, v, set(n.N.right, newK, newD)) + } + } + } + +let rec updateU = (t, x: key, f) => + switch t { + | None => + switch f(None) { + | None => t + | Some(data) => N.singleton(x, data) + } + | Some(n) => + let k = n.N.key + if x == k { + switch f(Some(n.N.value)) { + | None => + let {N.left: l, right: r} = n + switch (l, r) { + | (None, _) => r + | (_, None) => l + | (_, Some(rn)) => + let (kr, vr) = (ref(rn.N.key), ref(rn.N.value)) + let r = N.removeMinAuxWithRef(rn, kr, vr) + N.bal(l, kr.contents, vr.contents, r) + } + | Some(data) => Some(N.updateValue(n, data)) + } + } else { + let {N.left: l, right: r, value: v} = n + if x < k { + let ll = updateU(l, x, f) + if l === ll { + t + } else { + N.bal(ll, k, v, r) + } + } else { + let rr = updateU(r, x, f) + if r === rr { + t + } else { + N.bal(l, k, v, rr) + } + } + } + } + +let update = (t, x, f) => updateU(t, x, a => f(a)) + +let rec removeAux = (n, x: key) => { + let {N.left: l, key: v, right: r} = n + if x == v { + switch (l, r) { + | (None, _) => r + | (_, None) => l + | (_, Some(rn)) => + let (kr, vr) = (ref(rn.N.key), ref(rn.N.value)) + let r = N.removeMinAuxWithRef(rn, kr, vr) + N.bal(l, kr.contents, vr.contents, r) + } + } else if x < v { + switch l { + | None => Some(n) + | Some(left) => + let ll = removeAux(left, x) + if ll === l { + Some(n) + } else { + open N + bal(ll, v, n.value, r) + } + } + } else { + switch r { + | None => Some(n) + | Some(right) => + let rr = removeAux(right, x) + N.bal(l, v, n.N.value, rr) + } + } +} + +let remove = (n, x) => + switch n { + | None => None + | Some(n) => removeAux(n, x) + } + +let rec removeMany0 = (t, xs, i, len) => + if i < len { + let ele = A.getUnsafe(xs, i) + let u = removeAux(t, ele) + switch u { + | None => u + | Some(t) => removeMany0(t, xs, i + 1, len) + } + } else { + Some(t) + } + +let removeMany = (t, keys) => { + let len = A.length(keys) + switch t { + | None => None + | Some(t) => removeMany0(t, keys, 0, len) + } +} + +let findFirstByU = N.findFirstByU +let findFirstBy = N.findFirstBy + +let mergeMany = (h, arr) => { + let len = A.length(arr) + let v = ref(h) + for i in 0 to len - 1 { + let (key, value) = A.getUnsafe(arr, i) + v.contents = set(v.contents, key, value) + } + v.contents +} + +/* let mergeArray = mergeMany */ + +let has = I.has +let cmpU = I.cmpU +let cmp = I.cmp +let eqU = I.eqU +let eq = I.eq +let get = I.get +let getUndefined = I.getUndefined +let getWithDefault = I.getWithDefault +let getExn = I.getExn +let split = I.split +let mergeU = I.mergeU +let merge = I.merge +let fromArray = I.fromArray diff --git a/belt-cppo/map.cppo.resi b/belt-cppo/map.cppo.resi new file mode 100644 index 0000000..f3df600 --- /dev/null +++ b/belt-cppo/map.cppo.resi @@ -0,0 +1,181 @@ +#ifdef TYPE_STRING +type key = string +#elif defined TYPE_INT +type key = int +#else +[%error "unknown type"] +#endif + +/** The type of maps from type `key` to type `'value`. */ +type t<'value> + +let empty: t<'v> + +let isEmpty: t<'v> => bool + +let has: (t<'v>, key) => bool + +let cmpU: (t<'v>, t<'v>, ('v, 'v) => int) => int +let cmp: (t<'v>, t<'v>, ('v, 'v) => int) => int + +let eqU: (t<'v>, t<'v>, ('v, 'v) => bool) => bool + +/** +`eq(m1, m2)` tests whether the maps `m1` and `m2` are +equal, that is, contain equal keys and associate them with +equal data. +*/ +let eq: (t<'v>, t<'v>, ('v, 'v) => bool) => bool + +let findFirstByU: (t<'v>, (key, 'v) => bool) => option<(key, 'v)> + +/** +`findFirstBy(m, p)` uses funcion `f` to find the first key value pair +to match predicate `p`. + +```rescript +let s0 = fromArray(~id=module(IntCmp), [(4, "4"), (1, "1"), (2, "2,"(3, ""))]) +findFirstBy(s0, (k, v) => k == 4) == option((4, "4")) +``` +*/ +let findFirstBy: (t<'v>, (key, 'v) => bool) => option<(key, 'v)> + +let forEachU: (t<'v>, (key, 'v) => unit) => unit + +/** +`forEach(m, f)` applies `f` to all bindings in map `m`. +`f` receives the key as first argument, and the associated value +as second argument. The bindings are passed to `f` in increasing +order with respect to the ordering over the type of the keys. +*/ +let forEach: (t<'v>, (key, 'v) => unit) => unit + +let reduceU: (t<'v>, 'v2, ('v2, key, 'v) => 'v2) => 'v2 + +/** +`reduce(m, a, f)` computes `(f kN dN ... (f k1 d1 a)...)`, +where `k1 ... kN` are the keys of all bindings in `m` +(in increasing order), and `d1 ... dN` are the associated data. +*/ +let reduce: (t<'v>, 'v2, ('v2, key, 'v) => 'v2) => 'v2 + +let everyU: (t<'v>, (key, 'v) => bool) => bool + +/** +`every(m, p)` checks if all the bindings of the map satisfy the predicate `p`. +Order unspecified */ +let every: (t<'v>, (key, 'v) => bool) => bool + +let someU: (t<'v>, (key, 'v) => bool) => bool + +/** +`some(m, p)` checks if at least one binding of the map satisfy the predicate +`p`. Order unspecified */ +let some: (t<'v>, (key, 'v) => bool) => bool + +let size: t<'v> => int + +/** In increasing order. */ +let toList: t<'v> => list<(key, 'v)> + +let toArray: t<'v> => array<(key, 'v)> + +let fromArray: array<(key, 'v)> => t<'v> + +let keysToArray: t<'v> => array + +let valuesToArray: t<'v> => array<'v> + +let minKey: t<_> => option + +let minKeyUndefined: t<_> => Js.undefined + +let maxKey: t<_> => option + +let maxKeyUndefined: t<_> => Js.undefined + +let minimum: t<'v> => option<(key, 'v)> + +let minUndefined: t<'v> => Js.undefined<(key, 'v)> + +let maximum: t<'v> => option<(key, 'v)> + +let maxUndefined: t<'v> => Js.undefined<(key, 'v)> + +let get: (t<'v>, key) => option<'v> + +let getUndefined: (t<'v>, key) => Js.undefined<'v> + +let getWithDefault: (t<'v>, key, 'v) => 'v + +let getExn: (t<'v>, key) => 'v + +/** +**raise** when invariant is not held +*/ +let checkInvariantInternal: t<_> => unit + +/** `remove m x` returns a map containing the same bindings as + `m`, except for `x` which is unbound in the returned map. */ +let remove: (t<'v>, key) => t<'v> + +let removeMany: (t<'v>, array) => t<'v> + +/** +`set(m, x, y)` returns a map containing the same bindings as +`m`, plus a binding of `x` to `y`. If `x` was already bound +in `m`, its previous binding disappears. +*/ +let set: (t<'v>, key, 'v) => t<'v> + +let updateU: (t<'v>, key, option<'v> => option<'v>) => t<'v> +let update: (t<'v>, key, option<'v> => option<'v>) => t<'v> + +let mergeU: (t<'v>, t<'v2>, (key, option<'v>, option<'v2>) => option<'c>) => t<'c> + +/** +`merge(m1, m2, f)` computes a map whose keys is a subset of keys of `m1` +and of `m2`. The presence of each such binding, and the corresponding +value, is determined with the function `f`. +*/ +let merge: (t<'v>, t<'v2>, (key, option<'v>, option<'v2>) => option<'c>) => t<'c> + +let mergeMany: (t<'v>, array<(key, 'v)>) => t<'v> + +let keepU: (t<'v>, (key, 'v) => bool) => t<'v> + +/** +`keep(m, p)` returns the map with all the bindings in `m` that satisfy predicate +`p`. +*/ +let keep: (t<'v>, (key, 'v) => bool) => t<'v> + +let partitionU: (t<'v>, (key, 'v) => bool) => (t<'v>, t<'v>) + +/** +`partition(m, p)` returns a pair of maps `(m1, m2)`, where `m1` contains all the +bindings of `s` that satisfy the predicate `p`, and `m2` is the map with all the +bindings of `s` that do not satisfy `p`. +*/ +let partition: (t<'v>, (key, 'v) => bool) => (t<'v>, t<'v>) + +/** +`split(x, m)` returns a triple `(l, data, r)`, where `l` is the map with all the +bindings of `m` whose key is strictly less than `x`; `r` is the map with all the +bindings of `m` whose key is strictly greater than `x`; `data` is `None` if `m` +contains no binding for `x`, or `Some(v)` if `m` binds `v` to `x`. +*/ +let split: (key, t<'v>) => (t<'v>, option<'v>, t<'v>) + +let mapU: (t<'v>, 'v => 'v2) => t<'v2> + +/** +`map(m, f)` returns a map with same domain as `m`, where the associated value `a` +of all bindings of `m` has been replaced by the result of the application of `f` +to `a`. The bindings are passed to `f` in increasing order with respect to the +ordering over the type of the keys. +*/ +let map: (t<'v>, 'v => 'v2) => t<'v2> + +let mapWithKeyU: (t<'v>, (key, 'v) => 'v2) => t<'v2> +let mapWithKey: (t<'v>, (key, 'v) => 'v2) => t<'v2> diff --git a/belt-cppo/mapm.cppo.res b/belt-cppo/mapm.cppo.res new file mode 100644 index 0000000..2797b6d --- /dev/null +++ b/belt-cppo/mapm.cppo.res @@ -0,0 +1,183 @@ +#ifdef TYPE_INT +module I = Belt_internalMapInt +type key = int +#elif defined TYPE_STRING +module I = Belt_internalMapString +type key = string +#else +[%error "unknown type"] +#endif + +module N = Belt_internalAVLtree +module A = Belt_Array + +type t<'a> = {mutable data: I.t<'a>} + +let make = () => {data: None} +let isEmpty = m => N.isEmpty(m.data) +let clear = m => m.data = None +/* let singleton k v = t ~data:(N.singleton k v) */ + +let minKeyUndefined = m => N.minKeyUndefined(m.data) +let minKey = m => N.minKey(m.data) +let maxKeyUndefined = m => N.maxKeyUndefined(m.data) +let maxKey = m => N.maxKey(m.data) +let minimum = m => N.minimum(m.data) +let minUndefined = m => N.minUndefined(m.data) +let maximum = m => N.maximum(m.data) +let maxUndefined = m => N.maxUndefined(m.data) + +let set = (m: t<_>, k, v) => { + let old_data = m.data + let v = I.addMutate(old_data, k, v) + if v !== old_data { + m.data = v + } +} + +let forEachU = (d, f) => N.forEachU(d.data, f) +let forEach = (d, f) => forEachU(d, (a, b) => f(a, b)) +let mapU = (d, f) => {data: N.mapU(d.data, f)} +let map = (d, f) => mapU(d, a => f(a)) +let mapWithKeyU = (d, f) => {data: N.mapWithKeyU(d.data, f)} +let mapWithKey = (d, f) => mapWithKeyU(d, (a, b) => f(a, b)) +let reduceU = (d, acc, f) => N.reduceU(d.data, acc, f) +let reduce = (d, acc, f) => reduceU(d, acc, (a, b, c) => f(a, b, c)) +let everyU = (d, f) => N.everyU(d.data, f) +let every = (d, f) => everyU(d, (a, b) => f(a, b)) +let someU = (d, f) => N.someU(d.data, f) +let some = (d, f) => someU(d, (a, b) => f(a, b)) +let size = d => N.size(d.data) +let toList = d => N.toList(d.data) +let toArray = d => N.toArray(d.data) +let keysToArray = d => N.keysToArray(d.data) +let valuesToArray = d => N.valuesToArray(d.data) +let checkInvariantInternal = d => N.checkInvariantInternal(d.data) +let has = (d, v) => I.has(d.data, v) + +let rec removeMutateAux = (nt, x: key) => { + let k = nt.N.key + if x == k { + let {N.left: l, right: r} = nt + switch (l, r) { + | (None, _) => r + | (_, None) => l + | (_, Some(nr)) => + nt.right = N.removeMinAuxWithRootMutate(nt, nr) + Some(N.balMutate(nt)) + } + } else if x < k { + switch nt.left { + | None => Some(nt) + | Some(l) => + nt.left = removeMutateAux(l, x) + Some(N.balMutate(nt)) + } + } else { + switch nt.right { + | None => Some(nt) + | Some(r) => + nt.right = removeMutateAux(r, x) + Some(N.balMutate(nt)) + } + } +} + +let remove = (d, v) => { + let oldRoot = d.data + switch oldRoot { + | None => () + | Some(root) => + let newRoot = removeMutateAux(root, v) + if newRoot !== oldRoot { + d.data = newRoot + } + } +} + +let rec updateDone = (t, x: key, f) => + switch t { + | None => + switch f(None) { + | Some(data) => N.singleton(x, data) + | None => t + } + | Some(nt) => + let k = nt.N.key + + /* let c = (Belt_Cmp.getCmpInternal cmp) x k [@bs] in */ + if k == x { + switch f(Some(nt.value)) { + | None => + let {N.left: l, right: r} = nt + switch (l, r) { + | (None, _) => r + | (_, None) => l + | (_, Some(nr)) => + nt.right = N.removeMinAuxWithRootMutate(nt, nr) + Some(N.balMutate(nt)) + } + | Some(data) => + nt.value = data + Some(nt) + } + } else { + let {N.left: l, right: r} = nt + if x < k { + let ll = updateDone(l, x, f) + nt.left = ll + } else { + nt.right = updateDone(r, x, f) + } + Some(N.balMutate(nt)) + } + } + +let updateU = (t, x, f) => { + let oldRoot = t.data + let newRoot = updateDone(oldRoot, x, f) + if newRoot !== oldRoot { + t.data = newRoot + } +} +let update = (t, x, f) => updateU(t, x, a => f(a)) +let rec removeArrayMutateAux = (t, xs, i, len) => + if i < len { + let ele = A.getUnsafe(xs, i) + let u = removeMutateAux(t, ele) + switch u { + | None => None + | Some(t) => removeArrayMutateAux(t, xs, i + 1, len) + } + } else { + Some(t) + } + +let removeMany = (d: t<_>, xs) => { + let oldRoot = d.data + switch oldRoot { + | None => () + | Some(nt) => + let len = A.length(xs) + let newRoot = removeArrayMutateAux(nt, xs, 0, len) + if newRoot !== oldRoot { + d.data = newRoot + } + } +} + +/* let split = I.split */ +/* let merge = I.merge */ + +let fromArray = xs => {data: I.fromArray(xs)} + +let cmpU = (d0, d1, f) => I.cmpU(d0.data, d1.data, f) +let cmp = (d0, d1, f) => cmpU(d0, d1, (a, b) => f(a, b)) + +let eqU = (d0, d1, f) => I.eqU(d0.data, d1.data, f) +let eq = (d0, d1, f) => eqU(d0, d1, (a, b) => f(a, b)) + +let get = (d, x) => I.get(d.data, x) +let getUndefined = (d, x) => I.getUndefined(d.data, x) +let getWithDefault = (d, x, def) => I.getWithDefault(d.data, x, def) +let getExn = (d, x) => I.getExn(d.data, x) diff --git a/belt-cppo/mapm.cppo.resi b/belt-cppo/mapm.cppo.resi new file mode 100644 index 0000000..913e792 --- /dev/null +++ b/belt-cppo/mapm.cppo.resi @@ -0,0 +1,143 @@ +/* Copyright (C) 2017 Authors of ReScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +#ifdef TYPE_STRING +type key = string +#elif defined TYPE_INT +type key = int +#else +[%error "unknown type"] +#endif + +type t<'a> + +let make: unit => t<'a> +let clear: t<'a> => unit +let isEmpty: t<'a> => bool + +let has: (t<'a>, key) => bool + +let cmpU: (t<'a>, t<'a>, ('a, 'a) => int) => int + +/** +`cmp(m1, m2, cmp)`. First compare by size, if size is the same, compare by key, +value pair +*/ +let cmp: (t<'a>, t<'a>, ('a, 'a) => int) => int + +let eqU: (t<'a>, t<'a>, ('a, 'a) => bool) => bool + +/** `eq(m1, m2, cmp)` */ +let eq: (t<'a>, t<'a>, ('a, 'a) => bool) => bool + +let forEachU: (t<'a>, (key, 'a) => unit) => unit + +/** +`forEach(m, f)` applies `f` to all bindings in map `m`. `f` receives the key as +first argument, and the associated value as second argument. The application +order of `f` is in increasing order. */ +let forEach: (t<'a>, (key, 'a) => unit) => unit + +let reduceU: (t<'a>, 'b, ('b, key, 'a) => 'b) => 'b + +/** +`reduce(m, a, f)` computes `(f kN dN ... (f k1 d1 a)...)`, where `k1 ... kN` are +the keys of all bindings in `m` (in increasing order), and `d1 ... dN` are the +associated data. */ +let reduce: (t<'a>, 'b, ('b, key, 'a) => 'b) => 'b + +let everyU: (t<'a>, (key, 'a) => bool) => bool + +/** +`every(m, p)` checks if all the bindings of the map satisfy the predicate `p`. +The application order of `p` is unspecified. +*/ +let every: (t<'a>, (key, 'a) => bool) => bool + +let someU: (t<'a>, (key, 'a) => bool) => bool + +/** +`some(m, p)` checks if at least one binding of the map satisfy the predicate `p`. +The application order of `p` is unspecified. +*/ +let some: (t<'a>, (key, 'a) => bool) => bool + +let size: t<'a> => int + +/** In increasing order */ +let toList: t<'a> => list<(key, 'a)> + +/** In increasing order */ +let toArray: t<'a> => array<(key, 'a)> + +let fromArray: array<(key, 'a)> => t<'a> +let keysToArray: t<'a> => array +let valuesToArray: t<'a> => array<'a> +let minKey: t<_> => option +let minKeyUndefined: t<_> => Js.undefined +let maxKey: t<_> => option +let maxKeyUndefined: t<_> => Js.undefined +let minimum: t<'a> => option<(key, 'a)> +let minUndefined: t<'a> => Js.undefined<(key, 'a)> +let maximum: t<'a> => option<(key, 'a)> +let maxUndefined: t<'a> => Js.undefined<(key, 'a)> +let get: (t<'a>, key) => option<'a> +let getUndefined: (t<'a>, key) => Js.undefined<'a> +let getWithDefault: (t<'a>, key, 'a) => 'a +let getExn: (t<'a>, key) => 'a + +/** + **raise** when invariant is not held +*/ +let checkInvariantInternal: t<_> => unit + +/* ************************************************************************** */ + +/* TODO: add functional `merge, partition, keep, split` */ + +/** `remove(m, x)` do the in-place modification */ +let remove: (t<'a>, key) => unit + +let removeMany: (t<'a>, array) => unit + +/** +`set(m, x, y)` do the in-place modification, return `m` for chaining. If `x` was +already bound in `m`, its previous binding disappears. +*/ +let set: (t<'a>, key, 'a) => unit + +let updateU: (t<'a>, key, option<'a> => option<'a>) => unit +let update: (t<'a>, key, option<'a> => option<'a>) => unit + +let mapU: (t<'a>, 'a => 'b) => t<'b> + +/** +`map(m, f)` returns a map with same domain as `m`, where the associated value `a` +of all bindings of `m` has been replaced by the result of the application of `f` +to `a`. The bindings are passed to `f` in increasing order with respect to the +ordering over the type of the keys. */ +let map: (t<'a>, 'a => 'b) => t<'b> + +let mapWithKeyU: (t<'a>, (key, 'a) => 'b) => t<'b> +let mapWithKey: (t<'a>, (key, 'a) => 'b) => t<'b> diff --git a/belt-cppo/setm.cppo.res b/belt-cppo/setm.cppo.res new file mode 100644 index 0000000..89c4ede --- /dev/null +++ b/belt-cppo/setm.cppo.res @@ -0,0 +1,346 @@ +/* Copyright (C) 2017 Hongbo Zhang, Authors of ReScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +/*** This module is [`Belt.MutableSet`]() specialized with key type to be a primitive type. + It is more efficient in general, the API is the same with [`Belt_MutableSet`]() except its key type is fixed, + and identity is not needed(using the built-in one) +*/ + +#ifdef TYPE_INT +module I = Belt_internalSetInt +module S = Belt_SortArrayInt +#elif defined TYPE_STRING +module I = Belt_internalSetString +module S = Belt_SortArrayString +#else +[%error "unknown type"] +#endif + +module N = Belt_internalAVLset +module A = Belt_Array + +/** The type of the set elements. */ +type value = I.value + +/** The type of sets. */ +type t = {mutable data: I.t} + +let rec remove0 = (nt, x: value) => { + let k = nt.N.value + if x == k { + let {N.left: l, right: r} = nt + switch (l, r) { + | (None, _) => r + | (_, None) => l + | (Some(_), Some(nr)) => + nt.right = N.removeMinAuxWithRootMutate(nt, nr) + Some(N.balMutate(nt)) + } + } else if x < k { + switch nt.left { + | None => Some(nt) + | Some(l) => + nt.left = remove0(l, x) + Some(N.balMutate(nt)) + } + } else { + switch nt.right { + | None => Some(nt) + | Some(r) => + nt.right = remove0(r, x) + Some(N.balMutate(nt)) + } + } +} + +let remove = (d, v) => { + let oldRoot = d.data + switch oldRoot { + | None => () + | Some(oldRoot2) => + let newRoot = remove0(oldRoot2, v) + if newRoot !== oldRoot { + d.data = newRoot + } + } +} + +let rec removeMany0 = (t, xs, i, len) => + if i < len { + let ele = A.getUnsafe(xs, i) + let u = remove0(t, ele) + switch u { + | None => None + | Some(t) => removeMany0(t, xs, i + 1, len) + } + } else { + Some(t) + } + +let removeMany = (d: t, xs) => { + let oldRoot = d.data + switch oldRoot { + | None => () + | Some(nt) => + let len = A.length(xs) + d.data = removeMany0(nt, xs, 0, len) + } +} + +let rec removeCheck0 = (nt, x: value, removed) => { + let k = nt.N.value + if x == k { + let () = removed.contents = true + let {N.left: l, right: r} = nt + switch (l, r) { + | (None, _) => r + | (_, None) => l + | (Some(_), Some(nr)) => + nt.right = N.removeMinAuxWithRootMutate(nt, nr) + Some(N.balMutate(nt)) + } + } else if x < k { + switch nt.left { + | None => Some(nt) + | Some(l) => + nt.left = removeCheck0(l, x, removed) + Some(N.balMutate(nt)) + } + } else { + switch nt.right { + | None => Some(nt) + | Some(r) => + nt.right = removeCheck0(r, x, removed) + Some(N.balMutate(nt)) + } + } +} + +let removeCheck = (d: t, v) => { + let oldRoot = d.data + switch oldRoot { + | None => false + | Some(oldRoot2) => + let removed = ref(false) + let newRoot = removeCheck0(oldRoot2, v, removed) + if newRoot !== oldRoot { + d.data = newRoot + } + removed.contents + } +} + +let rec addCheck0 = (t, x: value, added) => + switch t { + | None => + added.contents = true + N.singleton(x) + | Some(nt) => + let k = nt.N.value + if x == k { + t + } else { + let {N.left: l, right: r} = nt + if x < k { + let ll = addCheck0(l, x, added) + nt.left = ll + } else { + nt.right = addCheck0(r, x, added) + } + Some(N.balMutate(nt)) + } + } + +let addCheck = (m: t, e) => { + let oldRoot = m.data + let added = ref(false) + let newRoot = addCheck0(oldRoot, e, added) + if newRoot !== oldRoot { + m.data = newRoot + } + added.contents +} + +let add = (d, k) => { + let oldRoot = d.data + let v = I.addMutate(oldRoot, k) + if v !== oldRoot { + d.data = v + } +} + +let addArrayMutate = (t, xs) => { + let v = ref(t) + for i in 0 to A.length(xs) - 1 { + v.contents = I.addMutate(v.contents, A.getUnsafe(xs, i)) + } + v.contents +} + +let mergeMany = (d, arr) => d.data = addArrayMutate(d.data, arr) + +let make = () => {data: None} + +let isEmpty = d => N.isEmpty(d.data) + +let minimum = d => N.minimum(d.data) + +let minUndefined = d => N.minUndefined(d.data) + +let maximum = d => N.maximum(d.data) + +let maxUndefined = d => N.maxUndefined(d.data) + +let forEachU = (d, f) => N.forEachU(d.data, f) +let forEach = (d, f) => forEachU(d, a => f(a)) + +let reduceU = (d, acc, cb) => N.reduceU(d.data, acc, cb) +let reduce = (d, acc, cb) => reduceU(d, acc, (a, b) => cb(a, b)) + +let everyU = (d, p) => N.everyU(d.data, p) +let every = (d, p) => everyU(d, a => p(a)) +let someU = (d, p) => N.someU(d.data, p) +let some = (d, p) => someU(d, a => p(a)) +let size = d => N.size(d.data) +let toList = d => N.toList(d.data) +let toArray = d => N.toArray(d.data) + +let fromSortedArrayUnsafe = xs => {data: N.fromSortedArrayUnsafe(xs)} + +let checkInvariantInternal = d => N.checkInvariantInternal(d.data) + +let fromArray = xs => {data: I.fromArray(xs)} + +let cmp = (d0, d1) => I.cmp(d0.data, d1.data) +let eq = (d0, d1) => I.eq(d0.data, d1.data) +let get = (d, x) => I.get(d.data, x) +let getUndefined = (d, x) => I.getUndefined(d.data, x) +let getExn = (d, x) => I.getExn(d.data, x) + +let split = (d, key) => { + let arr = N.toArray(d.data) + let i = S.binarySearch(arr, key) + let len = A.length(arr) + if i < 0 { + let next = -i - 1 + ( + ( + {data: N.fromSortedArrayAux(arr, 0, next)}, + {data: N.fromSortedArrayAux(arr, next, len - next)}, + ), + false, + ) + } else { + ( + ( + {data: N.fromSortedArrayAux(arr, 0, i)}, + {data: N.fromSortedArrayAux(arr, i + 1, len - i - 1)}, + ), + true, + ) + } +} + +let keepU = (d, p) => {data: N.keepCopyU(d.data, p)} +let keep = (d, p) => keepU(d, a => p(a)) + +let partitionU = (d, p) => { + let (a, b) = N.partitionCopyU(d.data, p) + ({data: a}, {data: b}) +} +let partition = (d, p) => partitionU(d, a => p(a)) + +let subset = (a, b) => I.subset(a.data, b.data) +let intersect = (dataa, datab) => { + let (dataa, datab) = (dataa.data, datab.data) + switch (dataa, datab) { + | (None, _) => make() + | (_, None) => make() + | (Some(dataa0), Some(datab0)) => + let (sizea, sizeb) = (N.lengthNode(dataa0), N.lengthNode(datab0)) + let totalSize = sizea + sizeb + let tmp = A.makeUninitializedUnsafe(totalSize) + ignore(N.fillArray(dataa0, 0, tmp)) + ignore(N.fillArray(datab0, sizea, tmp)) + if ( + A.getUnsafe(tmp, sizea - 1) < A.getUnsafe(tmp, sizea) || + A.getUnsafe(tmp, totalSize - 1) < A.getUnsafe(tmp, 0) + ) { + make() + } else { + let tmp2 = A.makeUninitializedUnsafe(Pervasives.min(sizea, sizeb)) + let k = S.intersect(tmp, 0, sizea, tmp, sizea, sizeb, tmp2, 0) + {data: N.fromSortedArrayAux(tmp2, 0, k)} + } + } +} + +let diff = (dataa, datab): t => { + let (dataa, datab) = (dataa.data, datab.data) + switch (dataa, datab) { + | (None, _) => make() + | (_, None) => {data: N.copy(dataa)} + | (Some(dataa0), Some(datab0)) => + let (sizea, sizeb) = (N.lengthNode(dataa0), N.lengthNode(datab0)) + let totalSize = sizea + sizeb + let tmp = A.makeUninitializedUnsafe(totalSize) + ignore(N.fillArray(dataa0, 0, tmp)) + ignore(N.fillArray(datab0, sizea, tmp)) + if ( + A.getUnsafe(tmp, sizea - 1) < A.getUnsafe(tmp, sizea) || + A.getUnsafe(tmp, totalSize - 1) < A.getUnsafe(tmp, 0) + ) { + {data: N.copy(dataa)} + } else { + let tmp2 = A.makeUninitializedUnsafe(sizea) + let k = S.diff(tmp, 0, sizea, tmp, sizea, sizeb, tmp2, 0) + {data: N.fromSortedArrayAux(tmp2, 0, k)} + } + } +} + +let union = (dataa: t, datab: t): t => { + let (dataa, datab) = (dataa.data, datab.data) + switch (dataa, datab) { + | (None, _) => {data: N.copy(datab)} + | (_, None) => {data: N.copy(dataa)} + | (Some(dataa0), Some(datab0)) => + let (sizea, sizeb) = (N.lengthNode(dataa0), N.lengthNode(datab0)) + let totalSize = sizea + sizeb + let tmp = A.makeUninitializedUnsafe(totalSize) + ignore(N.fillArray(dataa0, 0, tmp)) + ignore(N.fillArray(datab0, sizea, tmp)) + if A.getUnsafe(tmp, sizea - 1) < A.getUnsafe(tmp, sizea) { + {data: N.fromSortedArrayAux(tmp, 0, totalSize)} + } else { + let tmp2 = A.makeUninitializedUnsafe(totalSize) + let k = S.union(tmp, 0, sizea, tmp, sizea, sizeb, tmp2, 0) + {data: N.fromSortedArrayAux(tmp2, 0, k)} + } + } +} + +let has = (d, x) => I.has(d.data, x) + +let copy = d => {data: N.copy(d.data)} diff --git a/belt-cppo/setm.cppo.resi b/belt-cppo/setm.cppo.resi new file mode 100644 index 0000000..cdc2fb0 --- /dev/null +++ b/belt-cppo/setm.cppo.resi @@ -0,0 +1,138 @@ +/* Copyright (C) 2017 Authors of ReScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +/*** +This module is [`Belt.MutableSet`]() specialized with key type to be a primitive type. + +It is more efficient in general, the API is the same with [`Belt.MutableSet`]() except its key type is fixed, +and identity is not needed(using the built-in one) + +**See** [`Belt.MutableSet`]() +*/ + +#ifdef TYPE_STRING +/** The type of the set elements. */ +type value = string +#elif defined TYPE_INT +/** The type of the set elements. */ +type value = int +#else +[%error "unknown type"] +#endif + +/** The type of sets. */ +type t + +let make: unit => t + +let fromArray: array => t +let fromSortedArrayUnsafe: array => t + +let copy: t => t +let isEmpty: t => bool +let has: (t, value) => bool + +let add: (t, value) => unit +let addCheck: (t, value) => bool +let mergeMany: (t, array) => unit +let remove: (t, value) => unit +let removeCheck: (t, value) => bool +let removeMany: (t, array) => unit + +let union: (t, t) => t +let intersect: (t, t) => t +let diff: (t, t) => t +let subset: (t, t) => bool + +let cmp: (t, t) => int +let eq: (t, t) => bool + +let forEachU: (t, value => unit) => unit + +/** In increasing order*/ +let forEach: (t, value => unit) => unit + +let reduceU: (t, 'a, ('a, value) => 'a) => 'a + +/** Iterate in increasing order. */ +let reduce: (t, 'a, ('a, value) => 'a) => 'a + +let everyU: (t, value => bool) => bool + +/** +`every(p, s)` checks if all elements of the set satisfy the predicate `p`. +Order unspecified. */ +let every: (t, value => bool) => bool + +let someU: (t, value => bool) => bool + +/** +`some(p, s)` checks if at least one element of the set satisfies the predicate +`p`. Oder unspecified. +*/ +let some: (t, value => bool) => bool + +let keepU: (t, value => bool) => t + +/** +`keep(s, p)` returns a fresh copy of the set of all elements in `s` that satisfy +predicate `p`. +*/ +let keep: (t, value => bool) => t + +let partitionU: (t, value => bool) => (t, t) + +/** +`partition(s, p)` returns a fresh copy pair of sets `(s1, s2)`, where `s1` is +the set of all the elements of `s` that satisfy the predicate `p`, and `s2` is +the set of all the elements of `s` that do not satisfy `p`. +*/ +let partition: (t, value => bool) => (t, t) + +let size: t => int + +/** In increasing order with respect */ +let toList: t => list + +/** In increasing order with respect */ +let toArray: t => array + +let minimum: t => option +let minUndefined: t => Js.undefined +let maximum: t => option +let maxUndefined: t => Js.undefined + +let get: (t, value) => option +let getUndefined: (t, value) => Js.undefined +let getExn: (t, value) => value + +/** +`split(s, key)` return a fresh copy of each +*/ +let split: (t, value) => ((t, t), bool) + +/** +**raise** when invariant is not held +*/ +let checkInvariantInternal: t => unit diff --git a/belt-cppo/sort.cppo.res b/belt-cppo/sort.cppo.res new file mode 100644 index 0000000..8c521c5 --- /dev/null +++ b/belt-cppo/sort.cppo.res @@ -0,0 +1,310 @@ +#ifdef TYPE_INT +type element = int +#elif defined TYPE_STRING +type element = string +#else +[%error "unknown type"] +#endif + +module A = Belt_Array + +let rec sortedLengthAuxMore = (xs: array, prec, acc, len) => + if acc >= len { + acc + } else { + let v = A.getUnsafe(xs, acc) + if prec > v { + sortedLengthAuxMore(xs, v, acc + 1, len) + } else { + acc + } + } + +let rec sortedLengthAuxLess = (xs: array, prec, acc, len) => + if acc >= len { + acc + } else { + let v = A.getUnsafe(xs, acc) + if prec < v { + sortedLengthAuxLess(xs, v, acc + 1, len) + } else { + acc + } + } + +let strictlySortedLength = (xs: array) => { + let len = A.length(xs) + switch len { + | 0 | 1 => len + | _ => + let (x0, x1) = (A.getUnsafe(xs, 0), A.getUnsafe(xs, 1)) + + /* let c = cmp x0 x1 [@bs] in */ + if x0 < x1 { + sortedLengthAuxLess(xs, x1, 2, len) + } else if x0 > x1 { + -sortedLengthAuxMore(xs, x1, 2, len) + } else { + 1 + } + } +} + +let rec isSortedAux = (a: array, i, last_bound) => + /* when `i = len - 1`, it reaches the last element */ + if i == last_bound { + true + } else if A.getUnsafe(a, i) <= A.getUnsafe(a, i + 1) { + isSortedAux(a, i + 1, last_bound) + } else { + false + } + +let isSorted = a => { + let len = A.length(a) + if len == 0 { + true + } else { + isSortedAux(a, 0, len - 1) + } +} + +let cutoff = 5 + +let merge = (src: array, src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs) => { + let src1r = src1ofs + src1len and src2r = src2ofs + src2len + let rec loop = (i1, s1, i2, s2, d) => + if s1 <= s2 { + A.setUnsafe(dst, d, s1) + let i1 = i1 + 1 + if i1 < src1r { + loop(i1, A.getUnsafe(src, i1), i2, s2, d + 1) + } else { + A.blitUnsafe(~src=src2, ~srcOffset=i2, ~dst, ~dstOffset=d + 1, ~len=src2r - i2) + } + } else { + A.setUnsafe(dst, d, s2) + let i2 = i2 + 1 + if i2 < src2r { + loop(i1, s1, i2, A.getUnsafe(src2, i2), d + 1) + } else { + A.blitUnsafe(~src, ~srcOffset=i1, ~dst, ~dstOffset=d + 1, ~len=src1r - i1) + } + } + + loop(src1ofs, A.getUnsafe(src, src1ofs), src2ofs, A.getUnsafe(src2, src2ofs), dstofs) +} + +let union = (src: array, src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs) => { + let src1r = src1ofs + src1len + let src2r = src2ofs + src2len + let rec loop = (i1, s1, i2, s2, d) => + /* let c = cmp s1 s2 [@bs] in */ + if s1 < s2 { + /* `s1` is larger than all elements in `d` */ + A.setUnsafe(dst, d, s1) + let i1 = i1 + 1 + let d = d + 1 + if i1 < src1r { + loop(i1, A.getUnsafe(src, i1), i2, s2, d) + } else { + A.blitUnsafe(~src=src2, ~srcOffset=i2, ~dst, ~dstOffset=d, ~len=src2r - i2) + d + src2r - i2 + } + } else if s1 == s2 { + A.setUnsafe(dst, d, s1) + let i1 = i1 + 1 + let i2 = i2 + 1 + let d = d + 1 + if i1 < src1r && i2 < src2r { + loop(i1, A.getUnsafe(src, i1), i2, A.getUnsafe(src2, i2), d) + } else if i1 == src1r { + A.blitUnsafe(~src=src2, ~srcOffset=i2, ~dst, ~dstOffset=d, ~len=src2r - i2) + d + src2r - i2 + } else { + A.blitUnsafe(~src, ~srcOffset=i1, ~dst, ~dstOffset=d, ~len=src1r - i1) + d + src1r - i1 + } + } else { + A.setUnsafe(dst, d, s2) + let i2 = i2 + 1 + let d = d + 1 + if i2 < src2r { + loop(i1, s1, i2, A.getUnsafe(src2, i2), d) + } else { + A.blitUnsafe(~src, ~srcOffset=i1, ~dst, ~dstOffset=d, ~len=src1r - i1) + d + src1r - i1 + } + } + + loop(src1ofs, A.getUnsafe(src, src1ofs), src2ofs, A.getUnsafe(src2, src2ofs), dstofs) +} + +let intersect = (src: array, src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs) => { + let src1r = src1ofs + src1len + let src2r = src2ofs + src2len + let rec loop = (i1, s1, i2, s2, d) => + /* let c = cmp s1 s2 [@bs] in */ + if s1 < s2 { + /* A.setUnsafe dst d s1; */ + let i1 = i1 + 1 + if i1 < src1r { + loop(i1, A.getUnsafe(src, i1), i2, s2, d) + } else { + d + } + } else if s1 == s2 { + A.setUnsafe(dst, d, s1) + let i1 = i1 + 1 + let i2 = i2 + 1 + let d = d + 1 + if i1 < src1r && i2 < src2r { + loop(i1, A.getUnsafe(src, i1), i2, A.getUnsafe(src2, i2), d) + } else { + d + } + } else { + /* A.setUnsafe dst d s2; */ + let i2 = i2 + 1 + if i2 < src2r { + loop(i1, s1, i2, A.getUnsafe(src2, i2), d) + } else { + d + } + } + + loop(src1ofs, A.getUnsafe(src, src1ofs), src2ofs, A.getUnsafe(src2, src2ofs), dstofs) +} + +let diff = (src: array, src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs) => { + let src1r = src1ofs + src1len + let src2r = src2ofs + src2len + let rec loop = (i1, s1, i2, s2, d) => + /* let c = cmp s1 s2 [@bs] in */ + if s1 < s2 { + A.setUnsafe(dst, d, s1) + let d = d + 1 + let i1 = i1 + 1 + if i1 < src1r { + loop(i1, A.getUnsafe(src, i1), i2, s2, d) + } else { + d + } + } else if s1 == s2 { + let i1 = i1 + 1 + let i2 = i2 + 1 + if i1 < src1r && i2 < src2r { + loop(i1, A.getUnsafe(src, i1), i2, A.getUnsafe(src2, i2), d) + } else if i1 == src1r { + d + } else { + A.blitUnsafe(~src, ~srcOffset=i1, ~dst, ~dstOffset=d, ~len=src1r - i1) + d + src1r - i1 + } + } else { + let i2 = i2 + 1 + if i2 < src2r { + loop(i1, s1, i2, A.getUnsafe(src2, i2), d) + } else { + A.blitUnsafe(~src, ~srcOffset=i1, ~dst, ~dstOffset=d, ~len=src1r - i1) + d + src1r - i1 + } + } + + loop(src1ofs, A.getUnsafe(src, src1ofs), src2ofs, A.getUnsafe(src2, src2ofs), dstofs) +} + +let insertionSort = (src: array, srcofs, dst, dstofs, len) => + for i in 0 to len - 1 { + let e = A.getUnsafe(src, srcofs + i) + let j = ref(dstofs + i - 1) + while j.contents >= dstofs && A.getUnsafe(dst, j.contents) > e { + A.setUnsafe(dst, j.contents + 1, A.getUnsafe(dst, j.contents)) + j.contents = j.contents - 1 + } + A.setUnsafe(dst, j.contents + 1, e) + } + +let rec sortTo = (src: array, srcofs, dst, dstofs, len) => + if len <= cutoff { + insertionSort(src, srcofs, dst, dstofs, len) + } else { + let l1 = len / 2 + let l2 = len - l1 + sortTo(src, srcofs + l1, dst, dstofs + l1, l2) + sortTo(src, srcofs, src, srcofs + l2, l1) + merge(src, srcofs + l2, l1, dst, dstofs + l1, l2, dst, dstofs) + } + +let stableSortInPlace = (a: array) => { + let l = A.length(a) + if l <= cutoff { + insertionSort(a, 0, a, 0, l) + } else { + let l1 = l / 2 + let l2 = l - l1 + let t = Belt_Array.makeUninitializedUnsafe(l2) + sortTo(a, l1, t, 0, l2) + sortTo(a, 0, a, l2, l1) + merge(a, l2, l1, t, 0, l2, a, 0) + } +} + +let stableSort = a => { + let b = A.copy(a) + stableSortInPlace(b) + b +} + +let rec binarySearchAux = (arr: array, lo, hi, key) => { + let mid = (lo + hi) / 2 + let midVal = A.getUnsafe(arr, mid) + + /* let c = cmp key midVal [@bs] in */ + if key == midVal { + mid + } else if key < midVal { + /* a[lo] =< key < a[mid] <= a[hi] */ + if hi == mid { + if A.getUnsafe(arr, lo) == key { + lo + } else { + -(hi + 1) + } + } else { + binarySearchAux(arr, lo, mid, key) + } + } /* a[lo] =< a[mid] < key <= a[hi] */ + else if lo == mid { + if A.getUnsafe(arr, hi) == key { + hi + } else { + -(hi + 1) + } + } else { + binarySearchAux(arr, mid, hi, key) + } +} + +let binarySearch = (sorted: array, key): int => { + let len = A.length(sorted) + if len == 0 { + -1 + } else { + let lo = A.getUnsafe(sorted, 0) + + /* let c = cmp key lo [@bs] in */ + if key < lo { + -1 + } else { + let hi = A.getUnsafe(sorted, len - 1) + + /* let c2 = cmp key hi [@bs]in */ + if key > hi { + -(len + 1) + } else { + binarySearchAux(sorted, 0, len - 1, key) + } + } + } +} diff --git a/belt-cppo/sort.cppo.resi b/belt-cppo/sort.cppo.resi new file mode 100644 index 0000000..8570da4 --- /dev/null +++ b/belt-cppo/sort.cppo.resi @@ -0,0 +1,81 @@ +/* Copyright (C) 2017 Authors of ReScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +/*** +This is a specialized module for [`Belt_SortArray`](), the docs in that module also +applies here, except the comparator is fixed and inlined +*/ + +#ifdef TYPE_INT +type element = int +#elif defined TYPE_STRING +type element = string +#else +[%error "unknown type"] +#endif + +/** +The same as [`Belt_SortArray.strictlySortedLength`]() except the comparator is fixed + +**return** `+n` means increasing order `-n` means negative order +*/ +let strictlySortedLength: array => int + +/** `sorted(xs)` return true if `xs` is in non strict increasing order */ +let isSorted: array => bool + +/** +The same as [`Belt_SortArray.stableSortInPlaceBy`]() except the comparator is fixed +*/ +let stableSortInPlace: array => unit + +/** +The same as [`Belt_SortArray.stableSortBy`]() except the comparator is fixed +*/ +let stableSort: array => array + +/** +If value is not found and value is less than one or more elements in array, +the negative number returned is the bitwise complement of the index of the first element +that is larger than value. + +If value is not found and value is greater than all elements in array, +the negative number returned is the bitwise complement of +(the index of the last element plus 1) + +for example, if `key` is smaller than all elements return `-1` since `lnot (-1) = 0` +if `key` is larger than all elements return `- (len + 1)` since `lnot (-(len+1)) = len` +*/ +let binarySearch: (array, element) => int + +/** +`union(src, src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs, cmp)` assume +`src` and `src2` is strictly sorted. for equivalent elements, it is picked from +`src` also assume that `dst` is large enough to store all elements +*/ +let union: (array, int, int, array, int, int, array, int) => int + +let intersect: (array, int, int, array, int, int, array, int) => int + +let diff: (array, int, int, array, int, int, array, int) => int diff --git a/belt/src/belt.res b/belt/src/belt.res index c97d77f..333b098 100644 --- a/belt/src/belt.res +++ b/belt/src/belt.res @@ -92,7 +92,7 @@ E.g.: ```rescript let forEach: (t<'a>, 'a => unit) => unit -let forEachU: (t<'a>, (. 'a) => unit) => unit +let forEachU: (t<'a>, 'a => unit) => unit ``` The uncurried version will be faster in some cases, but for simplicity we recommend to stick with the curried version unless you need the extra performance. @@ -104,7 +104,7 @@ The two versions can be invoked as follows: ```rescript ["a", "b", "c"]->Belt.Array.forEach(x => Js.log(x)) -["a", "b", "c"]->Belt.Array.forEachU((. x) => Js.log(x)) +["a", "b", "c"]->Belt.Array.forEachU(x => Js.log(x)) ``` ## Specialized Collections diff --git a/belt/src/belt_HashMap.resi b/belt/src/belt_HashMap.resi index e60d5ad..a391c09 100644 --- a/belt/src/belt_HashMap.resi +++ b/belt/src/belt_HashMap.resi @@ -33,10 +33,10 @@ _hash_ functions will have different type. ```rescript type t = int -module I0 = unpack(Belt.Id.hashableU(~hash=(. a: t) => "&"(a, 0xff_ff), ~eq=(. a, b) => a == b)) +module I0 = unpack(Belt.Id.hashableU(~hash=(a: t) => "&"(a, 0xff_ff), ~eq=(a, b) => a == b)) let s0: t<_, string, _> = make(~hintSize=40, ~id=module(I0)) -module I1 = unpack(Belt.Id.hashableU(~hash=(. a: t) => "&"(a, 0xff), ~eq=(. a, b) => a == b)) +module I1 = unpack(Belt.Id.hashableU(~hash=(a: t) => "&"(a, 0xff), ~eq=(a, b) => a == b)) let s1: t<_, string, _> = make(~hintSize=40, ~id=module(I1)) ``` diff --git a/belt/src/belt_HashSet.resi b/belt/src/belt_HashSet.resi index 990e80d..0fd011c 100644 --- a/belt/src/belt_HashSet.resi +++ b/belt/src/belt_HashSet.resi @@ -34,8 +34,8 @@ different _hash_ functions will have different type. ```rescript module I0 = unpack( Belt.Id.hashableU( - ~hash=(. a: int) => land(a, 65535), - ~eq=(. a, b) => a == b, + ~hash=(a: int) => land(a, 65535), + ~eq=(a, b) => a == b, ) ) @@ -43,8 +43,8 @@ let s0 = Belt.HashSet.make(~id=module(I0), ~hintSize=40) module I1 = unpack( Belt.Id.hashableU( - ~hash=(. a: int) => land(a, 255), - ~eq=(. a, b) => a == b, + ~hash=(a: int) => land(a, 255), + ~eq=(a, b) => a == b, ) ) diff --git a/scripts/cppo.js b/scripts/cppo.js new file mode 100644 index 0000000..c83cd16 --- /dev/null +++ b/scripts/cppo.js @@ -0,0 +1,51 @@ +// @ts-check + +const { execFileSync } = require("child_process"); + +[ + ["belt_HashSetString.res", "hashset.cppo.res", "TYPE_STRING"], + ["belt_HashSetString.resi", "hashset.cppo.resi", "TYPE_STRING"], + ["belt_HashSetInt.res", "hashset.cppo.res", "TYPE_INT"], + ["belt_HashSetInt.resi", "hashset.cppo.resi", "TYPE_INT"], + ["belt_HashMapString.res", "hashmap.cppo.res", "TYPE_STRING"], + ["belt_HashMapString.resi", "hashmap.cppo.resi", "TYPE_STRING"], + ["belt_HashMapInt.res", "hashmap.cppo.res", "TYPE_INT"], + ["belt_HashMapInt.resi", "hashmap.cppo.resi", "TYPE_INT"], + ["belt_MapString.res", "map.cppo.res", "TYPE_STRING"], + ["belt_MapString.resi", "map.cppo.resi", "TYPE_STRING"], + ["belt_MapInt.res", "map.cppo.res", "TYPE_INT"], + ["belt_MapInt.resi", "map.cppo.resi", "TYPE_INT"], + ["belt_SetString.res", "belt_Set.cppo.res", "TYPE_STRING"], + ["belt_SetString.resi", "belt_Set.cppo.resi", "TYPE_STRING"], + ["belt_SetInt.res", "belt_Set.cppo.res", "TYPE_INT"], + ["belt_SetInt.resi", "belt_Set.cppo.resi", "TYPE_INT"], + ["belt_MutableMapString.res", "mapm.cppo.res", "TYPE_STRING"], + ["belt_MutableMapString.resi", "mapm.cppo.resi", "TYPE_STRING"], + ["belt_MutableMapInt.res", "mapm.cppo.res", "TYPE_INT"], + ["belt_MutableMapInt.resi", "mapm.cppo.resi", "TYPE_INT"], + ["belt_MutableSetString.res", "setm.cppo.res", "TYPE_STRING"], + ["belt_MutableSetString.resi", "setm.cppo.resi", "TYPE_STRING"], + ["belt_MutableSetInt.res", "setm.cppo.res", "TYPE_INT"], + ["belt_MutableSetInt.resi", "setm.cppo.resi", "TYPE_INT"], + ["belt_SortArrayString.res", "sort.cppo.res", "TYPE_STRING"], + ["belt_SortArrayString.resi", "sort.cppo.resi", "TYPE_STRING"], + ["belt_SortArrayInt.res", "sort.cppo.res", "TYPE_INT"], + ["belt_SortArrayInt.resi", "sort.cppo.resi", "TYPE_INT"], + ["belt_internalMapString.res", "internal_map.cppo.res", "TYPE_STRING"], + ["belt_internalMapInt.res", "internal_map.cppo.res", "TYPE_INT"], + ["belt_internalSetString.res", "internal_set.cppo.res", "TYPE_STRING"], + ["belt_internalSetInt.res", "internal_set.cppo.res", "TYPE_INT"], +].forEach(([output, input, type]) => { + execFileSync( + "cppo", + [ + "-n", + "-D", + type, + `belt-cppo/${input}`, + "-o", + `belt/src/${output}`, + ], + { stdio: "inherit" }, + ); +});