diff --git a/.travis.yml b/.travis.yml index 9f874d8156b..bcf27ea7e9a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -8,12 +8,12 @@ env: - BS_TRAVIS_CI=1 node_js: - 6 - +script: npm run coveralls # # - 6 # This delays notification # Not a very reliable service.. -# script: npm run coveralls + # FIXME: instrumentation takes too much time diff --git a/jscomp/others/.depend b/jscomp/others/.depend index 3a2931581a6..221f3b9e3f0 100644 --- a/jscomp/others/.depend +++ b/jscomp/others/.depend @@ -17,14 +17,22 @@ js_console.cmj : js_result.cmj : js_result.cmi js_mapperRt.cmj : js_mapperRt.cmi bs_Array.cmj : js_math.cmj bs_Array.cmi -bs_internalAVLset.cmj : +bs_internalAVLset.cmj : bs_Array.cmj bs.cmj bs_internalAVLtree.cmj : bs_internalMutableAVLSet.cmj : bs_internalAVLset.cmj bs_Hash.cmj : bs_Hash.cmi bs_Queue.cmj : bs_Array.cmj bs_Queue.cmi -bs_internalBuckets.cmj : bs_Array.cmj -bs_HashMap.cmj : bs_internalBuckets.cmj bs_Hash.cmj bs_Bag.cmj bs_Array.cmj \ - bs_HashMap.cmi +bs_internalBucketsType.cmj : bs_Array.cmj +bs_internalSetBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj bs.cmj +bs_internalBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj +bs_HashMap.cmj : bs_internalBucketsType.cmj bs_internalBuckets.cmj \ + bs_Hash.cmj bs_Bag.cmj bs_Array.cmj bs_HashMap.cmi +bs_HashSet.cmj : bs_internalSetBuckets.cmj bs_internalBucketsType.cmj \ + bs_Hash.cmj bs_Bag.cmj bs_Array.cmj bs_HashSet.cmi +bs_HashSetString.cmj : bs_internalSetBuckets.cmj bs_internalBucketsType.cmj \ + bs_Array.cmj bs.cmj bs_HashSetString.cmi +bs_HashSetInt.cmj : bs_internalSetBuckets.cmj bs_internalBucketsType.cmj \ + bs_Array.cmj bs.cmj bs_HashSetInt.cmi bs_Bag.cmj : bs_Cmp.cmj : bs_Cmp.cmi bs_Map.cmj : bs_internalAVLtree.cmj bs_Cmp.cmj bs_Bag.cmj bs_Array.cmj \ @@ -43,9 +51,10 @@ js_date.cmj : js_global.cmj : js_cast.cmj : js_cast.cmi js_promise.cmj : -bs_HashMapInt.cmj : bs_internalBuckets.cmj bs_Array.cmj bs_HashMapInt.cmi -bs_HashMapString.cmj : bs_internalBuckets.cmj bs_Array.cmj \ - bs_HashMapString.cmi +bs_HashMapInt.cmj : bs_internalBucketsType.cmj bs_internalBuckets.cmj \ + bs_Array.cmj bs_HashMapInt.cmi +bs_HashMapString.cmj : bs_internalBucketsType.cmj bs_internalBuckets.cmj \ + bs_Array.cmj bs_HashMapString.cmi node_process.cmi : js_dict.cmi js_re.cmi : js_null_undefined.cmi : @@ -60,6 +69,9 @@ bs_Array.cmi : bs_Hash.cmi : bs_Queue.cmi : bs_HashMap.cmi : bs_Hash.cmi bs_Bag.cmj +bs_HashSet.cmi : bs_Hash.cmi bs_Bag.cmj +bs_HashSetString.cmi : +bs_HashSetInt.cmi : bs_Cmp.cmi : bs_Map.cmi : bs_Cmp.cmi bs_Bag.cmj bs_Set.cmi : bs_Cmp.cmi bs_Bag.cmj diff --git a/jscomp/others/Makefile b/jscomp/others/Makefile index 79691790161..76842fa1374 100644 --- a/jscomp/others/Makefile +++ b/jscomp/others/Makefile @@ -17,8 +17,13 @@ SOURCE_LIST= node_path node_fs node_process dict node_module js_array js_string bs_internalMutableAVL\ bs_Hash\ bs_Queue\ + bs_internalBucketsType\ + bs_internalSetBuckets\ bs_internalBuckets\ bs_HashMap\ + bs_HashSet\ + bs_HashSetString\ + bs_HashSetInt\ bs_Bag\ bs_Cmp\ bs_Map\ @@ -60,6 +65,14 @@ clean:: rm -f *.rawlambda *.lam *.lambda *.map ifndef BS_RELEASE_BUILD +bs_HashSetString.ml: hashset.cppo.ml + cppo -D TYPE_STRING $^ > $@ +bs_HashSetInt.ml: hashset.cppo.ml + cppo -D TYPE_INT $^ > $@ +bs_HashSetString.mli: hashset.cppo.mli + cppo -D TYPE_STRING $^ > $@ +bs_HashSetInt.mli: hashset.cppo.mli + cppo -D TYPE_INT $^ > $@ bs_HashMapString.ml: hashmap.cppo.ml cppo -D TYPE_STRING $^ > $@ bs_HashMapInt.ml: hashmap.cppo.ml diff --git a/jscomp/others/bs.ml b/jscomp/others/bs.ml index d2bb5881630..70902672902 100644 --- a/jscomp/others/bs.ml +++ b/jscomp/others/bs.ml @@ -32,6 +32,9 @@ module Hash = Bs_Hash module Array = Bs_Array module Queue = Bs_Queue module HashMap = Bs_HashMap +module HashSet = Bs_HashSet +module HashSetInt = Bs_HashSetInt +module HashSetString = Bs_HashSetInt module HashMapString = Bs_HashMapString module HashMapInt = Bs_HashMapInt module Map = Bs_Map diff --git a/jscomp/others/bs_Bag.ml b/jscomp/others/bs_Bag.ml index dad650d2b9d..efa626ab8ee 100644 --- a/jscomp/others/bs_Bag.ml +++ b/jscomp/others/bs_Bag.ml @@ -1,6 +1,28 @@ - +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) type (+ 'k, + 'v) bag = { dict : 'k ; data : 'v -} [@@bs.deriving abstract] \ No newline at end of file +} [@@bs.deriving abstract] diff --git a/jscomp/others/bs_HashMap.ml b/jscomp/others/bs_HashMap.ml index d5addf6e9b4..1f56770f9b0 100644 --- a/jscomp/others/bs_HashMap.ml +++ b/jscomp/others/bs_HashMap.ml @@ -13,8 +13,9 @@ (** Adapted by Authors of BuckleScript 2017 *) module N = Bs_internalBuckets +module C = Bs_internalBucketsType module B = Bs_Bag -type ('a, 'b,'id) t0 = ('a,'b,'id) N.t0 +type ('a, 'b,'id) t0 = ('a,'b) N.t0 type ('a,'b) bucket = ('a,'b) N.bucket @@ -26,12 +27,12 @@ type ('a,'b,'id) t = let rec insert_bucket ~hash ~h_buckets ~ndata_tail h old_bucket = - match N.toOpt old_bucket with + match C.toOpt old_bucket with | None -> () | Some cell -> let nidx = (Bs_Hash.getHash hash) (N.key cell) [@bs] land (Array.length h_buckets - 1) in - let v = N.return cell in - begin match N.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with + let v = C.return cell in + begin match C.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with | None -> Bs_Array.unsafe_set h_buckets nidx v | Some tail -> @@ -42,79 +43,79 @@ let rec insert_bucket ~hash ~h_buckets ~ndata_tail h old_bucket = let resize ~hash h = - let odata = N.buckets h in + let odata = C.buckets h in let osize = Array.length odata in let nsize = osize * 2 in if nsize >= osize then begin (* no overflow *) - let h_buckets = N.makeSize nsize in - let ndata_tail = N.makeSize nsize in (* keep track of tail *) - N.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) + let h_buckets = C.makeSize nsize in + let ndata_tail = C.makeSize nsize in (* keep track of tail *) + C.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) for i = 0 to osize - 1 do insert_bucket ~hash ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i) done; for i = 0 to nsize - 1 do - match N.toOpt (Bs_Array.unsafe_get ndata_tail i) with + match C.toOpt (Bs_Array.unsafe_get ndata_tail i) with | None -> () - | Some tail -> N.nextSet tail N.emptyOpt + | Some tail -> N.nextSet tail C.emptyOpt done end let add0 ~hash h key value = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let h_buckets_lenth = Array.length h_buckets in let i = (Bs_Hash.getHash hash) key [@bs] land (h_buckets_lenth - 1) in let bucket = N.bucket ~key ~value ~next:(Bs_Array.unsafe_get h_buckets i) in - Bs_Array.unsafe_set h_buckets i (N.return bucket); - let h_new_size = N.size h + 1 in - N.sizeSet h h_new_size; + Bs_Array.unsafe_set h_buckets i (C.return bucket); + let h_new_size = C.size h + 1 in + C.sizeSet h h_new_size; if h_new_size > h_buckets_lenth lsl 1 then resize ~hash h let rec remove_bucket ~eq h h_buckets i key prec buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> () | Some cell -> let cell_next = N.next cell in if (Bs_Hash.getEq eq) (N.key cell) key [@bs] then begin - (match N.toOpt prec with + (match C.toOpt prec with | None -> Bs_Array.unsafe_set h_buckets i cell_next | Some c -> N.nextSet c cell_next); - N.sizeSet h (N.size h - 1); + C.sizeSet h (C.size h - 1); end else remove_bucket ~eq h h_buckets i key buckets cell_next let remove0 ~hash ~eq h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = (Bs_Hash.getHash hash) key [@bs] land (Array.length h_buckets - 1) in - remove_bucket ~eq h h_buckets i key N.emptyOpt (Bs_Array.unsafe_get h_buckets i) + remove_bucket ~eq h h_buckets i key C.emptyOpt (Bs_Array.unsafe_get h_buckets i) let rec removeAllBuckets ~eq h h_buckets i key prec buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> () | Some cell -> let cell_next = N.next cell in if (Bs_Hash.getEq eq) (N.key cell) key [@bs] then begin - (match N.toOpt prec with + (match C.toOpt prec with | None -> Bs_Array.unsafe_set h_buckets i cell_next | Some c -> N.nextSet c cell_next); - N.sizeSet h (N.size h - 1); + C.sizeSet h (C.size h - 1); end; removeAllBuckets ~eq h h_buckets i key buckets cell_next let removeAll0 ~hash ~eq h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = (Bs_Hash.getHash hash) key [@bs] land (Array.length h_buckets - 1) in - removeAllBuckets ~eq h h_buckets i key N.emptyOpt (Bs_Array.unsafe_get h_buckets i) + removeAllBuckets ~eq h h_buckets i key C.emptyOpt (Bs_Array.unsafe_get h_buckets i) let rec find_rec ~eq key buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> None | Some cell -> @@ -122,21 +123,21 @@ let rec find_rec ~eq key buckets = else find_rec ~eq key (N.next cell) let findOpt0 ~hash ~eq h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = (Bs_Hash.getHash hash) key [@bs] land (Array.length h_buckets - 1) in - match N.toOpt @@ Bs_Array.unsafe_get h_buckets nid with + match C.toOpt @@ Bs_Array.unsafe_get h_buckets nid with | None -> None | Some cell1 -> if (Bs_Hash.getEq eq) key (N.key cell1) [@bs] then Some (N.value cell1) else - match N.toOpt (N.next cell1) with + match C.toOpt (N.next cell1) with | None -> None | Some cell2 -> if (Bs_Hash.getEq eq) key (N.key cell2) [@bs] then Some (N.value cell2) else - match N.toOpt (N.next cell2) with + match C.toOpt (N.next cell2) with | None -> None | Some cell3 -> if (Bs_Hash.getEq eq) key @@ -148,7 +149,7 @@ let findOpt0 ~hash ~eq h key = let findAll0 ~hash ~eq h key = let rec find_in_bucket buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> [] | Some cell -> @@ -156,12 +157,12 @@ let findAll0 ~hash ~eq h key = (N.key cell) key [@bs] then (N.value cell) :: find_in_bucket (N.next cell) else find_in_bucket (N.next cell) in - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = (Bs_Hash.getHash hash) key [@bs] land (Array.length h_buckets - 1) in find_in_bucket (Bs_Array.unsafe_get h_buckets nid) let rec replace_bucket ~eq key info buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> true | Some cell -> @@ -176,36 +177,39 @@ let rec replace_bucket ~eq key info buckets = replace_bucket ~eq key info (N.next cell) let replace0 ~hash ~eq h key info = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = (Bs_Hash.getHash hash) key [@bs] land (Array.length h_buckets - 1) in let l = Array.unsafe_get h_buckets i in if replace_bucket ~eq key info l then begin - Bs_Array.unsafe_set h_buckets i (N.return + Bs_Array.unsafe_set h_buckets i (C.return (N.bucket ~key ~value:info ~next:l)); - N.sizeSet h (N.size h + 1); - if N.size h > Array.length (N.buckets h) lsl 1 then resize ~hash h + C.sizeSet h (C.size h + 1); + if C.size h > Array.length (C.buckets h) lsl 1 then resize ~hash h (* TODO: duplicate bucklets ? *) end -let rec mem_in_bucket ~eq key buckets = - match N.toOpt buckets with - | None -> - false - | Some cell -> +let rec mem_in_bucket ~eq key cell = (Bs_Hash.getEq eq) (N.key cell) key [@bs] || - mem_in_bucket ~eq key (N.next cell) + (match C.toOpt (N.next cell) with + | None -> false + | Some nextCell -> + mem_in_bucket ~eq key nextCell) let mem0 ~hash ~eq h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = (Bs_Hash.getHash hash) key [@bs] land (Array.length h_buckets - 1) in - mem_in_bucket ~eq key (Bs_Array.unsafe_get h_buckets nid) + let bucket = (Bs_Array.unsafe_get h_buckets nid) in + match C.toOpt bucket with + | None -> false + | Some bucket -> + mem_in_bucket ~eq key bucket -let create0 = N.create0 -let clear0 = N.clear0 -let reset0 = N.reset0 -let length0 = N.length0 +let create0 = C.create0 +let clear0 = C.clear0 +let reset0 = C.reset0 +let length0 = C.length0 let iter0 = N.iter0 let fold0 = N.fold0 let logStats0 = N.logStats0 diff --git a/jscomp/others/bs_HashMapInt.ml b/jscomp/others/bs_HashMapInt.ml index 71914c3dbf9..8a7ac368ace 100644 --- a/jscomp/others/bs_HashMapInt.ml +++ b/jscomp/others/bs_HashMapInt.ml @@ -21,19 +21,19 @@ let hash (s : key) = (***********************************************************************) (** Adapted by Authors of BuckleScript 2017 *) module N = Bs_internalBuckets - -type ('a, 'b,'id) t0 = ('a,'b,'id) N.t0 +module C = Bs_internalBucketsType +type ('a, 'b,'id) t0 = ('a,'b) N.t0 type 'b t = (key,'b,unit) t0 let rec insert_bucket ~h_buckets ~ndata_tail h old_bucket = - match N.toOpt old_bucket with + match C.toOpt old_bucket with | None -> () | Some cell -> let nidx = hash (N.key cell) land (Array.length h_buckets - 1) in - let v = N.return cell in - begin match N.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with + let v = C.return cell in + begin match C.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with | None -> Bs_Array.unsafe_set h_buckets nidx v | Some tail -> @@ -44,82 +44,82 @@ let rec insert_bucket ~h_buckets ~ndata_tail h old_bucket = let resize h = - let odata = N.buckets h in + let odata = C.buckets h in let osize = Array.length odata in let nsize = osize * 2 in if nsize >= osize then begin (* no overflow *) - let h_buckets = N.makeSize nsize in - let ndata_tail = N.makeSize nsize in (* keep track of tail *) - N.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) + let h_buckets = C.makeSize nsize in + let ndata_tail = C.makeSize nsize in (* keep track of tail *) + C.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) for i = 0 to osize - 1 do insert_bucket ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i) done; for i = 0 to nsize - 1 do - match N.toOpt (Bs_Array.unsafe_get ndata_tail i) with + match C.toOpt (Bs_Array.unsafe_get ndata_tail i) with | None -> () - | Some tail -> N.nextSet tail N.emptyOpt + | Some tail -> N.nextSet tail C.emptyOpt done end let add h key value = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let h_buckets_lenth = Array.length h_buckets in let i = hash key land (h_buckets_lenth - 1) in let bucket = N.bucket ~key ~value ~next:(Bs_Array.unsafe_get h_buckets i) in - Bs_Array.unsafe_set h_buckets i (N.return bucket); - let h_new_size = N.size h + 1 in - N.sizeSet h h_new_size; + Bs_Array.unsafe_set h_buckets i (C.return bucket); + let h_new_size = C.size h + 1 in + C.sizeSet h h_new_size; if h_new_size > h_buckets_lenth lsl 1 then resize h let rec remove_bucket h h_buckets i (key : key) prec buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> () | Some cell -> let cell_next = N.next cell in if N.key cell = key then begin - (match N.toOpt prec with + (match C.toOpt prec with | None -> Bs_Array.unsafe_set h_buckets i cell_next | Some c -> N.nextSet c cell_next); - N.sizeSet h (N.size h - 1); + C.sizeSet h (C.size h - 1); end else remove_bucket h h_buckets i key buckets cell_next let remove h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = hash key land (Array.length h_buckets - 1) in - remove_bucket h h_buckets i key N.emptyOpt (Bs_Array.unsafe_get h_buckets i) + remove_bucket h h_buckets i key C.emptyOpt (Bs_Array.unsafe_get h_buckets i) let rec removeAllBuckets h h_buckets i (key : key) prec buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> () | Some cell -> let cell_next = N.next cell in if N.key cell = key then begin - (match N.toOpt prec with + (match C.toOpt prec with | None -> Bs_Array.unsafe_set h_buckets i cell_next | Some c -> N.nextSet c cell_next); - N.sizeSet h (N.size h - 1); + C.sizeSet h (C.size h - 1); end; removeAllBuckets h h_buckets i key buckets cell_next let removeAll h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = hash key land (Array.length h_buckets - 1) in - removeAllBuckets h h_buckets i key N.emptyOpt (Bs_Array.unsafe_get h_buckets i) + removeAllBuckets h h_buckets i key C.emptyOpt (Bs_Array.unsafe_get h_buckets i) (* TODO: add [removeAll] *) let rec find_rec (key : key) buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> None | Some cell -> @@ -127,17 +127,17 @@ let rec find_rec (key : key) buckets = else find_rec key (N.next cell) let findOpt h (key : key) = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = hash key land (Array.length h_buckets - 1) in - match N.toOpt @@ Bs_Array.unsafe_get h_buckets nid with + match C.toOpt @@ Bs_Array.unsafe_get h_buckets nid with | None -> None | Some cell1 -> if key = (N.key cell1) then Some (N.value cell1) else - match N.toOpt (N.next cell1) with + match C.toOpt (N.next cell1) with | None -> None | Some cell2 -> if key = (N.key cell2) then Some (N.value cell2) else - match N.toOpt (N.next cell2) with + match C.toOpt (N.next cell2) with | None -> None | Some cell3 -> if key = (N.key cell3) then Some (N.value cell3) @@ -146,19 +146,19 @@ let findOpt h (key : key) = let findAll h (key : key) = let rec find_in_bucket buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> [] | Some cell -> if (N.key cell) = key then (N.value cell) :: find_in_bucket (N.next cell) else find_in_bucket (N.next cell) in - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = hash key land (Array.length h_buckets - 1) in find_in_bucket (Bs_Array.unsafe_get h_buckets nid) let rec replace_bucket (key : key) info buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> true | Some cell -> @@ -173,32 +173,32 @@ let rec replace_bucket (key : key) info buckets = replace_bucket key info (N.next cell) let replace h (key : key) info = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = hash key land (Array.length h_buckets - 1) in let l = Array.unsafe_get h_buckets i in if replace_bucket key info l then begin - Bs_Array.unsafe_set h_buckets i (N.return + Bs_Array.unsafe_set h_buckets i (C.return (N.bucket ~key ~value:info ~next:l)); - N.sizeSet h (N.size h + 1); - if N.size h > Array.length (N.buckets h) lsl 1 then resize h + C.sizeSet h (C.size h + 1); + if C.size h > Array.length (C.buckets h) lsl 1 then resize h end let rec mem_in_bucket (key : key) buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> false | Some cell -> (N.key cell) = key || mem_in_bucket key (N.next cell) let mem h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = hash key land (Array.length h_buckets - 1) in mem_in_bucket key (Bs_Array.unsafe_get h_buckets nid) -let create = N.create0 -let clear = N.clear0 -let reset = N.reset0 -let length = N.length0 +let create = C.create0 +let clear = C.clear0 +let reset = C.reset0 +let length = C.length0 let iter = N.iter0 let fold = N.fold0 let logStats = N.logStats0 diff --git a/jscomp/others/bs_HashMapString.ml b/jscomp/others/bs_HashMapString.ml index 764adbfbba4..e4f4f30c67d 100644 --- a/jscomp/others/bs_HashMapString.ml +++ b/jscomp/others/bs_HashMapString.ml @@ -21,19 +21,19 @@ let hash (s : key) = (***********************************************************************) (** Adapted by Authors of BuckleScript 2017 *) module N = Bs_internalBuckets - -type ('a, 'b,'id) t0 = ('a,'b,'id) N.t0 +module C = Bs_internalBucketsType +type ('a, 'b,'id) t0 = ('a,'b) N.t0 type 'b t = (key,'b,unit) t0 let rec insert_bucket ~h_buckets ~ndata_tail h old_bucket = - match N.toOpt old_bucket with + match C.toOpt old_bucket with | None -> () | Some cell -> let nidx = hash (N.key cell) land (Array.length h_buckets - 1) in - let v = N.return cell in - begin match N.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with + let v = C.return cell in + begin match C.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with | None -> Bs_Array.unsafe_set h_buckets nidx v | Some tail -> @@ -44,82 +44,82 @@ let rec insert_bucket ~h_buckets ~ndata_tail h old_bucket = let resize h = - let odata = N.buckets h in + let odata = C.buckets h in let osize = Array.length odata in let nsize = osize * 2 in if nsize >= osize then begin (* no overflow *) - let h_buckets = N.makeSize nsize in - let ndata_tail = N.makeSize nsize in (* keep track of tail *) - N.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) + let h_buckets = C.makeSize nsize in + let ndata_tail = C.makeSize nsize in (* keep track of tail *) + C.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) for i = 0 to osize - 1 do insert_bucket ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i) done; for i = 0 to nsize - 1 do - match N.toOpt (Bs_Array.unsafe_get ndata_tail i) with + match C.toOpt (Bs_Array.unsafe_get ndata_tail i) with | None -> () - | Some tail -> N.nextSet tail N.emptyOpt + | Some tail -> N.nextSet tail C.emptyOpt done end let add h key value = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let h_buckets_lenth = Array.length h_buckets in let i = hash key land (h_buckets_lenth - 1) in let bucket = N.bucket ~key ~value ~next:(Bs_Array.unsafe_get h_buckets i) in - Bs_Array.unsafe_set h_buckets i (N.return bucket); - let h_new_size = N.size h + 1 in - N.sizeSet h h_new_size; + Bs_Array.unsafe_set h_buckets i (C.return bucket); + let h_new_size = C.size h + 1 in + C.sizeSet h h_new_size; if h_new_size > h_buckets_lenth lsl 1 then resize h let rec remove_bucket h h_buckets i (key : key) prec buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> () | Some cell -> let cell_next = N.next cell in if N.key cell = key then begin - (match N.toOpt prec with + (match C.toOpt prec with | None -> Bs_Array.unsafe_set h_buckets i cell_next | Some c -> N.nextSet c cell_next); - N.sizeSet h (N.size h - 1); + C.sizeSet h (C.size h - 1); end else remove_bucket h h_buckets i key buckets cell_next let remove h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = hash key land (Array.length h_buckets - 1) in - remove_bucket h h_buckets i key N.emptyOpt (Bs_Array.unsafe_get h_buckets i) + remove_bucket h h_buckets i key C.emptyOpt (Bs_Array.unsafe_get h_buckets i) let rec removeAllBuckets h h_buckets i (key : key) prec buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> () | Some cell -> let cell_next = N.next cell in if N.key cell = key then begin - (match N.toOpt prec with + (match C.toOpt prec with | None -> Bs_Array.unsafe_set h_buckets i cell_next | Some c -> N.nextSet c cell_next); - N.sizeSet h (N.size h - 1); + C.sizeSet h (C.size h - 1); end; removeAllBuckets h h_buckets i key buckets cell_next let removeAll h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = hash key land (Array.length h_buckets - 1) in - removeAllBuckets h h_buckets i key N.emptyOpt (Bs_Array.unsafe_get h_buckets i) + removeAllBuckets h h_buckets i key C.emptyOpt (Bs_Array.unsafe_get h_buckets i) (* TODO: add [removeAll] *) let rec find_rec (key : key) buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> None | Some cell -> @@ -127,17 +127,17 @@ let rec find_rec (key : key) buckets = else find_rec key (N.next cell) let findOpt h (key : key) = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = hash key land (Array.length h_buckets - 1) in - match N.toOpt @@ Bs_Array.unsafe_get h_buckets nid with + match C.toOpt @@ Bs_Array.unsafe_get h_buckets nid with | None -> None | Some cell1 -> if key = (N.key cell1) then Some (N.value cell1) else - match N.toOpt (N.next cell1) with + match C.toOpt (N.next cell1) with | None -> None | Some cell2 -> if key = (N.key cell2) then Some (N.value cell2) else - match N.toOpt (N.next cell2) with + match C.toOpt (N.next cell2) with | None -> None | Some cell3 -> if key = (N.key cell3) then Some (N.value cell3) @@ -146,19 +146,19 @@ let findOpt h (key : key) = let findAll h (key : key) = let rec find_in_bucket buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> [] | Some cell -> if (N.key cell) = key then (N.value cell) :: find_in_bucket (N.next cell) else find_in_bucket (N.next cell) in - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = hash key land (Array.length h_buckets - 1) in find_in_bucket (Bs_Array.unsafe_get h_buckets nid) let rec replace_bucket (key : key) info buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> true | Some cell -> @@ -173,32 +173,32 @@ let rec replace_bucket (key : key) info buckets = replace_bucket key info (N.next cell) let replace h (key : key) info = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = hash key land (Array.length h_buckets - 1) in let l = Array.unsafe_get h_buckets i in if replace_bucket key info l then begin - Bs_Array.unsafe_set h_buckets i (N.return + Bs_Array.unsafe_set h_buckets i (C.return (N.bucket ~key ~value:info ~next:l)); - N.sizeSet h (N.size h + 1); - if N.size h > Array.length (N.buckets h) lsl 1 then resize h + C.sizeSet h (C.size h + 1); + if C.size h > Array.length (C.buckets h) lsl 1 then resize h end let rec mem_in_bucket (key : key) buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> false | Some cell -> (N.key cell) = key || mem_in_bucket key (N.next cell) let mem h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = hash key land (Array.length h_buckets - 1) in mem_in_bucket key (Bs_Array.unsafe_get h_buckets nid) -let create = N.create0 -let clear = N.clear0 -let reset = N.reset0 -let length = N.length0 +let create = C.create0 +let clear = C.clear0 +let reset = C.reset0 +let length = C.length0 let iter = N.iter0 let fold = N.fold0 let logStats = N.logStats0 diff --git a/jscomp/others/bs_HashSet.ml b/jscomp/others/bs_HashSet.ml new file mode 100644 index 00000000000..1e9fee3f430 --- /dev/null +++ b/jscomp/others/bs_HashSet.ml @@ -0,0 +1,199 @@ +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + + +module N = Bs_internalSetBuckets +module C = Bs_internalBucketsType +module B = Bs_Bag +type ('a,'id) t0 = 'a N.t0 + + +type 'a bucket = 'a N.bucket + +type ('a,'id) t = + (('a, 'id) Bs_Hash.t, + ('a,'id) t0) B.bag + + + +let rec insert_bucket ~hash ~h_buckets ~ndata_tail h old_bucket = + match C.toOpt old_bucket with + | None -> () + | Some cell -> + let nidx = (Bs_Hash.getHash hash) (N.key cell) [@bs] land (Array.length h_buckets - 1) in + let v = C.return cell in + begin match C.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with + | None -> + Bs_Array.unsafe_set h_buckets nidx v + | Some tail -> + N.nextSet tail v (* cell put at the end *) + end; + Bs_Array.unsafe_set ndata_tail nidx v; + insert_bucket ~hash ~h_buckets ~ndata_tail h (N.next cell) + + +let resize ~hash h = + let odata = C.buckets h in + let osize = Array.length odata in + let nsize = osize * 2 in + if nsize >= osize then begin (* no overflow *) + let h_buckets = C.makeSize nsize in + let ndata_tail = C.makeSize nsize in (* keep track of tail *) + C.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) + for i = 0 to osize - 1 do + insert_bucket ~hash ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i) + done; + for i = 0 to nsize - 1 do + match C.toOpt (Bs_Array.unsafe_get ndata_tail i) with + | None -> () + | Some tail -> N.nextSet tail C.emptyOpt + done + end + + + +let rec remove_bucket ~eq h h_buckets i key prec cell = + let cell_next = N.next cell in + if (Bs_Hash.getEq eq) (N.key cell) key [@bs] + then + begin + N.nextSet prec cell_next; + C.sizeSet h (C.size h - 1); + end + else + match C.toOpt cell_next with + | None -> + () + | Some cell_next -> + remove_bucket ~eq h h_buckets i key cell cell_next + +let remove0 ~hash ~eq h key = + let h_buckets = C.buckets h in + let i = (Bs_Hash.getHash hash) key [@bs] land (Array.length h_buckets - 1) in + let l = (Bs_Array.unsafe_get h_buckets i) in + match C.toOpt l with + | None -> () + | Some cell -> + let next_cell = (N.next cell) in + if (Bs_Hash.getEq eq) (N.key cell) key [@bs] then + begin + C.sizeSet h (C.size h - 1) ; + Bs_Array.unsafe_set h_buckets i next_cell + end + else + match C.toOpt next_cell with + | None -> () + | Some next_cell -> + remove_bucket ~eq h h_buckets i key cell next_cell + + + + +let rec addBucket ~eq h key cell = + if (Bs_Hash.getEq eq) (N.key cell) key [@bs] + then + N.keySet cell key + else + let n = N.next cell in + match C.toOpt n with + | None -> + C.sizeSet h (C.size h + 1); + N.nextSet cell (C.return @@ N.bucket ~key ~next:n) + | Some n -> addBucket ~eq h key n + +let add0 + ~hash:(hash:(_,'id)Bs_Hash.hash) + ~eq:(eq:(_,'id) Bs_Hash.eq) (h : (_,'id) t0) key = + let h_buckets = C.buckets h in + let i = (Bs_Hash.getHash hash) key [@bs] land (Array.length h_buckets - 1) in + let l = Array.unsafe_get h_buckets i in + (match C.toOpt l with + | None -> + C.sizeSet h (C.size h + 1); + Bs_Array.unsafe_set h_buckets i + (C.return @@ N.bucket ~key ~next:C.emptyOpt) + | Some cell -> + addBucket ~eq h key cell); + if C.size h > Array.length (C.buckets h) lsl 1 then resize ~hash h + + +let rec mem_in_bucket ~eq key cell = + (Bs_Hash.getEq eq) + (N.key cell) key [@bs] || + (match C.toOpt (N.next cell) with + | None -> false + | Some nextCell -> + mem_in_bucket ~eq key nextCell) + +let mem0 ~hash ~eq h key = + let h_buckets = C.buckets h in + let nid = (Bs_Hash.getHash hash) key [@bs] land (Array.length h_buckets - 1) in + let bucket = (Bs_Array.unsafe_get h_buckets nid) in + match C.toOpt bucket with + | None -> false + | Some bucket -> + mem_in_bucket ~eq key bucket + + +let create0 = C.create0 +let clear0 = C.clear0 +let reset0 = C.reset0 +let length0 = C.length0 +let iter0 = N.iter0 +let fold0 = N.fold0 +let logStats0 = N.logStats0 +let toArray0 = N.toArray0 +let toArray h = toArray0 (B.data h) +(* Wrapper *) +let create dict initialize_size = + B.bag ~data:(create0 initialize_size) + ~dict +let clear h = clear0 (B.data h) +let reset h = reset0 (B.data h) +let length h = length0 (B.data h) +let iter f h = iter0 f (B.data h) +let fold f h init = fold0 f (B.data h) init +let logStats h = logStats0 (B.data h) + +let add (type a) (type id) (h : (a,id) t) (key:a) = + let dict,data = B.(dict h, data h) in + let module M = (val dict) in + add0 ~hash:M.hash ~eq:M.eq data key + +let remove (type a) (type id) (h : (a,id) t) (key : a) = + let dict,data = B.(dict h, data h) in + let module M = (val dict) in + remove0 ~hash:M.hash ~eq:M.eq data key + + +let replace (type a)(type id) (h : (a,id) t) (key : a) = + let dict,data = B.(dict h, data h) in + let module M = (val dict) in + add0 ~hash:M.hash ~eq:M.eq data key + +let mem (type a) (type id) (h : (a,id) t) (key : a) = + let dict,data = B.(dict h, data h) in + let module M = (val dict) in + mem0 ~hash:M.hash ~eq:M.eq data key + diff --git a/jscomp/others/bs_HashSet.mli b/jscomp/others/bs_HashSet.mli new file mode 100644 index 00000000000..11b64aa088c --- /dev/null +++ b/jscomp/others/bs_HashSet.mli @@ -0,0 +1,182 @@ + + +type ('a, 'id) t0 + +type ('a, 'id) t = + (('a, 'id) Bs_Hash.t, + ('a, 'id) t0) Bs_Bag.bag + +(** The type of hash tables from type ['a] to type ['b]. *) + +val create0 : int -> ('a, 'id) t0 +val create : ('a,'id) Bs_Hash.t -> int -> ('a, 'id) t +(** [Hashtbl.create n] creates a new, empty hash table, with + initial size [n]. For best results, [n] should be on the + order of the expected number of elements that will be in + the table. The table grows as needed, so [n] is just an + initial guess. + + The optional [random] parameter (a boolean) controls whether + the internal organization of the hash table is randomized at each + execution of [Hashtbl.create] or deterministic over all executions. + + A hash table that is created with [~random:false] uses a + fixed hash function ({!Hashtbl.hash}) to distribute keys among + buckets. As a consequence, collisions between keys happen + deterministically. In Web-facing applications or other + security-sensitive applications, the deterministic collision + patterns can be exploited by a malicious user to create a + denial-of-service attack: the attacker sends input crafted to + create many collisions in the table, slowing the application down. + + A hash table that is created with [~random:true] uses the seeded + hash function {!Hashtbl.seeded_hash} with a seed that is randomly + chosen at hash table creation time. In effect, the hash function + used is randomly selected among [2^{30}] different hash functions. + All these hash functions have different collision patterns, + rendering ineffective the denial-of-service attack described above. + However, because of randomization, enumerating all elements of the + hash table using {!Hashtbl.fold} or {!Hashtbl.iter} is no longer + deterministic: elements are enumerated in different orders at + different runs of the program. + + If no [~random] parameter is given, hash tables are created + in non-random mode by default. This default can be changed + either programmatically by calling {!Hashtbl.randomize} or by + setting the [R] flag in the [OCAMLRUNPARAM] environment variable. + + @before 4.00.0 the [random] parameter was not present and all + hash tables were created in non-randomized mode. *) + +val clear0 : ('a, 'id) t0 -> unit +val clear : ('a, 'id) t -> unit +(** Empty a hash table. Use [reset] instead of [clear] to shrink the + size of the bucket table to its initial size. *) + +val reset0 : ('a, 'id) t0 -> unit +val reset : ('a, 'id) t -> unit +(** Empty a hash table and shrink the size of the bucket table + to its initial size. + @since 4.00.0 *) + + + +val add0 : + hash:('a,'id) Bs_Hash.hash -> + eq:('a,'id) Bs_Hash.eq -> + ('a,'id) t0 -> 'a -> unit +val add : ('a, 'id) t -> 'a -> unit +(** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl]. + Previous bindings for [x] are not removed, but simply + hidden. That is, after performing {!Hashtbl.remove}[ tbl x], + the previous binding for [x], if any, is restored. + (Same behavior as with association lists.) *) + +val mem0: + hash:('a,'id) Bs_Hash.hash -> + eq:('a,'id) Bs_Hash.eq -> + ('a, 'id) t0 -> 'a -> bool +val mem: + ('a, 'id) t -> 'a -> bool +(** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. *) + +val remove0: + hash:('a,'id) Bs_Hash.hash -> + eq:('a,'id) Bs_Hash.eq -> + ('a, 'id) t0 -> 'a -> unit +val remove: +('a, 'id) t -> 'a -> unit +(** [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl], + restoring the previous binding if it exists. + It does nothing if [x] is not bound in [tbl]. *) + + + + +val iter0 : ('a -> unit [@bs]) -> ('a, 'id) t0 -> unit +val iter : ('a -> unit [@bs]) -> ('a, 'id) t -> unit +(** [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl]. + [f] receives the key as first argument, and the associated value + as second argument. Each binding is presented exactly once to [f]. + + The order in which the bindings are passed to [f] is unspecified. + However, if the table contains several bindings for the same key, + they are passed to [f] in reverse order of introduction, that is, + the most recent binding is passed first. + + If the hash table was created in non-randomized mode, the order + in which the bindings are enumerated is reproducible between + successive runs of the program, and even between minor versions + of OCaml. For randomized hash tables, the order of enumeration + is entirely random. *) + +val fold0 : ('a -> 'c -> 'c [@bs]) -> ('a, 'id) t0 -> 'c -> 'c +val fold : ('a -> 'c -> 'c [@bs]) -> ('a, 'id) t -> 'c -> 'c +(** [Hashtbl.fold f tbl init] computes + [(f kN dN ... (f k1 d1 init)...)], + where [k1 ... kN] are the keys of all bindings in [tbl], + and [d1 ... dN] are the associated values. + Each binding is presented exactly once to [f]. + + The order in which the bindings are passed to [f] is unspecified. + However, if the table contains several bindings for the same key, + they are passed to [f] in reverse order of introduction, that is, + the most recent binding is passed first. + + If the hash table was created in non-randomized mode, the order + in which the bindings are enumerated is reproducible between + successive runs of the program, and even between minor versions + of OCaml. For randomized hash tables, the order of enumeration + is entirely random. *) + + +val length0 : ('a, 'id) t0 -> int +val length : ('a, 'id) t -> int +(** [Hashtbl.length tbl] returns the number of bindings in [tbl]. + It takes constant time. Multiple bindings are counted once each, so + [Hashtbl.length] gives the number of times [Hashtbl.iter] calls its + first argument. *) + + + + +val logStats0 : ('a, 'id) t0 -> unit +val logStats : _ t -> unit +(** [Hashtbl.stats tbl] returns statistics about the table [tbl]: + number of buckets, size of the biggest bucket, distribution of + buckets by size. + @since 4.00.0 *) + +(** {6 Functorial interface} *) + +(** The functorial interface allows the use of specific comparison + and hash functions, either for performance/security concerns, + or because keys are not hashable/comparable with the polymorphic builtins. + + For instance, one might want to specialize a table for integer keys: + {[ + module IntHash = + struct + type t = int + let equal i j = i=j + let hash i = i land max_int + end + + module IntHashtbl = Hashtbl.Make(IntHash) + + let h = IntHashtbl.create 17 in + IntHashtbl.add h 12 "hello";; + ]} + + This creates a new module [IntHashtbl], with a new type ['a + IntHashtbl.t] of tables from [int] to ['a]. In this example, [h] + contains [string] values so its type is [string IntHashtbl.t]. + + Note that the new type ['a IntHashtbl.t] is not compatible with + the type [('a,'b) Hashtbl.t] of the generic interface. For + example, [Hashtbl.length h] would not type-check, you must use + [IntHashtbl.length]. +*) + +val toArray0 : ('a,'id) t0 -> 'a array +val toArray : ('a,'id) t -> 'a array diff --git a/jscomp/others/bs_HashSetInt.ml b/jscomp/others/bs_HashSetInt.ml new file mode 100644 index 00000000000..3169f879329 --- /dev/null +++ b/jscomp/others/bs_HashSetInt.ml @@ -0,0 +1,146 @@ +# 9 "hashset.cppo.ml" +type key = int +type seed = int +external caml_hash_mix_int : seed -> int -> seed = "caml_hash_mix_int" +external final_mix : seed -> seed = "caml_hash_final_mix" +let hash (s : key) = + final_mix (caml_hash_mix_int 0 s) + +# 19 +module N = Bs_internalSetBuckets +module C = Bs_internalBucketsType +type t = key N.t0 + +let rec insert_bucket ~h_buckets ~ndata_tail h old_bucket = + match C.toOpt old_bucket with + | None -> () + | Some cell -> + let nidx = hash (N.key cell) land (Array.length h_buckets - 1) in + let v = C.return cell in + begin match C.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with + | None -> + Bs_Array.unsafe_set h_buckets nidx v + | Some tail -> + N.nextSet tail v (* cell put at the end *) + end; + Bs_Array.unsafe_set ndata_tail nidx v; + insert_bucket ~h_buckets ~ndata_tail h (N.next cell) + + +let resize h = + let odata = C.buckets h in + let osize = Array.length odata in + let nsize = osize * 2 in + if nsize >= osize then begin (* no overflow *) + let h_buckets = C.makeSize nsize in + let ndata_tail = C.makeSize nsize in (* keep track of tail *) + C.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) + for i = 0 to osize - 1 do + insert_bucket ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i) + done; + for i = 0 to nsize - 1 do + match C.toOpt (Bs_Array.unsafe_get ndata_tail i) with + | None -> () + | Some tail -> N.nextSet tail C.emptyOpt + done + end + + + +let rec remove_bucket h h_buckets i (key : key) prec cell = + let cell_next = N.next cell in + if (N.key cell) = key + then + begin + N.nextSet prec cell_next; + C.sizeSet h (C.size h - 1); + end + else + match C.toOpt cell_next with + | None -> + () + | Some cell_next -> + remove_bucket h h_buckets i key cell cell_next + +let remove h (key : key)= + let h_buckets = C.buckets h in + let i = hash key land (Array.length h_buckets - 1) in + let l = (Bs_Array.unsafe_get h_buckets i) in + match C.toOpt l with + | None -> () + | Some cell -> + let next_cell = (N.next cell) in + if (N.key cell) = key then + begin + C.sizeSet h (C.size h - 1) ; + Bs_Array.unsafe_set h_buckets i next_cell + end + else + match C.toOpt next_cell with + | None -> () + | Some next_cell -> + remove_bucket h h_buckets i key cell next_cell + + + + +let rec addBucket h buckets_len (key : key) cell = + if N.key cell <> key then + let n = N.next cell in + match C.toOpt n with + | None -> + C.sizeSet h (C.size h + 1); + N.nextSet cell (C.return @@ N.bucket ~key ~next:n); + if C.size h > buckets_len lsl 1 then resize h + | Some n -> addBucket h buckets_len key n + +let add h key = + let h_buckets = C.buckets h in + let buckets_len = Array.length h_buckets in + let i = hash key land (buckets_len - 1) in + let l = Array.unsafe_get h_buckets i in + match C.toOpt l with + | None -> + Bs_Array.unsafe_set h_buckets i + (C.return @@ N.bucket ~key ~next:C.emptyOpt); + C.sizeSet h (C.size h + 1); + if C.size h > buckets_len lsl 1 then resize h + | Some cell -> + addBucket h buckets_len key cell + + + +let rec mem_in_bucket (key : key) cell = + + (N.key cell) = key || + (match C.toOpt (N.next cell) with + | None -> false + | Some nextCell -> + mem_in_bucket key nextCell) + +let mem h key = + let h_buckets = C.buckets h in + let nid = hash key land (Array.length h_buckets - 1) in + let bucket = (Bs_Array.unsafe_get h_buckets nid) in + match C.toOpt bucket with + | None -> false + | Some bucket -> + mem_in_bucket key bucket + + +let create = C.create0 +let clear = C.clear0 +let reset = C.reset0 +let length = C.length0 +let iter = N.iter0 +let fold = N.fold0 +let logStats = N.logStats0 +let toArray = N.toArray0 + +let ofArray arr = + let len = Bs.Array.length arr in + let v = create len in + for i = 0 to len - 1 do + add v (Bs.Array.unsafe_get arr i) + done ; + v \ No newline at end of file diff --git a/jscomp/others/bs_HashSetInt.mli b/jscomp/others/bs_HashSetInt.mli new file mode 100644 index 00000000000..208433545cf --- /dev/null +++ b/jscomp/others/bs_HashSetInt.mli @@ -0,0 +1,173 @@ +# 4 "hashset.cppo.mli" +type key = int + + +# 10 +type t + + + + +val create : int -> t + +(** [Hashtbl.create n] creates a new, empty hash table, with + initial size [n]. For best results, [n] should be on the + order of the expected number of elements that will be in + the table. The table grows as needed, so [n] is just an + initial guess. + + The optional [random] parameter (a boolean) controls whether + the internal organization of the hash table is randomized at each + execution of [Hashtbl.create] or deterministic over all executions. + + A hash table that is created with [~random:false] uses a + fixed hash function ({!Hashtbl.hash}) to distribute keys among + buckets. As a consequence, collisions between keys happen + deterministically. In Web-facing applications or other + security-sensitive applications, the deterministic collision + patterns can be exploited by a malicious user to create a + denial-of-service attack: the attacker sends input crafted to + create many collisions in the table, slowing the application down. + + A hash table that is created with [~random:true] uses the seeded + hash function {!Hashtbl.seeded_hash} with a seed that is randomly + chosen at hash table creation time. In effect, the hash function + used is randomly selected among [2^{30}] different hash functions. + All these hash functions have different collision patterns, + rendering ineffective the denial-of-service attack described above. + However, because of randomization, enumerating all elements of the + hash table using {!Hashtbl.fold} or {!Hashtbl.iter} is no longer + deterministic: elements are enumerated in different orders at + different runs of the program. + + If no [~random] parameter is given, hash tables are created + in non-random mode by default. This default can be changed + either programmatically by calling {!Hashtbl.randomize} or by + setting the [R] flag in the [OCAMLRUNPARAM] environment variable. + + @before 4.00.0 the [random] parameter was not present and all + hash tables were created in non-randomized mode. *) + + +val clear : t -> unit +(** Empty a hash table. Use [reset] instead of [clear] to shrink the + size of the bucket table to its initial size. *) + + +val reset : t -> unit +(** Empty a hash table and shrink the size of the bucket table + to its initial size. + @since 4.00.0 *) + + + +val add : t -> key -> unit +(** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl]. + Previous bindings for [x] are not removed, but simply + hidden. That is, after performing {!Hashtbl.remove}[ tbl x], + the previous binding for [x], if any, is restored. + (Same behavior as with association lists.) *) + + +val mem: + t -> key -> bool +(** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. *) + +val remove: + t -> key -> unit +(** [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl], + restoring the previous binding if it exists. + It does nothing if [x] is not bound in [tbl]. *) + + + + + +val iter : (key -> unit [@bs]) -> t -> unit +(** [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl]. + [f] receives the key as first argument, and the associated value + as second argument. Each binding is presented exactly once to [f]. + + The order in which the bindings are passed to [f] is unspecified. + However, if the table contains several bindings for the same key, + they are passed to [f] in reverse order of introduction, that is, + the most recent binding is passed first. + + If the hash table was created in non-randomized mode, the order + in which the bindings are enumerated is reproducible between + successive runs of the program, and even between minor versions + of OCaml. For randomized hash tables, the order of enumeration + is entirely random. *) + + +val fold : (key -> 'c -> 'c [@bs]) -> t -> 'c -> 'c +(** [Hashtbl.fold f tbl init] computes + [(f kN dN ... (f k1 d1 init)...)], + where [k1 ... kN] are the keys of all bindings in [tbl], + and [d1 ... dN] are the associated values. + Each binding is presented exactly once to [f]. + + The order in which the bindings are passed to [f] is unspecified. + However, if the table contains several bindings for the same key, + they are passed to [f] in reverse order of introduction, that is, + the most recent binding is passed first. + + If the hash table was created in non-randomized mode, the order + in which the bindings are enumerated is reproducible between + successive runs of the program, and even between minor versions + of OCaml. For randomized hash tables, the order of enumeration + is entirely random. *) + + +val length : t -> int +(** [Hashtbl.length tbl] returns the number of bindings in [tbl]. + It takes constant time. Multiple bindings are counted once each, so + [Hashtbl.length] gives the number of times [Hashtbl.iter] calls its + first argument. *) + + + + + +val logStats : t -> unit +(** [Hashtbl.stats tbl] returns statistics about the table [tbl]: + number of buckets, size of the biggest bucket, distribution of + buckets by size. + @since 4.00.0 *) + +(** {6 Functorial interface} *) + +(** The functorial interface allows the use of specific comparison + and hash functions, either for performance/security concerns, + or because keys are not hashable/comparable with the polymorphic builtins. + + For instance, one might want to specialize a table for integer keys: + {[ + module IntHash = + struct + type t = int + let equal i j = i=j + let hash i = i land max_int + end + + module IntHashtbl = Hashtbl.Make(IntHash) + + let h = IntHashtbl.create 17 in + IntHashtbl.add h 12 "hello";; + ]} + + This creates a new module [IntHashtbl], with a new type ['a + IntHashtbl.t] of tables from [int] to ['a]. In this example, [h] + contains [string] values so its type is [string IntHashtbl.t]. + + Note that the new type ['a IntHashtbl.t] is not compatible with + the type [('a,'b) Hashtbl.t] of the generic interface. For + example, [Hashtbl.length h] would not type-check, you must use + [IntHashtbl.length]. +*) + + + +val toArray : t -> key array + +val ofArray : key array -> t \ No newline at end of file diff --git a/jscomp/others/bs_HashSetString.ml b/jscomp/others/bs_HashSetString.ml new file mode 100644 index 00000000000..5ae5dfa9ca9 --- /dev/null +++ b/jscomp/others/bs_HashSetString.ml @@ -0,0 +1,146 @@ +# 2 "hashset.cppo.ml" +type key = string +type seed = int +external caml_hash_mix_string : seed -> string -> seed = "caml_hash_mix_string" +external final_mix : seed -> seed = "caml_hash_final_mix" +let hash (s : key) = + final_mix (caml_hash_mix_string 0 s ) + +# 19 +module N = Bs_internalSetBuckets +module C = Bs_internalBucketsType +type t = key N.t0 + +let rec insert_bucket ~h_buckets ~ndata_tail h old_bucket = + match C.toOpt old_bucket with + | None -> () + | Some cell -> + let nidx = hash (N.key cell) land (Array.length h_buckets - 1) in + let v = C.return cell in + begin match C.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with + | None -> + Bs_Array.unsafe_set h_buckets nidx v + | Some tail -> + N.nextSet tail v (* cell put at the end *) + end; + Bs_Array.unsafe_set ndata_tail nidx v; + insert_bucket ~h_buckets ~ndata_tail h (N.next cell) + + +let resize h = + let odata = C.buckets h in + let osize = Array.length odata in + let nsize = osize * 2 in + if nsize >= osize then begin (* no overflow *) + let h_buckets = C.makeSize nsize in + let ndata_tail = C.makeSize nsize in (* keep track of tail *) + C.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) + for i = 0 to osize - 1 do + insert_bucket ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i) + done; + for i = 0 to nsize - 1 do + match C.toOpt (Bs_Array.unsafe_get ndata_tail i) with + | None -> () + | Some tail -> N.nextSet tail C.emptyOpt + done + end + + + +let rec remove_bucket h h_buckets i (key : key) prec cell = + let cell_next = N.next cell in + if (N.key cell) = key + then + begin + N.nextSet prec cell_next; + C.sizeSet h (C.size h - 1); + end + else + match C.toOpt cell_next with + | None -> + () + | Some cell_next -> + remove_bucket h h_buckets i key cell cell_next + +let remove h (key : key)= + let h_buckets = C.buckets h in + let i = hash key land (Array.length h_buckets - 1) in + let l = (Bs_Array.unsafe_get h_buckets i) in + match C.toOpt l with + | None -> () + | Some cell -> + let next_cell = (N.next cell) in + if (N.key cell) = key then + begin + C.sizeSet h (C.size h - 1) ; + Bs_Array.unsafe_set h_buckets i next_cell + end + else + match C.toOpt next_cell with + | None -> () + | Some next_cell -> + remove_bucket h h_buckets i key cell next_cell + + + + +let rec addBucket h buckets_len (key : key) cell = + if N.key cell <> key then + let n = N.next cell in + match C.toOpt n with + | None -> + C.sizeSet h (C.size h + 1); + N.nextSet cell (C.return @@ N.bucket ~key ~next:n); + if C.size h > buckets_len lsl 1 then resize h + | Some n -> addBucket h buckets_len key n + +let add h key = + let h_buckets = C.buckets h in + let buckets_len = Array.length h_buckets in + let i = hash key land (buckets_len - 1) in + let l = Array.unsafe_get h_buckets i in + match C.toOpt l with + | None -> + Bs_Array.unsafe_set h_buckets i + (C.return @@ N.bucket ~key ~next:C.emptyOpt); + C.sizeSet h (C.size h + 1); + if C.size h > buckets_len lsl 1 then resize h + | Some cell -> + addBucket h buckets_len key cell + + + +let rec mem_in_bucket (key : key) cell = + + (N.key cell) = key || + (match C.toOpt (N.next cell) with + | None -> false + | Some nextCell -> + mem_in_bucket key nextCell) + +let mem h key = + let h_buckets = C.buckets h in + let nid = hash key land (Array.length h_buckets - 1) in + let bucket = (Bs_Array.unsafe_get h_buckets nid) in + match C.toOpt bucket with + | None -> false + | Some bucket -> + mem_in_bucket key bucket + + +let create = C.create0 +let clear = C.clear0 +let reset = C.reset0 +let length = C.length0 +let iter = N.iter0 +let fold = N.fold0 +let logStats = N.logStats0 +let toArray = N.toArray0 + +let ofArray arr = + let len = Bs.Array.length arr in + let v = create len in + for i = 0 to len - 1 do + add v (Bs.Array.unsafe_get arr i) + done ; + v \ No newline at end of file diff --git a/jscomp/others/bs_HashSetString.mli b/jscomp/others/bs_HashSetString.mli new file mode 100644 index 00000000000..b66051f161d --- /dev/null +++ b/jscomp/others/bs_HashSetString.mli @@ -0,0 +1,173 @@ +# 2 "hashset.cppo.mli" +type key = string + + +# 10 +type t + + + + +val create : int -> t + +(** [Hashtbl.create n] creates a new, empty hash table, with + initial size [n]. For best results, [n] should be on the + order of the expected number of elements that will be in + the table. The table grows as needed, so [n] is just an + initial guess. + + The optional [random] parameter (a boolean) controls whether + the internal organization of the hash table is randomized at each + execution of [Hashtbl.create] or deterministic over all executions. + + A hash table that is created with [~random:false] uses a + fixed hash function ({!Hashtbl.hash}) to distribute keys among + buckets. As a consequence, collisions between keys happen + deterministically. In Web-facing applications or other + security-sensitive applications, the deterministic collision + patterns can be exploited by a malicious user to create a + denial-of-service attack: the attacker sends input crafted to + create many collisions in the table, slowing the application down. + + A hash table that is created with [~random:true] uses the seeded + hash function {!Hashtbl.seeded_hash} with a seed that is randomly + chosen at hash table creation time. In effect, the hash function + used is randomly selected among [2^{30}] different hash functions. + All these hash functions have different collision patterns, + rendering ineffective the denial-of-service attack described above. + However, because of randomization, enumerating all elements of the + hash table using {!Hashtbl.fold} or {!Hashtbl.iter} is no longer + deterministic: elements are enumerated in different orders at + different runs of the program. + + If no [~random] parameter is given, hash tables are created + in non-random mode by default. This default can be changed + either programmatically by calling {!Hashtbl.randomize} or by + setting the [R] flag in the [OCAMLRUNPARAM] environment variable. + + @before 4.00.0 the [random] parameter was not present and all + hash tables were created in non-randomized mode. *) + + +val clear : t -> unit +(** Empty a hash table. Use [reset] instead of [clear] to shrink the + size of the bucket table to its initial size. *) + + +val reset : t -> unit +(** Empty a hash table and shrink the size of the bucket table + to its initial size. + @since 4.00.0 *) + + + +val add : t -> key -> unit +(** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl]. + Previous bindings for [x] are not removed, but simply + hidden. That is, after performing {!Hashtbl.remove}[ tbl x], + the previous binding for [x], if any, is restored. + (Same behavior as with association lists.) *) + + +val mem: + t -> key -> bool +(** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. *) + +val remove: + t -> key -> unit +(** [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl], + restoring the previous binding if it exists. + It does nothing if [x] is not bound in [tbl]. *) + + + + + +val iter : (key -> unit [@bs]) -> t -> unit +(** [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl]. + [f] receives the key as first argument, and the associated value + as second argument. Each binding is presented exactly once to [f]. + + The order in which the bindings are passed to [f] is unspecified. + However, if the table contains several bindings for the same key, + they are passed to [f] in reverse order of introduction, that is, + the most recent binding is passed first. + + If the hash table was created in non-randomized mode, the order + in which the bindings are enumerated is reproducible between + successive runs of the program, and even between minor versions + of OCaml. For randomized hash tables, the order of enumeration + is entirely random. *) + + +val fold : (key -> 'c -> 'c [@bs]) -> t -> 'c -> 'c +(** [Hashtbl.fold f tbl init] computes + [(f kN dN ... (f k1 d1 init)...)], + where [k1 ... kN] are the keys of all bindings in [tbl], + and [d1 ... dN] are the associated values. + Each binding is presented exactly once to [f]. + + The order in which the bindings are passed to [f] is unspecified. + However, if the table contains several bindings for the same key, + they are passed to [f] in reverse order of introduction, that is, + the most recent binding is passed first. + + If the hash table was created in non-randomized mode, the order + in which the bindings are enumerated is reproducible between + successive runs of the program, and even between minor versions + of OCaml. For randomized hash tables, the order of enumeration + is entirely random. *) + + +val length : t -> int +(** [Hashtbl.length tbl] returns the number of bindings in [tbl]. + It takes constant time. Multiple bindings are counted once each, so + [Hashtbl.length] gives the number of times [Hashtbl.iter] calls its + first argument. *) + + + + + +val logStats : t -> unit +(** [Hashtbl.stats tbl] returns statistics about the table [tbl]: + number of buckets, size of the biggest bucket, distribution of + buckets by size. + @since 4.00.0 *) + +(** {6 Functorial interface} *) + +(** The functorial interface allows the use of specific comparison + and hash functions, either for performance/security concerns, + or because keys are not hashable/comparable with the polymorphic builtins. + + For instance, one might want to specialize a table for integer keys: + {[ + module IntHash = + struct + type t = int + let equal i j = i=j + let hash i = i land max_int + end + + module IntHashtbl = Hashtbl.Make(IntHash) + + let h = IntHashtbl.create 17 in + IntHashtbl.add h 12 "hello";; + ]} + + This creates a new module [IntHashtbl], with a new type ['a + IntHashtbl.t] of tables from [int] to ['a]. In this example, [h] + contains [string] values so its type is [string IntHashtbl.t]. + + Note that the new type ['a IntHashtbl.t] is not compatible with + the type [('a,'b) Hashtbl.t] of the generic interface. For + example, [Hashtbl.length h] would not type-check, you must use + [IntHashtbl.length]. +*) + + + +val toArray : t -> key array + +val ofArray : key array -> t \ No newline at end of file diff --git a/jscomp/others/bs_Queue.ml b/jscomp/others/bs_Queue.ml index 8b8e4ca1899..61edaaf7997 100644 --- a/jscomp/others/bs_Queue.ml +++ b/jscomp/others/bs_Queue.ml @@ -13,7 +13,7 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) - +(* Adapted siginifcantly by BuckleScript Authors *) type 'a node = { content: 'a; mutable next: 'a cell @@ -187,4 +187,4 @@ let rec fillAux i arr cell = let toArray x = let v = Bs_Array.makeUninitializedUnsafe (length x) in fillAux 0 v (first x); - v \ No newline at end of file + v diff --git a/jscomp/others/bs_Set.ml b/jscomp/others/bs_Set.ml index 70c988ddaad..1435fc4deb8 100644 --- a/jscomp/others/bs_Set.ml +++ b/jscomp/others/bs_Set.ml @@ -24,7 +24,7 @@ let filter0 = N.filter0 let partition0 = N.partition0 let cardinal0 = N.cardinal0 let elements0 = N.elements0 - +let toArray0 = N.toArray0 (* Insertion of one element *) let rec add0 ~cmp x (t : _ t0) : _ t0 = @@ -278,7 +278,7 @@ let partition f m = let cardinal m = cardinal0 (B.data m) let elements m = elements0 (B.data m) - +let toArray m = toArray0 (B.data m) let min m = min0 (B.data m) let max m = max0 (B.data m) diff --git a/jscomp/others/bs_Set.mli b/jscomp/others/bs_Set.mli index b38076b694b..0f9b531da5c 100644 --- a/jscomp/others/bs_Set.mli +++ b/jscomp/others/bs_Set.mli @@ -140,6 +140,8 @@ val elements: ('elt, 'id) t -> 'elt list The returned list is sorted in increasing order with respect to the ordering [Ord.compare], where [Ord] is the argument given to {!Set.Make}. *) +val toArray0: ('elt, 'id) t0 -> 'elt array +val toArray: ('elt, 'id) t -> 'elt array val min0: ('elt, 'id) t0 -> 'elt option val min: ('elt, 'id) t -> 'elt option diff --git a/jscomp/others/bs_SetInt.ml b/jscomp/others/bs_SetInt.ml index 8c5269da9fa..61dd220cf34 100644 --- a/jscomp/others/bs_SetInt.ml +++ b/jscomp/others/bs_SetInt.ml @@ -29,6 +29,7 @@ let filter = N.filter0 let partition = N.partition0 let cardinal = N.cardinal0 let elements = N.elements0 +let toArray = N.toArray0 let checkInvariant = N.checkInvariant (* Insertion of one element *) diff --git a/jscomp/others/bs_SetInt.mli b/jscomp/others/bs_SetInt.mli index 375543dfd08..b2066064bb5 100644 --- a/jscomp/others/bs_SetInt.mli +++ b/jscomp/others/bs_SetInt.mli @@ -84,6 +84,8 @@ val elements: t -> elt list to the ordering [Ord.compare], where [Ord] is the argument given to {!Set.Make}. *) +val toArray: t -> elt array + val min: t -> elt option (** Return the smallest element of the given set (with respect to the [Ord.compare] ordering), or raise diff --git a/jscomp/others/bs_SetString.ml b/jscomp/others/bs_SetString.ml index a2424d96f7c..d9d2894c55e 100644 --- a/jscomp/others/bs_SetString.ml +++ b/jscomp/others/bs_SetString.ml @@ -29,6 +29,7 @@ let filter = N.filter0 let partition = N.partition0 let cardinal = N.cardinal0 let elements = N.elements0 +let toArray = N.toArray0 let checkInvariant = N.checkInvariant (* Insertion of one element *) diff --git a/jscomp/others/bs_SetString.mli b/jscomp/others/bs_SetString.mli index 99ab193b440..eeaf7b010ae 100644 --- a/jscomp/others/bs_SetString.mli +++ b/jscomp/others/bs_SetString.mli @@ -84,6 +84,8 @@ val elements: t -> elt list to the ordering [Ord.compare], where [Ord] is the argument given to {!Set.Make}. *) +val toArray: t -> elt array + val min: t -> elt option (** Return the smallest element of the given set (with respect to the [Ord.compare] ordering), or raise diff --git a/jscomp/others/bs_internalAVLset.ml b/jscomp/others/bs_internalAVLset.ml index 25fb163f138..7191924ac0c 100644 --- a/jscomp/others/bs_internalAVLset.ml +++ b/jscomp/others/bs_internalAVLset.ml @@ -252,12 +252,28 @@ let rec checkInvariant (v : _ t0) = diff <=2 && diff >= -2 && checkInvariant l && checkInvariant r +let rec fillArray n i arr = + let l,v,r = left n, key n, right n in + let next = + match toOpt l with + | None -> i + | Some l -> + fillArray l i arr in + Bs_Array.unsafe_set arr next v ; + let rnext = next + 1 in + match toOpt r with + | None -> rnext + | Some r -> + fillArray r rnext arr + (* TODO: binary search tree to array efficiency -let toArray n = +*) +let toArray0 n = match toOpt n with | None -> [||] | Some n -> let size = cardinalAux n in - let v = Bs.Array.makeUninitialized size in - let l,v,r = left n, value n, right n in -*) \ No newline at end of file + let v = Bs.Array.makeUninitializedUnsafe size in + ignore (fillArray n 0 v : int); (* may add assertion *) + v + diff --git a/jscomp/others/bs_internalBuckets.ml b/jscomp/others/bs_internalBuckets.ml index 7b4df55cac8..9b80f9f04f5 100644 --- a/jscomp/others/bs_internalBuckets.ml +++ b/jscomp/others/bs_internalBuckets.ml @@ -18,51 +18,21 @@ (* We do dynamic hashing, and resize the table and rehash the elements when buckets become too long. *) -(* and ('a,'b) buckets -= - < key : 'a [@bs.set]; - value : 'b [@bs.set]; - next : ('a,'b) buckets opt [@bs.set] - > Js.t *) - (* { - mutable key : 'a ; - mutable value : 'b ; - mutable next : ('a, 'b) buckets opt - } *) - -#if BS then -type 'a opt = 'a Js.undefined -#else -type 'a opt = 'a option -#end +module C = Bs_internalBucketsType +(* TODO: + the current implementation relies on the fact that bucket + empty value is [undefined] in both places, + in theory, it can be different +*) type ('a,'b) bucket = { mutable key : 'a; mutable value : 'b; - mutable next : ('a,'b) bucket opt + mutable next : ('a,'b) bucket C.opt } - -and ('a,'b) bucket_opt = ('a, 'b) bucket opt - - -and ('a, 'b,'id) t0 = - { mutable size: int; (* number of entries *) - mutable buckets: ('a, 'b) bucket_opt array; (* the buckets *) - initial_size: int; (* initial array size *) - } +and ('a, 'b) t0 = ('a,'b) bucket C.container [@@bs.deriving abstract] -#if BS then -external toOpt : 'a opt -> 'a option = "#undefined_to_opt" -external return : 'a -> 'a opt = "%identity" -let emptyOpt = Js.undefined -external makeSize : int -> 'a Js.undefined array = "Array" [@@bs.new] -#else -external toOpt : 'a -> 'a = "%identity" -let return x = Some x -let emptyOpt = None -let makeSize s = Bs_Array.make s emptyOpt -#end type statistics = { num_bindings: int; @@ -71,61 +41,37 @@ type statistics = { bucket_histogram: int array } +let rec bucket_length accu buckets = + match C.toOpt buckets with + | None -> accu + | Some cell -> bucket_length (accu + 1) (next cell) -let rec power_2_above x n = - if x >= n then x - else if x * 2 < x then x (* overflow *) - else power_2_above (x * 2) n - -let create0 initial_size = - let s = power_2_above 16 initial_size in - t0 ~initial_size:s ~size:0 - ~buckets:(makeSize s) - -let clear0 h = - sizeSet h 0; - let h_buckets = buckets h in - let len = Bs_Array.length h_buckets in - for i = 0 to len - 1 do - Bs_Array.unsafe_set h_buckets i emptyOpt - done - -let reset0 h = - let len = Bs_Array.length (buckets h) in - let h_initial_size = initial_size h in - if len = h_initial_size then - clear0 h - else begin - sizeSet h 0; - bucketsSet h (makeSize h_initial_size) - end - -let length0 h = size h +let max (m : int) n = if m > n then m else n let rec do_bucket_iter ~f buckets = - match toOpt buckets with + match C.toOpt buckets with | None -> () | Some cell -> f (key cell) (value cell) [@bs]; do_bucket_iter ~f (next cell) let iter0 f h = - let d = buckets h in + let d = C.buckets h in for i = 0 to Bs_Array.length d - 1 do do_bucket_iter f (Bs_Array.unsafe_get d i) done let rec do_bucket_fold ~f b accu = - match toOpt b with + match C.toOpt b with | None -> accu | Some cell -> do_bucket_fold ~f (next cell) (f (key cell) (value cell) accu [@bs]) let fold0 f h init = - let d = buckets h in + let d = C.buckets h in let accu = ref init in for i = 0 to Bs_Array.length d - 1 do accu := do_bucket_fold ~f (Bs_Array.unsafe_get d i) !accu @@ -134,52 +80,54 @@ let fold0 f h init = -let rec bucket_length accu buckets = - match toOpt buckets with - | None -> accu - | Some cell -> bucket_length (accu + 1) (next cell) - -let max (m : int) n = if m > n then m else n let logStats0 h = let mbl = - Bs_Array.foldLeft (fun[@bs] m b -> max m (bucket_length 0 b)) 0 (buckets h) in + Bs_Array.foldLeft (fun[@bs] m b -> max m (bucket_length 0 b)) 0 (C.buckets h) in let histo = Bs_Array.make (mbl + 1) 0 in Bs_Array.iter (fun[@bs] b -> let l = bucket_length 0 b in Bs_Array.unsafe_set histo l (Bs_Array.unsafe_get histo l + 1) ) - (buckets h); - Js.log [%obj{ num_bindings = (size h); - num_buckets = Bs_Array.length (buckets h); + (C.buckets h); + Js.log [%obj{ num_bindings = (C.size h); + num_buckets = Bs_Array.length (C.buckets h); max_bucket_length = mbl; bucket_histogram = histo }] -let rec filterMapInplaceBucket f h i prec bucket = - match toOpt bucket with - | None -> - begin match toOpt prec with - | None -> Bs_Array.unsafe_set (buckets h ) i emptyOpt - | Some cell -> nextSet cell emptyOpt - end - | (Some cell) -> - begin match f (key cell) (value cell) [@bs] with - | None -> - sizeSet h (size h - 1); (* delete *) - filterMapInplaceBucket f h i prec (next cell) - | Some data -> (* replace *) - begin match toOpt prec with - | None -> Bs_Array.unsafe_set (buckets h) i bucket - | Some c -> nextSet cell bucket - end; - valueSet cell data; - filterMapInplaceBucket f h i bucket (next cell) - end +let rec filterMapInplaceBucket f h i prec cell = + let n = next cell in + begin match f (key cell) (value cell) [@bs] with + | None -> + C.sizeSet h (C.size h - 1); (* delete *) + (match C.toOpt n with + | Some nextCell -> + filterMapInplaceBucket f h i prec nextCell + | None -> + match C.toOpt prec with + | None -> Bs_Array.unsafe_set (C.buckets h) i prec + | Some cell -> nextSet cell n + ) + | Some data -> (* replace *) + let bucket = C.return cell in + begin match C.toOpt prec with + | None -> Bs_Array.unsafe_set (C.buckets h) i bucket + | Some c -> nextSet cell bucket + end; + valueSet cell data; + match C.toOpt n with + | None -> nextSet cell n + | Some nextCell -> + filterMapInplaceBucket f h i bucket nextCell + end let filterMapInplace0 f h = - let h_buckets = buckets h in + let h_buckets = C.buckets h in for i = 0 to Bs_Array.length h_buckets - 1 do - filterMapInplaceBucket f h i emptyOpt (Bs_Array.unsafe_get h_buckets i) + let v = Bs_Array.unsafe_get h_buckets i in + match C.toOpt v with + | None -> () + | Some v -> filterMapInplaceBucket f h i C.emptyOpt v done diff --git a/jscomp/others/bs_internalBucketsType.ml b/jscomp/others/bs_internalBucketsType.ml new file mode 100644 index 00000000000..83350700b53 --- /dev/null +++ b/jscomp/others/bs_internalBucketsType.ml @@ -0,0 +1,87 @@ +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) +type 'a opt = 'a Js.undefined + +type 'c container = + { mutable size: int; (* number of entries *) + mutable buckets: 'c opt array; (* the buckets *) + initialSize: int; (* initial array size *) + } [@@bs.deriving abstract] + +external makeSize : int -> 'a opt array = "Array" [@@bs.new] +external toOpt : 'a opt -> 'a option = "#undefined_to_opt" +external return : 'a -> 'a opt = "%identity" +let emptyOpt = Js.undefined +let rec power_2_above x n = + if x >= n then x + else if x * 2 < x then x (* overflow *) + else power_2_above (x * 2) n + +let create0 initialSize = + let s = power_2_above 16 initialSize in + container ~initialSize:s ~size:0 + ~buckets:(makeSize s) + +let clear0 h = + sizeSet h 0; + let h_buckets = buckets h in + let len = Bs_Array.length h_buckets in + for i = 0 to len - 1 do + Bs_Array.unsafe_set h_buckets i emptyOpt + done + +let reset0 h = + let len = Bs_Array.length (buckets h) in + let h_initialSize = initialSize h in + if len = h_initialSize then + clear0 h + else begin + sizeSet h 0; + bucketsSet h (makeSize h_initialSize) + end + +let length0 h = size h + + +type statistics = { + num_bindings: int; + num_buckets: int; + max_bucket_length: int; + bucket_histogram: int array +} + +(* +type statistics = { + num_bindings: int; + (** Number of bindings present in the table. + Same value as returned by {!Hashtbl.length}. *) + num_buckets: int; + (** Number of buckets in the table. *) + max_bucket_length: int; + (** Maximal number of bindings per bucket. *) + bucket_histogram: int array + (** Histogram of bucket sizes. This array [histo] has + length [max_bucket_length + 1]. The value of + [histo.(i)] is the number of buckets whose size is [i]. *) +} *) \ No newline at end of file diff --git a/jscomp/others/bs_internalSetBuckets.ml b/jscomp/others/bs_internalSetBuckets.ml new file mode 100644 index 00000000000..5c908e784be --- /dev/null +++ b/jscomp/others/bs_internalSetBuckets.ml @@ -0,0 +1,116 @@ +(* Copyright (C) 2017 Authors of BuckleScript + * + * 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. *) + +(* We do dynamic hashing, and resize the table and rehash the elements + when buckets become too long. *) +module C = Bs_internalBucketsType +(* TODO: + the current implementation relies on the fact that bucket + empty value is [undefined] in both places, + in theory, it can be different + +*) +type 'a bucket = { + mutable key : 'a; + mutable next : 'a bucket C.opt +} +and 'a t0 = 'a bucket C.container +[@@bs.deriving abstract] + +let rec bucket_length accu buckets = + match C.toOpt buckets with + | None -> accu + | Some cell -> bucket_length (accu + 1) (next cell) + +let max (m : int) n = if m > n then m else n + + +let rec do_bucket_iter ~f buckets = + match C.toOpt buckets with + | None -> + () + | Some cell -> + f (key cell) [@bs]; do_bucket_iter ~f (next cell) + +let iter0 f h = + let d = C.buckets h in + for i = 0 to Bs_Array.length d - 1 do + do_bucket_iter f (Bs_Array.unsafe_get d i) + done + +let rec fillArray i arr cell = + Bs_Array.unsafe_set arr i (key cell); + match C.toOpt (next cell) with + | None -> i + 1 + | Some v -> fillArray (i + 1) arr v + +let toArray0 h = + let d = C.buckets h in + let current = ref 0 in + let arr = Bs.Array.makeUninitializedUnsafe (C.size h) in + for i = 0 to Bs_Array.length d - 1 do + let cell = Bs_Array.unsafe_get d i in + match C.toOpt cell with + | None -> () + | Some cell -> + current := fillArray !current arr cell + done; + arr + + + +let rec do_bucket_fold ~f b accu = + match C.toOpt b with + | None -> + accu + | Some cell -> + do_bucket_fold ~f (next cell) (f (key cell) accu [@bs]) + +let fold0 f h init = + let d = C.buckets h in + let accu = ref init in + for i = 0 to Bs_Array.length d - 1 do + accu := do_bucket_fold ~f (Bs_Array.unsafe_get d i) !accu + done; + !accu + + + + +let logStats0 h = + let mbl = + Bs_Array.foldLeft (fun[@bs] m b -> max m (bucket_length 0 b)) 0 (C.buckets h) in + let histo = Bs_Array.make (mbl + 1) 0 in + Bs_Array.iter + (fun[@bs] b -> + let l = bucket_length 0 b in + Bs_Array.unsafe_set histo l (Bs_Array.unsafe_get histo l + 1) + ) + (C.buckets h); + Js.log [%obj{ num_bindings = (C.size h); + num_buckets = Bs_Array.length (C.buckets h); + max_bucket_length = mbl; + bucket_histogram = histo }] + + diff --git a/jscomp/others/hashmap.cppo.ml b/jscomp/others/hashmap.cppo.ml index 76f880d80f9..dd98ef2f316 100644 --- a/jscomp/others/hashmap.cppo.ml +++ b/jscomp/others/hashmap.cppo.ml @@ -14,7 +14,7 @@ let hash (s : key) = final_mix (caml_hash_mix_int 0 s) #else [%error "unknown type"] - #endif +#endif (***********************************************************************) (* *) @@ -30,19 +30,19 @@ let hash (s : key) = (***********************************************************************) (** Adapted by Authors of BuckleScript 2017 *) module N = Bs_internalBuckets - -type ('a, 'b,'id) t0 = ('a,'b,'id) N.t0 +module C = Bs_internalBucketsType +type ('a, 'b,'id) t0 = ('a,'b) N.t0 type 'b t = (key,'b,unit) t0 let rec insert_bucket ~h_buckets ~ndata_tail h old_bucket = - match N.toOpt old_bucket with + match C.toOpt old_bucket with | None -> () | Some cell -> let nidx = hash (N.key cell) land (Array.length h_buckets - 1) in - let v = N.return cell in - begin match N.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with + let v = C.return cell in + begin match C.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with | None -> Bs_Array.unsafe_set h_buckets nidx v | Some tail -> @@ -53,82 +53,82 @@ let rec insert_bucket ~h_buckets ~ndata_tail h old_bucket = let resize h = - let odata = N.buckets h in + let odata = C.buckets h in let osize = Array.length odata in let nsize = osize * 2 in if nsize >= osize then begin (* no overflow *) - let h_buckets = N.makeSize nsize in - let ndata_tail = N.makeSize nsize in (* keep track of tail *) - N.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) + let h_buckets = C.makeSize nsize in + let ndata_tail = C.makeSize nsize in (* keep track of tail *) + C.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) for i = 0 to osize - 1 do insert_bucket ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i) done; for i = 0 to nsize - 1 do - match N.toOpt (Bs_Array.unsafe_get ndata_tail i) with + match C.toOpt (Bs_Array.unsafe_get ndata_tail i) with | None -> () - | Some tail -> N.nextSet tail N.emptyOpt + | Some tail -> N.nextSet tail C.emptyOpt done end let add h key value = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let h_buckets_lenth = Array.length h_buckets in let i = hash key land (h_buckets_lenth - 1) in let bucket = N.bucket ~key ~value ~next:(Bs_Array.unsafe_get h_buckets i) in - Bs_Array.unsafe_set h_buckets i (N.return bucket); - let h_new_size = N.size h + 1 in - N.sizeSet h h_new_size; + Bs_Array.unsafe_set h_buckets i (C.return bucket); + let h_new_size = C.size h + 1 in + C.sizeSet h h_new_size; if h_new_size > h_buckets_lenth lsl 1 then resize h let rec remove_bucket h h_buckets i (key : key) prec buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> () | Some cell -> let cell_next = N.next cell in if N.key cell = key then begin - (match N.toOpt prec with + (match C.toOpt prec with | None -> Bs_Array.unsafe_set h_buckets i cell_next | Some c -> N.nextSet c cell_next); - N.sizeSet h (N.size h - 1); + C.sizeSet h (C.size h - 1); end else remove_bucket h h_buckets i key buckets cell_next let remove h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = hash key land (Array.length h_buckets - 1) in - remove_bucket h h_buckets i key N.emptyOpt (Bs_Array.unsafe_get h_buckets i) + remove_bucket h h_buckets i key C.emptyOpt (Bs_Array.unsafe_get h_buckets i) let rec removeAllBuckets h h_buckets i (key : key) prec buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> () | Some cell -> let cell_next = N.next cell in if N.key cell = key then begin - (match N.toOpt prec with + (match C.toOpt prec with | None -> Bs_Array.unsafe_set h_buckets i cell_next | Some c -> N.nextSet c cell_next); - N.sizeSet h (N.size h - 1); + C.sizeSet h (C.size h - 1); end; removeAllBuckets h h_buckets i key buckets cell_next let removeAll h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = hash key land (Array.length h_buckets - 1) in - removeAllBuckets h h_buckets i key N.emptyOpt (Bs_Array.unsafe_get h_buckets i) + removeAllBuckets h h_buckets i key C.emptyOpt (Bs_Array.unsafe_get h_buckets i) (* TODO: add [removeAll] *) let rec find_rec (key : key) buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> None | Some cell -> @@ -136,17 +136,17 @@ let rec find_rec (key : key) buckets = else find_rec key (N.next cell) let findOpt h (key : key) = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = hash key land (Array.length h_buckets - 1) in - match N.toOpt @@ Bs_Array.unsafe_get h_buckets nid with + match C.toOpt @@ Bs_Array.unsafe_get h_buckets nid with | None -> None | Some cell1 -> if key = (N.key cell1) then Some (N.value cell1) else - match N.toOpt (N.next cell1) with + match C.toOpt (N.next cell1) with | None -> None | Some cell2 -> if key = (N.key cell2) then Some (N.value cell2) else - match N.toOpt (N.next cell2) with + match C.toOpt (N.next cell2) with | None -> None | Some cell3 -> if key = (N.key cell3) then Some (N.value cell3) @@ -155,19 +155,19 @@ let findOpt h (key : key) = let findAll h (key : key) = let rec find_in_bucket buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> [] | Some cell -> if (N.key cell) = key then (N.value cell) :: find_in_bucket (N.next cell) else find_in_bucket (N.next cell) in - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = hash key land (Array.length h_buckets - 1) in find_in_bucket (Bs_Array.unsafe_get h_buckets nid) let rec replace_bucket (key : key) info buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> true | Some cell -> @@ -182,32 +182,32 @@ let rec replace_bucket (key : key) info buckets = replace_bucket key info (N.next cell) let replace h (key : key) info = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let i = hash key land (Array.length h_buckets - 1) in let l = Array.unsafe_get h_buckets i in if replace_bucket key info l then begin - Bs_Array.unsafe_set h_buckets i (N.return + Bs_Array.unsafe_set h_buckets i (C.return (N.bucket ~key ~value:info ~next:l)); - N.sizeSet h (N.size h + 1); - if N.size h > Array.length (N.buckets h) lsl 1 then resize h + C.sizeSet h (C.size h + 1); + if C.size h > Array.length (C.buckets h) lsl 1 then resize h end let rec mem_in_bucket (key : key) buckets = - match N.toOpt buckets with + match C.toOpt buckets with | None -> false | Some cell -> (N.key cell) = key || mem_in_bucket key (N.next cell) let mem h key = - let h_buckets = N.buckets h in + let h_buckets = C.buckets h in let nid = hash key land (Array.length h_buckets - 1) in mem_in_bucket key (Bs_Array.unsafe_get h_buckets nid) -let create = N.create0 -let clear = N.clear0 -let reset = N.reset0 -let length = N.length0 +let create = C.create0 +let clear = C.clear0 +let reset = C.reset0 +let length = C.length0 let iter = N.iter0 let fold = N.fold0 let logStats = N.logStats0 diff --git a/jscomp/others/hashset.cppo.ml b/jscomp/others/hashset.cppo.ml new file mode 100644 index 00000000000..6f07f308431 --- /dev/null +++ b/jscomp/others/hashset.cppo.ml @@ -0,0 +1,155 @@ +#ifdef TYPE_STRING +type key = string +type seed = int +external caml_hash_mix_string : seed -> string -> seed = "caml_hash_mix_string" +external final_mix : seed -> seed = "caml_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 = "caml_hash_mix_int" +external final_mix : seed -> seed = "caml_hash_final_mix" +let hash (s : key) = + final_mix (caml_hash_mix_int 0 s) + #else + [%error "unknown type"] +#endif + +module N = Bs_internalSetBuckets +module C = Bs_internalBucketsType +type t = key N.t0 + +let rec insert_bucket ~h_buckets ~ndata_tail h old_bucket = + match C.toOpt old_bucket with + | None -> () + | Some cell -> + let nidx = hash (N.key cell) land (Array.length h_buckets - 1) in + let v = C.return cell in + begin match C.toOpt (Bs_Array.unsafe_get ndata_tail nidx) with + | None -> + Bs_Array.unsafe_set h_buckets nidx v + | Some tail -> + N.nextSet tail v (* cell put at the end *) + end; + Bs_Array.unsafe_set ndata_tail nidx v; + insert_bucket ~h_buckets ~ndata_tail h (N.next cell) + + +let resize h = + let odata = C.buckets h in + let osize = Array.length odata in + let nsize = osize * 2 in + if nsize >= osize then begin (* no overflow *) + let h_buckets = C.makeSize nsize in + let ndata_tail = C.makeSize nsize in (* keep track of tail *) + C.bucketsSet h h_buckets; (* so that indexfun sees the new bucket count *) + for i = 0 to osize - 1 do + insert_bucket ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i) + done; + for i = 0 to nsize - 1 do + match C.toOpt (Bs_Array.unsafe_get ndata_tail i) with + | None -> () + | Some tail -> N.nextSet tail C.emptyOpt + done + end + + + +let rec remove_bucket h h_buckets i (key : key) prec cell = + let cell_next = N.next cell in + if (N.key cell) = key + then + begin + N.nextSet prec cell_next; + C.sizeSet h (C.size h - 1); + end + else + match C.toOpt cell_next with + | None -> + () + | Some cell_next -> + remove_bucket h h_buckets i key cell cell_next + +let remove h (key : key)= + let h_buckets = C.buckets h in + let i = hash key land (Array.length h_buckets - 1) in + let l = (Bs_Array.unsafe_get h_buckets i) in + match C.toOpt l with + | None -> () + | Some cell -> + let next_cell = (N.next cell) in + if (N.key cell) = key then + begin + C.sizeSet h (C.size h - 1) ; + Bs_Array.unsafe_set h_buckets i next_cell + end + else + match C.toOpt next_cell with + | None -> () + | Some next_cell -> + remove_bucket h h_buckets i key cell next_cell + + + + +let rec addBucket h buckets_len (key : key) cell = + if N.key cell <> key then + let n = N.next cell in + match C.toOpt n with + | None -> + C.sizeSet h (C.size h + 1); + N.nextSet cell (C.return @@ N.bucket ~key ~next:n); + if C.size h > buckets_len lsl 1 then resize h + | Some n -> addBucket h buckets_len key n + +let add h key = + let h_buckets = C.buckets h in + let buckets_len = Array.length h_buckets in + let i = hash key land (buckets_len - 1) in + let l = Array.unsafe_get h_buckets i in + match C.toOpt l with + | None -> + Bs_Array.unsafe_set h_buckets i + (C.return @@ N.bucket ~key ~next:C.emptyOpt); + C.sizeSet h (C.size h + 1); + if C.size h > buckets_len lsl 1 then resize h + | Some cell -> + addBucket h buckets_len key cell + + + +let rec mem_in_bucket (key : key) cell = + + (N.key cell) = key || + (match C.toOpt (N.next cell) with + | None -> false + | Some nextCell -> + mem_in_bucket key nextCell) + +let mem h key = + let h_buckets = C.buckets h in + let nid = hash key land (Array.length h_buckets - 1) in + let bucket = (Bs_Array.unsafe_get h_buckets nid) in + match C.toOpt bucket with + | None -> false + | Some bucket -> + mem_in_bucket key bucket + + +let create = C.create0 +let clear = C.clear0 +let reset = C.reset0 +let length = C.length0 +let iter = N.iter0 +let fold = N.fold0 +let logStats = N.logStats0 +let toArray = N.toArray0 + +let ofArray arr = + let len = Bs.Array.length arr in + let v = create len in + for i = 0 to len - 1 do + add v (Bs.Array.unsafe_get arr i) + done ; + v \ No newline at end of file diff --git a/jscomp/others/hashset.cppo.mli b/jscomp/others/hashset.cppo.mli new file mode 100644 index 00000000000..7cd0d1f7139 --- /dev/null +++ b/jscomp/others/hashset.cppo.mli @@ -0,0 +1,177 @@ +#ifdef TYPE_STRING +type key = string +#elif defined TYPE_INT +type key = int +#else +[%error "unknown type"] +#endif + + +type t + + + + +val create : int -> t + +(** [Hashtbl.create n] creates a new, empty hash table, with + initial size [n]. For best results, [n] should be on the + order of the expected number of elements that will be in + the table. The table grows as needed, so [n] is just an + initial guess. + + The optional [random] parameter (a boolean) controls whether + the internal organization of the hash table is randomized at each + execution of [Hashtbl.create] or deterministic over all executions. + + A hash table that is created with [~random:false] uses a + fixed hash function ({!Hashtbl.hash}) to distribute keys among + buckets. As a consequence, collisions between keys happen + deterministically. In Web-facing applications or other + security-sensitive applications, the deterministic collision + patterns can be exploited by a malicious user to create a + denial-of-service attack: the attacker sends input crafted to + create many collisions in the table, slowing the application down. + + A hash table that is created with [~random:true] uses the seeded + hash function {!Hashtbl.seeded_hash} with a seed that is randomly + chosen at hash table creation time. In effect, the hash function + used is randomly selected among [2^{30}] different hash functions. + All these hash functions have different collision patterns, + rendering ineffective the denial-of-service attack described above. + However, because of randomization, enumerating all elements of the + hash table using {!Hashtbl.fold} or {!Hashtbl.iter} is no longer + deterministic: elements are enumerated in different orders at + different runs of the program. + + If no [~random] parameter is given, hash tables are created + in non-random mode by default. This default can be changed + either programmatically by calling {!Hashtbl.randomize} or by + setting the [R] flag in the [OCAMLRUNPARAM] environment variable. + + @before 4.00.0 the [random] parameter was not present and all + hash tables were created in non-randomized mode. *) + + +val clear : t -> unit +(** Empty a hash table. Use [reset] instead of [clear] to shrink the + size of the bucket table to its initial size. *) + + +val reset : t -> unit +(** Empty a hash table and shrink the size of the bucket table + to its initial size. + @since 4.00.0 *) + + + +val add : t -> key -> unit +(** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl]. + Previous bindings for [x] are not removed, but simply + hidden. That is, after performing {!Hashtbl.remove}[ tbl x], + the previous binding for [x], if any, is restored. + (Same behavior as with association lists.) *) + + +val mem: + t -> key -> bool +(** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. *) + +val remove: + t -> key -> unit +(** [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl], + restoring the previous binding if it exists. + It does nothing if [x] is not bound in [tbl]. *) + + + + + +val iter : (key -> unit [@bs]) -> t -> unit +(** [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl]. + [f] receives the key as first argument, and the associated value + as second argument. Each binding is presented exactly once to [f]. + + The order in which the bindings are passed to [f] is unspecified. + However, if the table contains several bindings for the same key, + they are passed to [f] in reverse order of introduction, that is, + the most recent binding is passed first. + + If the hash table was created in non-randomized mode, the order + in which the bindings are enumerated is reproducible between + successive runs of the program, and even between minor versions + of OCaml. For randomized hash tables, the order of enumeration + is entirely random. *) + + +val fold : (key -> 'c -> 'c [@bs]) -> t -> 'c -> 'c +(** [Hashtbl.fold f tbl init] computes + [(f kN dN ... (f k1 d1 init)...)], + where [k1 ... kN] are the keys of all bindings in [tbl], + and [d1 ... dN] are the associated values. + Each binding is presented exactly once to [f]. + + The order in which the bindings are passed to [f] is unspecified. + However, if the table contains several bindings for the same key, + they are passed to [f] in reverse order of introduction, that is, + the most recent binding is passed first. + + If the hash table was created in non-randomized mode, the order + in which the bindings are enumerated is reproducible between + successive runs of the program, and even between minor versions + of OCaml. For randomized hash tables, the order of enumeration + is entirely random. *) + + +val length : t -> int +(** [Hashtbl.length tbl] returns the number of bindings in [tbl]. + It takes constant time. Multiple bindings are counted once each, so + [Hashtbl.length] gives the number of times [Hashtbl.iter] calls its + first argument. *) + + + + + +val logStats : t -> unit +(** [Hashtbl.stats tbl] returns statistics about the table [tbl]: + number of buckets, size of the biggest bucket, distribution of + buckets by size. + @since 4.00.0 *) + +(** {6 Functorial interface} *) + +(** The functorial interface allows the use of specific comparison + and hash functions, either for performance/security concerns, + or because keys are not hashable/comparable with the polymorphic builtins. + + For instance, one might want to specialize a table for integer keys: + {[ + module IntHash = + struct + type t = int + let equal i j = i=j + let hash i = i land max_int + end + + module IntHashtbl = Hashtbl.Make(IntHash) + + let h = IntHashtbl.create 17 in + IntHashtbl.add h 12 "hello";; + ]} + + This creates a new module [IntHashtbl], with a new type ['a + IntHashtbl.t] of tables from [int] to ['a]. In this example, [h] + contains [string] values so its type is [string IntHashtbl.t]. + + Note that the new type ['a IntHashtbl.t] is not compatible with + the type [('a,'b) Hashtbl.t] of the generic interface. For + example, [Hashtbl.length h] would not type-check, you must use + [IntHashtbl.length]. +*) + + + +val toArray : t -> key array + +val ofArray : key array -> t \ No newline at end of file diff --git a/jscomp/others/set.cppo.ml b/jscomp/others/set.cppo.ml index 3353dea436e..36a4addd6ce 100644 --- a/jscomp/others/set.cppo.ml +++ b/jscomp/others/set.cppo.ml @@ -33,6 +33,7 @@ let filter = N.filter0 let partition = N.partition0 let cardinal = N.cardinal0 let elements = N.elements0 +let toArray = N.toArray0 let checkInvariant = N.checkInvariant (* Insertion of one element *) diff --git a/jscomp/others/set.cppo.mli b/jscomp/others/set.cppo.mli index a032cb2bc39..6232b3b81ad 100644 --- a/jscomp/others/set.cppo.mli +++ b/jscomp/others/set.cppo.mli @@ -88,6 +88,8 @@ val elements: t -> elt list to the ordering [Ord.compare], where [Ord] is the argument given to {!Set.Make}. *) +val toArray: t -> elt array + val min: t -> elt option (** Return the smallest element of the given set (with respect to the [Ord.compare] ordering), or raise diff --git a/jscomp/test/.depend b/jscomp/test/.depend index 8ecc9c2585d..9e2b7b3e105 100644 --- a/jscomp/test/.depend +++ b/jscomp/test/.depend @@ -60,6 +60,7 @@ arith_parser.cmj : ../stdlib/parsing.cmj ../stdlib/obj.cmj \ ../stdlib/lexing.cmj arith_syntax.cmj arith_syntax.cmj : arity_deopt.cmj : mt.cmj +array_data_util.cmj : ../others/bs.cmj ../stdlib/array.cmj array_safe_get.cmj : ../stdlib/array.cmj array_subtle_test.cmj : mt.cmj ../runtime/js.cmj ../stdlib/array.cmj array_test.cmj : ../stdlib/pervasives.cmj mt.cmj ../stdlib/list.cmj \ @@ -89,6 +90,8 @@ bs_abstract_test.cmj : ../runtime/js.cmj bs_array_test.cmj : mt.cmj ../runtime/js.cmj ../others/bs.cmj bs_auto_uncurry.cmj : ../runtime/js.cmj bs_auto_uncurry_test.cmj : mt.cmj ../others/js_array.cmj ../runtime/js.cmj +bs_hashmap_test.cmj : +bs_hashset_int_test.cmj : mt.cmj ../others/bs.cmj array_data_util.cmj bs_hashtbl_string_test.cmj : ../stdlib/hashtbl.cmj ../others/bs.cmj bs_ignore_effect.cmj : mt.cmj bs_ignore_test.cmj : ../runtime/js.cmj diff --git a/jscomp/test/Makefile b/jscomp/test/Makefile index b7fda162b4e..ef702089c13 100644 --- a/jscomp/test/Makefile +++ b/jscomp/test/Makefile @@ -224,6 +224,9 @@ OTHERS := test_literals a test_ari test_export2 test_internalOO test_obj_simple_ bs_mutable_set_test\ bs_abstract_test\ bs_queue_test\ + bs_hashmap_test\ + bs_hashset_int_test\ + array_data_util\ # bs_uncurry_test # needs Lam to get rid of Uncurry arity first # simple_derive_test diff --git a/jscomp/test/array_data_util.js b/jscomp/test/array_data_util.js new file mode 100644 index 00000000000..cc233d2e201 --- /dev/null +++ b/jscomp/test/array_data_util.js @@ -0,0 +1,22 @@ +'use strict'; + +var $$Array = require("../../lib/js/array.js"); +var Bs_Array = require("../../lib/js/bs_Array.js"); + +function range(i, j) { + return $$Array.init((j - i | 0) + 1 | 0, (function (k) { + return k + i | 0; + })); +} + +function randomRange(i, j) { + var v = Bs_Array.init((j - i | 0) + 1 | 0, (function (k) { + return k + i | 0; + })); + Bs_Array.shuffleInPlace(v); + return v; +} + +exports.range = range; +exports.randomRange = randomRange; +/* No side effect */ diff --git a/jscomp/test/array_data_util.ml b/jscomp/test/array_data_util.ml new file mode 100644 index 00000000000..b3e0d016cc5 --- /dev/null +++ b/jscomp/test/array_data_util.ml @@ -0,0 +1,9 @@ + +(* []*) +let range i j = + Array.init (j - i + 1) (fun k -> k + i ) + +let randomRange i j = + let v = Bs.Array.init (j - i + 1) (fun[@bs] k -> k + i ) in + Bs.Array.shuffleInPlace v ; + v \ No newline at end of file diff --git a/jscomp/test/bs_hashmap_test.js b/jscomp/test/bs_hashmap_test.js new file mode 100644 index 00000000000..ae1b9f17e65 --- /dev/null +++ b/jscomp/test/bs_hashmap_test.js @@ -0,0 +1 @@ +/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */ diff --git a/jscomp/test/bs_hashmap_test.ml b/jscomp/test/bs_hashmap_test.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/jscomp/test/bs_hashset_int_test.js b/jscomp/test/bs_hashset_int_test.js new file mode 100644 index 00000000000..a3cb648510a --- /dev/null +++ b/jscomp/test/bs_hashset_int_test.js @@ -0,0 +1,58 @@ +'use strict'; + +var Mt = require("./mt.js"); +var Block = require("../../lib/js/block.js"); +var Bs_Array = require("../../lib/js/bs_Array.js"); +var Bs_SetInt = require("../../lib/js/bs_SetInt.js"); +var Bs_HashSetInt = require("../../lib/js/bs_HashSetInt.js"); +var Array_data_util = require("./array_data_util.js"); + +var suites = [/* [] */0]; + +var test_id = [0]; + +function eq(loc, x, y) { + test_id[0] = test_id[0] + 1 | 0; + suites[0] = /* :: */[ + /* tuple */[ + loc + (" id " + test_id[0]), + (function () { + return /* Eq */Block.__(0, [ + x, + y + ]); + }) + ], + suites[0] + ]; + return /* () */0; +} + +var u = Bs_Array.append(Array_data_util.randomRange(30, 100), Array_data_util.randomRange(40, 120)); + +var v = Bs_HashSetInt.ofArray(u); + +eq("File \"bs_hashset_int_test.ml\", line 17, characters 5-12", Bs_HashSetInt.length(v), 91); + +var xs = Bs_SetInt.toArray(Bs_SetInt.ofArray(Bs_HashSetInt.toArray(v))); + +eq("File \"bs_hashset_int_test.ml\", line 19, characters 5-12", xs, Array_data_util.range(30, 120)); + +Mt.from_pair_suites("bs_hashset_int_test.ml", suites[0]); + +var N = 0; + +var S = 0; + +var I = 0; + +var $plus$plus = Bs_Array.append; + +exports.suites = suites; +exports.test_id = test_id; +exports.eq = eq; +exports.N = N; +exports.S = S; +exports.I = I; +exports.$plus$plus = $plus$plus; +/* u Not a pure module */ diff --git a/jscomp/test/bs_hashset_int_test.ml b/jscomp/test/bs_hashset_int_test.ml new file mode 100644 index 00000000000..0783a598fcf --- /dev/null +++ b/jscomp/test/bs_hashset_int_test.ml @@ -0,0 +1,21 @@ +let suites : Mt.pair_suites ref = ref [] +let test_id = ref 0 +let eq loc x y = + incr test_id ; + suites := + (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites + +module N = Bs.HashSetInt +module S = Bs.SetInt + +module I = Array_data_util +let (++) = Bs.Array.append + +let () = + let u = I.randomRange 30 100 ++ I.randomRange 40 120 in + let v = N.ofArray u in + eq __LOC__ (N.length v) 91 ; + let xs = S.toArray (S.ofArray (N.toArray v)) in + eq __LOC__ xs (I.range 30 120) +let () = Mt.from_pair_suites __FILE__ !suites + \ No newline at end of file diff --git a/jscomp/test/bs_hashtbl_string_test.js b/jscomp/test/bs_hashtbl_string_test.js index 6207b0d076e..b678181ebf5 100644 --- a/jscomp/test/bs_hashtbl_string_test.js +++ b/jscomp/test/bs_hashtbl_string_test.js @@ -6,9 +6,11 @@ var Caml_hash = require("../../lib/js/caml_hash.js"); var Bs_HashMap = require("../../lib/js/bs_HashMap.js"); var Caml_string = require("../../lib/js/caml_string.js"); var Bs_HashMapInt = require("../../lib/js/bs_HashMapInt.js"); +var Bs_HashSetInt = require("../../lib/js/bs_HashSetInt.js"); var Bs_HashMapString = require("../../lib/js/bs_HashMapString.js"); var Bs_internalAVLtree = require("../../lib/js/bs_internalAVLtree.js"); var Bs_internalBuckets = require("../../lib/js/bs_internalBuckets.js"); +var Bs_internalBucketsType = require("../../lib/js/bs_internalBucketsType.js"); var Caml_builtin_exceptions = require("../../lib/js/caml_builtin_exceptions.js"); function hash_string(s) { @@ -16,15 +18,15 @@ function hash_string(s) { } var hashString = (function (str) { - var hash = 5381, - i = str.length | 0; + var hash = 5381, + i = str.length | 0; - while(i !== 0) { - hash = (hash * 33) ^ str.charCodeAt(--i); - } - return hash -} -); + while(i !== 0) { + hash = (hash * 33) ^ str.charCodeAt(--i); + } + return hash + } + ); var String_000 = Hashtbl.hash; @@ -72,7 +74,7 @@ var Int = /* module */[ var empty = { dict: Int, - data: Bs_internalBuckets.create0(500000) + data: Bs_internalBucketsType.create0(500000) }; function bench() { @@ -98,7 +100,7 @@ function bench() { function bench2(m) { var empty = { dict: m, - data: Bs_internalBuckets.create0(1000000) + data: Bs_internalBucketsType.create0(1000000) }; var hash = m[/* hash */0]; var eq = m[/* eq */1]; @@ -176,7 +178,7 @@ function bench3(m) { } } -var S = /* module */[/* cmp */Caml_string.caml_string_compare]; +var Sx = /* module */[/* cmp */Caml_string.caml_string_compare]; function bench4() { var table = Bs_HashMapString.create(1000000); @@ -216,7 +218,7 @@ function bench4() { function bench5() { var table = { dict: Int, - data: Bs_internalBuckets.create0(1000000) + data: Bs_internalBucketsType.create0(1000000) }; var table_data = table.data; var hash = Int_000; @@ -234,7 +236,7 @@ function bench5() { [ "bs_hashtbl_string_test.ml", 135, - 4 + 6 ] ]; } @@ -295,23 +297,46 @@ function bench6() { } } -console.time("bs_hashtbl_string_test.ml 169"); - -bench6(/* () */0); - -console.timeEnd("bs_hashtbl_string_test.ml 169"); - -console.time("bs_hashtbl_string_test.ml 170"); - -bench6(/* () */0); - -console.timeEnd("bs_hashtbl_string_test.ml 170"); +function bench7() { + var table = Bs_HashSetInt.create(2000000); + for(var i = 0; i <= 1000000; ++i){ + Bs_HashSetInt.add(table, i); + } + for(var i$1 = 0; i$1 <= 1000000; ++i$1){ + if (!Bs_HashSetInt.mem(table, i$1)) { + throw [ + Caml_builtin_exceptions.assert_failure, + [ + "bs_hashtbl_string_test.ml", + 177, + 4 + ] + ]; + } + + } + for(var i$2 = 0; i$2 <= 1000000; ++i$2){ + Bs_HashSetInt.remove(table, i$2); + } + if (Bs_HashSetInt.length(table)) { + throw [ + Caml_builtin_exceptions.assert_failure, + [ + "bs_hashtbl_string_test.ml", + 188, + 2 + ] + ]; + } else { + return 0; + } +} -console.time("bs_hashtbl_string_test.ml 171"); +console.time("bs_hashtbl_string_test.ml 199"); -bench6(/* () */0); +bench7(/* () */0); -console.timeEnd("bs_hashtbl_string_test.ml 171"); +console.timeEnd("bs_hashtbl_string_test.ml 199"); var count = 1000000; @@ -319,6 +344,8 @@ var initial_size = 1000000; var B = 0; +var S = 0; + exports.hash_string = hash_string; exports.hashString = hashString; exports.$$String = $$String; @@ -332,8 +359,10 @@ exports.initial_size = initial_size; exports.B = B; exports.bench2 = bench2; exports.bench3 = bench3; -exports.S = S; +exports.Sx = Sx; exports.bench4 = bench4; exports.bench5 = bench5; exports.bench6 = bench6; +exports.S = S; +exports.bench7 = bench7; /* hashString Not a pure module */ diff --git a/jscomp/test/bs_hashtbl_string_test.ml b/jscomp/test/bs_hashtbl_string_test.ml index 1217e048f3f..b46d2616355 100644 --- a/jscomp/test/bs_hashtbl_string_test.ml +++ b/jscomp/test/bs_hashtbl_string_test.ml @@ -7,44 +7,44 @@ let hash_string s = final_mix (caml_hash_mix_string 0 s) let hashString : string -> int [@bs] = [%raw{|function (str) { - var hash = 5381, - i = str.length | 0; + var hash = 5381, + i = str.length | 0; - while(i !== 0) { - hash = (hash * 33) ^ str.charCodeAt(--i); - } - return hash -} -|}] + while(i !== 0) { + hash = (hash * 33) ^ str.charCodeAt(--i); + } + return hash + } + |}] module String = (val Bs.Hash.make - ~eq:(fun[@bs] (x:string) y -> x = y ) - ~hash:(fun [@bs] (x : string) -> Hashtbl.hash x )) - + ~eq:(fun[@bs] (x:string) y -> x = y ) + ~hash:(fun [@bs] (x : string) -> Hashtbl.hash x )) + module String1 = (val Bs.Hash.make - ~eq:(fun[@bs] (x:string) y -> x = y ) - ~hash:hashString) + ~eq:(fun[@bs] (x:string) y -> x = y ) + ~hash:hashString) module String2 = (val Bs.Hash.make - ~eq:(fun[@bs] (x:string) y -> x = y ) - ~hash:(fun [@bs] (x:string) -> hash_string x)) + ~eq:(fun[@bs] (x:string) y -> x = y ) + ~hash:(fun [@bs] (x:string) -> hash_string x)) module Int = (val Bs.Hash.make - ~eq:(fun[@bs] (x:int) y -> x = y ) - ~hash:(fun [@bs] x -> Hashtbl.hash x)) + ~eq:(fun[@bs] (x:int) y -> x = y ) + ~hash:(fun [@bs] x -> Hashtbl.hash x)) let empty = Bs.HashMap.create (module Int) 500_000 - + let bench() = let count = 1_000_000 in let add = Bs.HashMap.add in let mem = Bs.HashMap.mem in for i = 0 to count do - add empty i i + add empty i i done ; for i = 0 to count do assert (mem empty i) @@ -69,19 +69,19 @@ let bench2 (type t) (m : (string,t) Bs.Hash.t) = let table = B.data empty in for i = 0 to count do Bs.HashMap.add0 ~hash - table (string_of_int i) i + table (string_of_int i) i done ; for i = 0 to count do assert (Bs.HashMap.mem0 - ~hash ~eq - table (string_of_int i)) + ~hash ~eq + table (string_of_int i)) done; for i = 0 to count do Bs.HashMap.remove0 ~hash ~eq table (string_of_int i) done ; assert (Bs.HashMap.length0 table = 0) - - (* Bs.HashMap.logStats empty *) + +(* Bs.HashMap.logStats empty *) let bench3 (type t) (m : (string,t) Bs.Cmp.t) = let empty = Bs.Map.empty m in @@ -94,27 +94,27 @@ let bench3 (type t) (m : (string,t) Bs.Cmp.t) = done ; for i = 0 to count do assert (Bs.Map.mem0 ~cmp - - (string_of_int i) !table) + + (string_of_int i) !table) done; for i = 0 to count do table := Bs.Map.remove0 ~cmp (string_of_int i) !table done ; assert (Bs.Map.cardinal0 !table = 0) - -module S = (val Bs.Cmp.make (fun [@bs] (x : string) y -> compare x y )) - let bench4 () = +module Sx = (val Bs.Cmp.make (fun [@bs] (x : string) y -> compare x y )) + +let bench4 () = let table = Bs.HashMapString.create initial_size in for i = 0 to count do Bs.HashMapString.add - table (string_of_int i) i + table (string_of_int i) i done ; for i = 0 to count do assert (Bs.HashMapString.mem - table (string_of_int i)) + table (string_of_int i)) done; for i = 0 to count do Bs.HashMapString.remove table (string_of_int i) @@ -128,44 +128,77 @@ let bench5 () = let hash = Int.hash in let eq = Int.eq in [%time for i = 0 to count do - Bs.HashMap.add0 ~hash - table_data i i - done] ; + Bs.HashMap.add0 ~hash + table_data i i + done] ; [%time for i = 0 to count do - assert (Bs.HashMap.mem0 ~eq ~hash - table_data i) - done]; + assert (Bs.HashMap.mem0 ~eq ~hash + table_data i) + done]; [%time for i = 0 to count do - Bs.HashMap.remove0 ~eq ~hash table_data i - done ]; + Bs.HashMap.remove0 ~eq ~hash table_data i + done ]; assert (Bs.HashMap.length table = 0) - let bench6 () = +let bench6 () = let table = Bs.HashMapInt.create initial_size in for i = 0 to count do Bs.HashMapInt.add - table i i + table i i done ; for i = 0 to count do assert (Bs.HashMapInt.mem - table i) + table i) done; for i = 0 to count do Bs.HashMapInt.remove table i done ; assert (Bs.HashMapInt.length table = 0) - -(* ;; [%time bench4 ()] -;; [%time bench4 ()] -;; [%time bench2 (module String1)] -;; [%time bench2 (module String2)] +module S = Bs.HashSetInt +let bench7 () = + let table = + (* [%time *) + S.create (initial_size* 2) + (* ] *) + in + + (* [%time *) + for i = 0 to count do + S.add + table i + done + (* ] *) + ; + (* [%time *) + for i = 0 to count do + assert (S.mem + table i) + done + (* ] *) + ; + (* [%time *) + for i = 0 to count do + S.remove table i + done + (* ] *) + ; + assert (S.length table = 0) -;; [%time bench3 (module S)] -;; [%time bench5()] *) -;; [%time bench6 ()] -;; [%time bench6 ()] -;; [%time bench6 ()] \ No newline at end of file +(* ;; [%time bench4 ()] + ;; [%time bench4 ()] + ;; [%time bench2 (module String1)] + ;; [%time bench2 (module String2)] + + ;; [%time bench3 (module S)] + ;; [%time bench5()] *) +(* ;; [%time bench6 ()] *) +;; [%time bench7 ()] +(* ;; [%time bench7 ()] +;; [%time bench7 ()] +;; [%time bench7 ()] +;; [%time bench7 ()] +;; [%time bench7 ()] *) \ No newline at end of file diff --git a/jscomp/test/xx_hash_set.js b/jscomp/test/xx_hash_set.js new file mode 100644 index 00000000000..4f631989767 --- /dev/null +++ b/jscomp/test/xx_hash_set.js @@ -0,0 +1,27 @@ + +var empty = new Set() + +function bench() { + for (var i = 0; i < 1000000; ++i) { + empty.add(i) + } + for (var i = 0; i < 1000000; ++i) { + if (!empty.has(i)) { + throw "impossible" + } + } + for (var i = 0; i < 1000000; ++i) { + empty.delete(i) + } + // console.log(empty.size) +} + +function test(){ + console.time('start') + bench() + console.timeEnd('start') +} + +test() +test() +test() \ No newline at end of file diff --git a/lib/js/bs.js b/lib/js/bs.js index e564606ac19..c02c81c379b 100644 --- a/lib/js/bs.js +++ b/lib/js/bs.js @@ -13,6 +13,12 @@ var Queue = 0; var HashMap = 0; +var HashSet = 0; + +var HashSetInt = 0; + +var HashSetString = 0; + var HashMapString = 0; var HashMapInt = 0; @@ -35,6 +41,9 @@ exports.Hash = Hash; exports.$$Array = $$Array; exports.Queue = Queue; exports.HashMap = HashMap; +exports.HashSet = HashSet; +exports.HashSetInt = HashSetInt; +exports.HashSetString = HashSetString; exports.HashMapString = HashMapString; exports.HashMapInt = HashMapInt; exports.$$Map = $$Map; diff --git a/lib/js/bs_HashMap.js b/lib/js/bs_HashMap.js index 351523bcf3b..d22a9d88045 100644 --- a/lib/js/bs_HashMap.js +++ b/lib/js/bs_HashMap.js @@ -1,6 +1,7 @@ 'use strict'; -var Bs_internalBuckets = require("./bs_internalBuckets.js"); +var Bs_internalBuckets = require("./bs_internalBuckets.js"); +var Bs_internalBucketsType = require("./bs_internalBucketsType.js"); function insert_bucket(hash, h_buckets, ndata_tail, _, _old_bucket) { while(true) { @@ -37,7 +38,7 @@ function resize(hash, h) { for(var i$1 = 0 ,i_finish$1 = nsize - 1 | 0; i$1 <= i_finish$1; ++i$1){ var match = ndata_tail[i$1]; if (match !== undefined) { - match.next = Bs_internalBuckets.emptyOpt; + match.next = Bs_internalBucketsType.emptyOpt; } } @@ -74,7 +75,7 @@ function remove0(hash, eq, h, key) { var h_buckets$1 = h_buckets; var i$1 = i; var key$1 = key; - var _prec = Bs_internalBuckets.emptyOpt; + var _prec = Bs_internalBucketsType.emptyOpt; var _buckets = h_buckets[i]; while(true) { var buckets = _buckets; @@ -109,7 +110,7 @@ function removeAll0(hash, eq, h, key) { var h_buckets$1 = h_buckets; var i$1 = i; var key$1 = key; - var _prec = Bs_internalBuckets.emptyOpt; + var _prec = Bs_internalBucketsType.emptyOpt; var _buckets = h_buckets[i]; while(true) { var buckets = _buckets; @@ -251,38 +252,44 @@ function replace0(hash, eq, h, key, info) { function mem0(hash, eq, h, key) { var h_buckets = h.buckets; var nid = hash(key) & (h_buckets.length - 1 | 0); - var eq$1 = eq; - var key$1 = key; - var _buckets = h_buckets[nid]; - while(true) { - var buckets = _buckets; - if (buckets !== undefined) { - if (eq$1(buckets.key, key$1)) { + var bucket = h_buckets[nid]; + if (bucket !== undefined) { + var eq$1 = eq; + var key$1 = key; + var _cell = bucket; + while(true) { + var cell = _cell; + if (eq$1(cell.key, key$1)) { return /* true */1; } else { - _buckets = buckets.next; - continue ; - + var match = cell.next; + if (match !== undefined) { + _cell = match; + continue ; + + } else { + return /* false */0; + } } - } else { - return /* false */0; - } - }; + }; + } else { + return /* false */0; + } } function create(dict, initialize_size) { return { dict: dict, - data: Bs_internalBuckets.create0(initialize_size) + data: Bs_internalBucketsType.create0(initialize_size) }; } function clear(h) { - return Bs_internalBuckets.clear0(h.data); + return Bs_internalBucketsType.clear0(h.data); } function reset(h) { - return Bs_internalBuckets.reset0(h.data); + return Bs_internalBucketsType.reset0(h.data); } function length(h) { @@ -347,11 +354,11 @@ function filterMapInplace(f, h) { return Bs_internalBuckets.filterMapInplace0(f, h.data); } -var create0 = Bs_internalBuckets.create0; +var create0 = Bs_internalBucketsType.create0; -var clear0 = Bs_internalBuckets.clear0; +var clear0 = Bs_internalBucketsType.clear0; -var reset0 = Bs_internalBuckets.reset0; +var reset0 = Bs_internalBucketsType.reset0; var iter0 = Bs_internalBuckets.iter0; @@ -359,7 +366,7 @@ var fold0 = Bs_internalBuckets.fold0; var filterMapInplace0 = Bs_internalBuckets.filterMapInplace0; -var length0 = Bs_internalBuckets.length0; +var length0 = Bs_internalBucketsType.length0; var logStats0 = Bs_internalBuckets.logStats0; diff --git a/lib/js/bs_HashMapInt.js b/lib/js/bs_HashMapInt.js index 4e085a2e1da..88acd16a431 100644 --- a/lib/js/bs_HashMapInt.js +++ b/lib/js/bs_HashMapInt.js @@ -1,7 +1,8 @@ 'use strict'; -var Caml_hash = require("./caml_hash.js"); -var Bs_internalBuckets = require("./bs_internalBuckets.js"); +var Caml_hash = require("./caml_hash.js"); +var Bs_internalBuckets = require("./bs_internalBuckets.js"); +var Bs_internalBucketsType = require("./bs_internalBucketsType.js"); function insert_bucket(h_buckets, ndata_tail, _, _old_bucket) { while(true) { @@ -39,7 +40,7 @@ function resize(h) { for(var i$1 = 0 ,i_finish$1 = nsize - 1 | 0; i$1 <= i_finish$1; ++i$1){ var match = ndata_tail[i$1]; if (match !== undefined) { - match.next = Bs_internalBuckets.emptyOpt; + match.next = Bs_internalBucketsType.emptyOpt; } } @@ -75,7 +76,7 @@ function remove(h, key) { var h_buckets$1 = h_buckets; var i$1 = i; var key$1 = key; - var _prec = Bs_internalBuckets.emptyOpt; + var _prec = Bs_internalBucketsType.emptyOpt; var _buckets = h_buckets[i]; while(true) { var buckets = _buckets; @@ -109,7 +110,7 @@ function removeAll(h, key) { var h_buckets$1 = h_buckets; var i$1 = i; var key$1 = key; - var _prec = Bs_internalBuckets.emptyOpt; + var _prec = Bs_internalBucketsType.emptyOpt; var _buckets = h_buckets[i]; while(true) { var buckets = _buckets; @@ -268,11 +269,11 @@ function mem(h, key) { }; } -var create = Bs_internalBuckets.create0; +var create = Bs_internalBucketsType.create0; -var clear = Bs_internalBuckets.clear0; +var clear = Bs_internalBucketsType.clear0; -var reset = Bs_internalBuckets.reset0; +var reset = Bs_internalBucketsType.reset0; var iter = Bs_internalBuckets.iter0; @@ -280,7 +281,7 @@ var fold = Bs_internalBuckets.fold0; var filterMapInplace = Bs_internalBuckets.filterMapInplace0; -var length = Bs_internalBuckets.length0; +var length = Bs_internalBucketsType.length0; var logStats = Bs_internalBuckets.logStats0; diff --git a/lib/js/bs_HashMapString.js b/lib/js/bs_HashMapString.js index 31a31779404..7e97a191062 100644 --- a/lib/js/bs_HashMapString.js +++ b/lib/js/bs_HashMapString.js @@ -1,7 +1,8 @@ 'use strict'; -var Caml_hash = require("./caml_hash.js"); -var Bs_internalBuckets = require("./bs_internalBuckets.js"); +var Caml_hash = require("./caml_hash.js"); +var Bs_internalBuckets = require("./bs_internalBuckets.js"); +var Bs_internalBucketsType = require("./bs_internalBucketsType.js"); function insert_bucket(h_buckets, ndata_tail, _, _old_bucket) { while(true) { @@ -39,7 +40,7 @@ function resize(h) { for(var i$1 = 0 ,i_finish$1 = nsize - 1 | 0; i$1 <= i_finish$1; ++i$1){ var match = ndata_tail[i$1]; if (match !== undefined) { - match.next = Bs_internalBuckets.emptyOpt; + match.next = Bs_internalBucketsType.emptyOpt; } } @@ -75,7 +76,7 @@ function remove(h, key) { var h_buckets$1 = h_buckets; var i$1 = i; var key$1 = key; - var _prec = Bs_internalBuckets.emptyOpt; + var _prec = Bs_internalBucketsType.emptyOpt; var _buckets = h_buckets[i]; while(true) { var buckets = _buckets; @@ -109,7 +110,7 @@ function removeAll(h, key) { var h_buckets$1 = h_buckets; var i$1 = i; var key$1 = key; - var _prec = Bs_internalBuckets.emptyOpt; + var _prec = Bs_internalBucketsType.emptyOpt; var _buckets = h_buckets[i]; while(true) { var buckets = _buckets; @@ -268,11 +269,11 @@ function mem(h, key) { }; } -var create = Bs_internalBuckets.create0; +var create = Bs_internalBucketsType.create0; -var clear = Bs_internalBuckets.clear0; +var clear = Bs_internalBucketsType.clear0; -var reset = Bs_internalBuckets.reset0; +var reset = Bs_internalBucketsType.reset0; var iter = Bs_internalBuckets.iter0; @@ -280,7 +281,7 @@ var fold = Bs_internalBuckets.fold0; var filterMapInplace = Bs_internalBuckets.filterMapInplace0; -var length = Bs_internalBuckets.length0; +var length = Bs_internalBucketsType.length0; var logStats = Bs_internalBuckets.logStats0; diff --git a/lib/js/bs_HashSet.js b/lib/js/bs_HashSet.js new file mode 100644 index 00000000000..ac28f1e3b55 --- /dev/null +++ b/lib/js/bs_HashSet.js @@ -0,0 +1,253 @@ +'use strict'; + +var Bs_internalSetBuckets = require("./bs_internalSetBuckets.js"); +var Bs_internalBucketsType = require("./bs_internalBucketsType.js"); + +function insert_bucket(hash, h_buckets, ndata_tail, _, _old_bucket) { + while(true) { + var old_bucket = _old_bucket; + if (old_bucket !== undefined) { + var nidx = hash(old_bucket.key) & (h_buckets.length - 1 | 0); + var match = ndata_tail[nidx]; + if (match !== undefined) { + match.next = old_bucket; + } else { + h_buckets[nidx] = old_bucket; + } + ndata_tail[nidx] = old_bucket; + _old_bucket = old_bucket.next; + continue ; + + } else { + return /* () */0; + } + }; +} + +function remove0(hash, eq, h, key) { + var h_buckets = h.buckets; + var i = hash(key) & (h_buckets.length - 1 | 0); + var l = h_buckets[i]; + if (l !== undefined) { + var next_cell = l.next; + if (eq(l.key, key)) { + h.size = h.size - 1 | 0; + h_buckets[i] = next_cell; + return /* () */0; + } else if (next_cell !== undefined) { + var eq$1 = eq; + var h$1 = h; + var key$1 = key; + var _prec = l; + var _cell = next_cell; + while(true) { + var cell = _cell; + var prec = _prec; + var cell_next = cell.next; + if (eq$1(cell.key, key$1)) { + prec.next = cell_next; + h$1.size = h$1.size - 1 | 0; + return /* () */0; + } else if (cell_next !== undefined) { + _cell = cell_next; + _prec = cell; + continue ; + + } else { + return /* () */0; + } + }; + } else { + return /* () */0; + } + } else { + return /* () */0; + } +} + +function addBucket(eq, h, key, _cell) { + while(true) { + var cell = _cell; + if (eq(cell.key, key)) { + cell.key = key; + return /* () */0; + } else { + var n = cell.next; + if (n !== undefined) { + _cell = n; + continue ; + + } else { + h.size = h.size + 1 | 0; + cell.next = { + key: key, + next: n + }; + return /* () */0; + } + } + }; +} + +function add0(hash, eq, h, key) { + var h_buckets = h.buckets; + var i = hash(key) & (h_buckets.length - 1 | 0); + var l = h_buckets[i]; + if (l !== undefined) { + addBucket(eq, h, key, l); + } else { + h.size = h.size + 1 | 0; + h_buckets[i] = { + key: key, + next: Bs_internalBucketsType.emptyOpt + }; + } + if (h.size > (h.buckets.length << 1)) { + var hash$1 = hash; + var h$1 = h; + var odata = h$1.buckets; + var osize = odata.length; + var nsize = (osize << 1); + if (nsize >= osize) { + var h_buckets$1 = new Array(nsize); + var ndata_tail = new Array(nsize); + h$1.buckets = h_buckets$1; + for(var i$1 = 0 ,i_finish = osize - 1 | 0; i$1 <= i_finish; ++i$1){ + insert_bucket(hash$1, h_buckets$1, ndata_tail, h$1, odata[i$1]); + } + for(var i$2 = 0 ,i_finish$1 = nsize - 1 | 0; i$2 <= i_finish$1; ++i$2){ + var match = ndata_tail[i$2]; + if (match !== undefined) { + match.next = Bs_internalBucketsType.emptyOpt; + } + + } + return /* () */0; + } else { + return 0; + } + } else { + return 0; + } +} + +function mem0(hash, eq, h, key) { + var h_buckets = h.buckets; + var nid = hash(key) & (h_buckets.length - 1 | 0); + var bucket = h_buckets[nid]; + if (bucket !== undefined) { + var eq$1 = eq; + var key$1 = key; + var _cell = bucket; + while(true) { + var cell = _cell; + if (eq$1(cell.key, key$1)) { + return /* true */1; + } else { + var match = cell.next; + if (match !== undefined) { + _cell = match; + continue ; + + } else { + return /* false */0; + } + } + }; + } else { + return /* false */0; + } +} + +function toArray(h) { + return Bs_internalSetBuckets.toArray0(h.data); +} + +function create(dict, initialize_size) { + return { + dict: dict, + data: Bs_internalBucketsType.create0(initialize_size) + }; +} + +function clear(h) { + return Bs_internalBucketsType.clear0(h.data); +} + +function reset(h) { + return Bs_internalBucketsType.reset0(h.data); +} + +function length(h) { + return h.data.size; +} + +function iter(f, h) { + return Bs_internalSetBuckets.iter0(f, h.data); +} + +function fold(f, h, init) { + return Bs_internalSetBuckets.fold0(f, h.data, init); +} + +function logStats(h) { + return Bs_internalSetBuckets.logStats0(h.data); +} + +function add(h, key) { + var dict = h.dict; + var data = h.data; + return add0(dict[/* hash */0], dict[/* eq */1], data, key); +} + +function remove(h, key) { + var dict = h.dict; + var data = h.data; + return remove0(dict[/* hash */0], dict[/* eq */1], data, key); +} + +function mem(h, key) { + var dict = h.dict; + var data = h.data; + return mem0(dict[/* hash */0], dict[/* eq */1], data, key); +} + +var create0 = Bs_internalBucketsType.create0; + +var clear0 = Bs_internalBucketsType.clear0; + +var reset0 = Bs_internalBucketsType.reset0; + +var iter0 = Bs_internalSetBuckets.iter0; + +var fold0 = Bs_internalSetBuckets.fold0; + +var length0 = Bs_internalBucketsType.length0; + +var logStats0 = Bs_internalSetBuckets.logStats0; + +var toArray0 = Bs_internalSetBuckets.toArray0; + +exports.create0 = create0; +exports.create = create; +exports.clear0 = clear0; +exports.clear = clear; +exports.reset0 = reset0; +exports.reset = reset; +exports.add0 = add0; +exports.add = add; +exports.mem0 = mem0; +exports.mem = mem; +exports.remove0 = remove0; +exports.remove = remove; +exports.iter0 = iter0; +exports.iter = iter; +exports.fold0 = fold0; +exports.fold = fold; +exports.length0 = length0; +exports.length = length; +exports.logStats0 = logStats0; +exports.logStats = logStats; +exports.toArray0 = toArray0; +exports.toArray = toArray; +/* Bs_internalBucketsType Not a pure module */ diff --git a/lib/js/bs_HashSetInt.js b/lib/js/bs_HashSetInt.js new file mode 100644 index 00000000000..239cbacb2cc --- /dev/null +++ b/lib/js/bs_HashSetInt.js @@ -0,0 +1,205 @@ +'use strict'; + +var Caml_hash = require("./caml_hash.js"); +var Bs_internalSetBuckets = require("./bs_internalSetBuckets.js"); +var Bs_internalBucketsType = require("./bs_internalBucketsType.js"); + +function insert_bucket(h_buckets, ndata_tail, _, _old_bucket) { + while(true) { + var old_bucket = _old_bucket; + if (old_bucket !== undefined) { + var s = old_bucket.key; + var nidx = Caml_hash.caml_hash_final_mix(Caml_hash.caml_hash_mix_int(0, s)) & (h_buckets.length - 1 | 0); + var match = ndata_tail[nidx]; + if (match !== undefined) { + match.next = old_bucket; + } else { + h_buckets[nidx] = old_bucket; + } + ndata_tail[nidx] = old_bucket; + _old_bucket = old_bucket.next; + continue ; + + } else { + return /* () */0; + } + }; +} + +function resize(h) { + var odata = h.buckets; + var osize = odata.length; + var nsize = (osize << 1); + if (nsize >= osize) { + var h_buckets = new Array(nsize); + var ndata_tail = new Array(nsize); + h.buckets = h_buckets; + for(var i = 0 ,i_finish = osize - 1 | 0; i <= i_finish; ++i){ + insert_bucket(h_buckets, ndata_tail, h, odata[i]); + } + for(var i$1 = 0 ,i_finish$1 = nsize - 1 | 0; i$1 <= i_finish$1; ++i$1){ + var match = ndata_tail[i$1]; + if (match !== undefined) { + match.next = Bs_internalBucketsType.emptyOpt; + } + + } + return /* () */0; + } else { + return 0; + } +} + +function remove(h, key) { + var h_buckets = h.buckets; + var i = Caml_hash.caml_hash_final_mix(Caml_hash.caml_hash_mix_int(0, key)) & (h_buckets.length - 1 | 0); + var l = h_buckets[i]; + if (l !== undefined) { + var next_cell = l.next; + if (l.key === key) { + h.size = h.size - 1 | 0; + h_buckets[i] = next_cell; + return /* () */0; + } else if (next_cell !== undefined) { + var h$1 = h; + var key$1 = key; + var _prec = l; + var _cell = next_cell; + while(true) { + var cell = _cell; + var prec = _prec; + var cell_next = cell.next; + if (cell.key === key$1) { + prec.next = cell_next; + h$1.size = h$1.size - 1 | 0; + return /* () */0; + } else if (cell_next !== undefined) { + _cell = cell_next; + _prec = cell; + continue ; + + } else { + return /* () */0; + } + }; + } else { + return /* () */0; + } + } else { + return /* () */0; + } +} + +function add(h, key) { + var h_buckets = h.buckets; + var buckets_len = h_buckets.length; + var i = Caml_hash.caml_hash_final_mix(Caml_hash.caml_hash_mix_int(0, key)) & (buckets_len - 1 | 0); + var l = h_buckets[i]; + if (l !== undefined) { + var h$1 = h; + var buckets_len$1 = buckets_len; + var key$1 = key; + var _cell = l; + while(true) { + var cell = _cell; + if (cell.key !== key$1) { + var n = cell.next; + if (n !== undefined) { + _cell = n; + continue ; + + } else { + h$1.size = h$1.size + 1 | 0; + cell.next = { + key: key$1, + next: n + }; + if (h$1.size > (buckets_len$1 << 1)) { + return resize(h$1); + } else { + return 0; + } + } + } else { + return 0; + } + }; + } else { + h_buckets[i] = { + key: key, + next: Bs_internalBucketsType.emptyOpt + }; + h.size = h.size + 1 | 0; + if (h.size > (buckets_len << 1)) { + return resize(h); + } else { + return 0; + } + } +} + +function mem(h, key) { + var h_buckets = h.buckets; + var nid = Caml_hash.caml_hash_final_mix(Caml_hash.caml_hash_mix_int(0, key)) & (h_buckets.length - 1 | 0); + var bucket = h_buckets[nid]; + if (bucket !== undefined) { + var key$1 = key; + var _cell = bucket; + while(true) { + var cell = _cell; + if (cell.key === key$1) { + return /* true */1; + } else { + var match = cell.next; + if (match !== undefined) { + _cell = match; + continue ; + + } else { + return /* false */0; + } + } + }; + } else { + return /* false */0; + } +} + +function ofArray(arr) { + var len = arr.length; + var v = Bs_internalBucketsType.create0(len); + for(var i = 0 ,i_finish = len - 1 | 0; i <= i_finish; ++i){ + add(v, arr[i]); + } + return v; +} + +var create = Bs_internalBucketsType.create0; + +var clear = Bs_internalBucketsType.clear0; + +var reset = Bs_internalBucketsType.reset0; + +var iter = Bs_internalSetBuckets.iter0; + +var fold = Bs_internalSetBuckets.fold0; + +var length = Bs_internalBucketsType.length0; + +var logStats = Bs_internalSetBuckets.logStats0; + +var toArray = Bs_internalSetBuckets.toArray0; + +exports.create = create; +exports.clear = clear; +exports.reset = reset; +exports.add = add; +exports.mem = mem; +exports.remove = remove; +exports.iter = iter; +exports.fold = fold; +exports.length = length; +exports.logStats = logStats; +exports.toArray = toArray; +exports.ofArray = ofArray; +/* Bs_internalBucketsType Not a pure module */ diff --git a/lib/js/bs_HashSetString.js b/lib/js/bs_HashSetString.js new file mode 100644 index 00000000000..a88a93f7795 --- /dev/null +++ b/lib/js/bs_HashSetString.js @@ -0,0 +1,205 @@ +'use strict'; + +var Caml_hash = require("./caml_hash.js"); +var Bs_internalSetBuckets = require("./bs_internalSetBuckets.js"); +var Bs_internalBucketsType = require("./bs_internalBucketsType.js"); + +function insert_bucket(h_buckets, ndata_tail, _, _old_bucket) { + while(true) { + var old_bucket = _old_bucket; + if (old_bucket !== undefined) { + var s = old_bucket.key; + var nidx = Caml_hash.caml_hash_final_mix(Caml_hash.caml_hash_mix_string(0, s)) & (h_buckets.length - 1 | 0); + var match = ndata_tail[nidx]; + if (match !== undefined) { + match.next = old_bucket; + } else { + h_buckets[nidx] = old_bucket; + } + ndata_tail[nidx] = old_bucket; + _old_bucket = old_bucket.next; + continue ; + + } else { + return /* () */0; + } + }; +} + +function resize(h) { + var odata = h.buckets; + var osize = odata.length; + var nsize = (osize << 1); + if (nsize >= osize) { + var h_buckets = new Array(nsize); + var ndata_tail = new Array(nsize); + h.buckets = h_buckets; + for(var i = 0 ,i_finish = osize - 1 | 0; i <= i_finish; ++i){ + insert_bucket(h_buckets, ndata_tail, h, odata[i]); + } + for(var i$1 = 0 ,i_finish$1 = nsize - 1 | 0; i$1 <= i_finish$1; ++i$1){ + var match = ndata_tail[i$1]; + if (match !== undefined) { + match.next = Bs_internalBucketsType.emptyOpt; + } + + } + return /* () */0; + } else { + return 0; + } +} + +function remove(h, key) { + var h_buckets = h.buckets; + var i = Caml_hash.caml_hash_final_mix(Caml_hash.caml_hash_mix_string(0, key)) & (h_buckets.length - 1 | 0); + var l = h_buckets[i]; + if (l !== undefined) { + var next_cell = l.next; + if (l.key === key) { + h.size = h.size - 1 | 0; + h_buckets[i] = next_cell; + return /* () */0; + } else if (next_cell !== undefined) { + var h$1 = h; + var key$1 = key; + var _prec = l; + var _cell = next_cell; + while(true) { + var cell = _cell; + var prec = _prec; + var cell_next = cell.next; + if (cell.key === key$1) { + prec.next = cell_next; + h$1.size = h$1.size - 1 | 0; + return /* () */0; + } else if (cell_next !== undefined) { + _cell = cell_next; + _prec = cell; + continue ; + + } else { + return /* () */0; + } + }; + } else { + return /* () */0; + } + } else { + return /* () */0; + } +} + +function add(h, key) { + var h_buckets = h.buckets; + var buckets_len = h_buckets.length; + var i = Caml_hash.caml_hash_final_mix(Caml_hash.caml_hash_mix_string(0, key)) & (buckets_len - 1 | 0); + var l = h_buckets[i]; + if (l !== undefined) { + var h$1 = h; + var buckets_len$1 = buckets_len; + var key$1 = key; + var _cell = l; + while(true) { + var cell = _cell; + if (cell.key !== key$1) { + var n = cell.next; + if (n !== undefined) { + _cell = n; + continue ; + + } else { + h$1.size = h$1.size + 1 | 0; + cell.next = { + key: key$1, + next: n + }; + if (h$1.size > (buckets_len$1 << 1)) { + return resize(h$1); + } else { + return 0; + } + } + } else { + return 0; + } + }; + } else { + h_buckets[i] = { + key: key, + next: Bs_internalBucketsType.emptyOpt + }; + h.size = h.size + 1 | 0; + if (h.size > (buckets_len << 1)) { + return resize(h); + } else { + return 0; + } + } +} + +function mem(h, key) { + var h_buckets = h.buckets; + var nid = Caml_hash.caml_hash_final_mix(Caml_hash.caml_hash_mix_string(0, key)) & (h_buckets.length - 1 | 0); + var bucket = h_buckets[nid]; + if (bucket !== undefined) { + var key$1 = key; + var _cell = bucket; + while(true) { + var cell = _cell; + if (cell.key === key$1) { + return /* true */1; + } else { + var match = cell.next; + if (match !== undefined) { + _cell = match; + continue ; + + } else { + return /* false */0; + } + } + }; + } else { + return /* false */0; + } +} + +function ofArray(arr) { + var len = arr.length; + var v = Bs_internalBucketsType.create0(len); + for(var i = 0 ,i_finish = len - 1 | 0; i <= i_finish; ++i){ + add(v, arr[i]); + } + return v; +} + +var create = Bs_internalBucketsType.create0; + +var clear = Bs_internalBucketsType.clear0; + +var reset = Bs_internalBucketsType.reset0; + +var iter = Bs_internalSetBuckets.iter0; + +var fold = Bs_internalSetBuckets.fold0; + +var length = Bs_internalBucketsType.length0; + +var logStats = Bs_internalSetBuckets.logStats0; + +var toArray = Bs_internalSetBuckets.toArray0; + +exports.create = create; +exports.clear = clear; +exports.reset = reset; +exports.add = add; +exports.mem = mem; +exports.remove = remove; +exports.iter = iter; +exports.fold = fold; +exports.length = length; +exports.logStats = logStats; +exports.toArray = toArray; +exports.ofArray = ofArray; +/* Bs_internalBucketsType Not a pure module */ diff --git a/lib/js/bs_Set.js b/lib/js/bs_Set.js index 1bcd608b6fc..9784f4d221c 100644 --- a/lib/js/bs_Set.js +++ b/lib/js/bs_Set.js @@ -317,6 +317,10 @@ function elements(m) { return Bs_internalAVLset.elements0(m.data); } +function toArray(m) { + return Bs_internalAVLset.toArray0(m.data); +} + function min(m) { return Bs_internalAVLset.min0(m.data); } @@ -364,6 +368,8 @@ var cardinal0 = Bs_internalAVLset.cardinal0; var elements0 = Bs_internalAVLset.elements0; +var toArray0 = Bs_internalAVLset.toArray0; + var min0 = Bs_internalAVLset.min0; var max0 = Bs_internalAVLset.max0; @@ -404,6 +410,8 @@ exports.cardinal0 = cardinal0; exports.cardinal = cardinal; exports.elements0 = elements0; exports.elements = elements; +exports.toArray0 = toArray0; +exports.toArray = toArray; exports.min0 = min0; exports.min = min; exports.max0 = max0; diff --git a/lib/js/bs_SetInt.js b/lib/js/bs_SetInt.js index a977f753e18..2df400565b3 100644 --- a/lib/js/bs_SetInt.js +++ b/lib/js/bs_SetInt.js @@ -347,6 +347,8 @@ var cardinal = Bs_internalAVLset.cardinal0; var elements = Bs_internalAVLset.elements0; +var toArray = Bs_internalAVLset.toArray0; + var min = Bs_internalAVLset.min0; var max = Bs_internalAVLset.max0; @@ -373,6 +375,7 @@ exports.filter = filter; exports.partition = partition; exports.cardinal = cardinal; exports.elements = elements; +exports.toArray = toArray; exports.min = min; exports.max = max; exports.split = split; diff --git a/lib/js/bs_SetString.js b/lib/js/bs_SetString.js index a977f753e18..2df400565b3 100644 --- a/lib/js/bs_SetString.js +++ b/lib/js/bs_SetString.js @@ -347,6 +347,8 @@ var cardinal = Bs_internalAVLset.cardinal0; var elements = Bs_internalAVLset.elements0; +var toArray = Bs_internalAVLset.toArray0; + var min = Bs_internalAVLset.min0; var max = Bs_internalAVLset.max0; @@ -373,6 +375,7 @@ exports.filter = filter; exports.partition = partition; exports.cardinal = cardinal; exports.elements = elements; +exports.toArray = toArray; exports.min = min; exports.max = max; exports.split = split; diff --git a/lib/js/bs_internalAVLset.js b/lib/js/bs_internalAVLset.js index 3201e47815b..cf481d7d0c3 100644 --- a/lib/js/bs_internalAVLset.js +++ b/lib/js/bs_internalAVLset.js @@ -402,6 +402,38 @@ function checkInvariant(_v) { }; } +function fillArray(_n, _i, arr) { + while(true) { + var i = _i; + var n = _n; + var l = n.left; + var v = n.key; + var r = n.right; + var next = l !== null ? fillArray(l, i, arr) : i; + arr[next] = v; + var rnext = next + 1 | 0; + if (r !== null) { + _i = rnext; + _n = r; + continue ; + + } else { + return rnext; + } + }; +} + +function toArray0(n) { + if (n !== null) { + var size = cardinalAux(n); + var v = new Array(size); + fillArray(n, 0, v); + return v; + } else { + return /* array */[]; + } +} + exports.height = height; exports.create = create; exports.bal = bal; @@ -430,4 +462,6 @@ exports.cardinal0 = cardinal0; exports.elements_aux = elements_aux; exports.elements0 = elements0; exports.checkInvariant = checkInvariant; +exports.fillArray = fillArray; +exports.toArray0 = toArray0; /* empty0 Not a pure module */ diff --git a/lib/js/bs_internalBuckets.js b/lib/js/bs_internalBuckets.js index 24e2b4b8c34..e587c8041ab 100644 --- a/lib/js/bs_internalBuckets.js +++ b/lib/js/bs_internalBuckets.js @@ -1,60 +1,32 @@ 'use strict'; -var Bs_Array = require("./bs_Array.js"); -var Caml_array = require("./caml_array.js"); +var Bs_Array = require("./bs_Array.js"); +var Caml_array = require("./caml_array.js"); +var Bs_internalBucketsType = require("./bs_internalBucketsType.js"); -var emptyOpt = undefined; - -function power_2_above(_x, n) { +function bucket_length(_accu, _buckets) { while(true) { - var x = _x; - if (x >= n) { - return x; - } else if ((x << 1) < x) { - return x; - } else { - _x = (x << 1); + var buckets = _buckets; + var accu = _accu; + if (buckets !== undefined) { + _buckets = buckets.next; + _accu = accu + 1 | 0; continue ; + } else { + return accu; } }; } -function create0(initial_size) { - var s = power_2_above(16, initial_size); - return { - size: 0, - buckets: new Array(s), - initial_size: s - }; -} - -function clear0(h) { - h.size = 0; - var h_buckets = h.buckets; - var len = h_buckets.length; - for(var i = 0 ,i_finish = len - 1 | 0; i <= i_finish; ++i){ - h_buckets[i] = emptyOpt; - } - return /* () */0; -} - -function reset0(h) { - var len = h.buckets.length; - var h_initial_size = h.initial_size; - if (len === h_initial_size) { - return clear0(h); +function max(m, n) { + if (m > n) { + return m; } else { - h.size = 0; - h.buckets = new Array(h_initial_size); - return /* () */0; + return n; } } -function length0(h) { - return h.size; -} - function do_bucket_iter(f, _buckets) { while(true) { var buckets = _buckets; @@ -101,29 +73,6 @@ function fold0(f, h, init) { return accu; } -function bucket_length(_accu, _buckets) { - while(true) { - var buckets = _buckets; - var accu = _accu; - if (buckets !== undefined) { - _buckets = buckets.next; - _accu = accu + 1 | 0; - continue ; - - } else { - return accu; - } - }; -} - -function max(m, n) { - if (m > n) { - return m; - } else { - return n; - } -} - function logStats0(h) { var mbl = Bs_Array.foldLeft((function (m, b) { return max(m, bucket_length(0, b)); @@ -143,35 +92,41 @@ function logStats0(h) { return /* () */0; } -function filterMapInplaceBucket(f, h, i, _prec, _bucket) { +function filterMapInplaceBucket(f, h, i, _prec, _cell) { while(true) { - var bucket = _bucket; + var cell = _cell; var prec = _prec; - if (bucket !== undefined) { - var match = f(bucket.key, bucket.value); - if (match) { - if (prec !== undefined) { - bucket.next = bucket; - } else { - h.buckets[i] = bucket; - } - bucket.value = match[0]; - _bucket = bucket.next; - _prec = bucket; + var n = cell.next; + var match = f(cell.key, cell.value); + if (match) { + if (prec !== undefined) { + cell.next = cell; + } else { + h.buckets[i] = cell; + } + cell.value = match[0]; + if (n !== undefined) { + _cell = n; + _prec = cell; continue ; } else { - h.size = h.size - 1 | 0; - _bucket = bucket.next; + cell.next = n; + return /* () */0; + } + } else { + h.size = h.size - 1 | 0; + if (n !== undefined) { + _cell = n; continue ; + } else if (prec !== undefined) { + prec.next = n; + return /* () */0; + } else { + h.buckets[i] = prec; + return /* () */0; } - } else if (prec !== undefined) { - prec.next = emptyOpt; - return /* () */0; - } else { - h.buckets[i] = emptyOpt; - return /* () */0; } }; } @@ -179,24 +134,25 @@ function filterMapInplaceBucket(f, h, i, _prec, _bucket) { function filterMapInplace0(f, h) { var h_buckets = h.buckets; for(var i = 0 ,i_finish = h_buckets.length - 1 | 0; i <= i_finish; ++i){ - filterMapInplaceBucket(f, h, i, emptyOpt, h_buckets[i]); + var v = h_buckets[i]; + if (v !== undefined) { + filterMapInplaceBucket(f, h, i, Bs_internalBucketsType.emptyOpt, v); + } + } return /* () */0; } -exports.emptyOpt = emptyOpt; -exports.power_2_above = power_2_above; -exports.create0 = create0; -exports.clear0 = clear0; -exports.reset0 = reset0; -exports.length0 = length0; +var C = 0; + +exports.C = C; +exports.bucket_length = bucket_length; +exports.max = max; exports.do_bucket_iter = do_bucket_iter; exports.iter0 = iter0; exports.do_bucket_fold = do_bucket_fold; exports.fold0 = fold0; -exports.bucket_length = bucket_length; -exports.max = max; exports.logStats0 = logStats0; exports.filterMapInplaceBucket = filterMapInplaceBucket; exports.filterMapInplace0 = filterMapInplace0; -/* emptyOpt Not a pure module */ +/* Bs_internalBucketsType Not a pure module */ diff --git a/lib/js/bs_internalBucketsType.js b/lib/js/bs_internalBucketsType.js new file mode 100644 index 00000000000..b122ab83e48 --- /dev/null +++ b/lib/js/bs_internalBucketsType.js @@ -0,0 +1,62 @@ +'use strict'; + + +var emptyOpt = undefined; + +function power_2_above(_x, n) { + while(true) { + var x = _x; + if (x >= n) { + return x; + } else if ((x << 1) < x) { + return x; + } else { + _x = (x << 1); + continue ; + + } + }; +} + +function create0(initialSize) { + var s = power_2_above(16, initialSize); + return { + size: 0, + buckets: new Array(s), + initialSize: s + }; +} + +function clear0(h) { + h.size = 0; + var h_buckets = h.buckets; + var len = h_buckets.length; + for(var i = 0 ,i_finish = len - 1 | 0; i <= i_finish; ++i){ + h_buckets[i] = emptyOpt; + } + return /* () */0; +} + +function reset0(h) { + var len = h.buckets.length; + var h_initialSize = h.initialSize; + if (len === h_initialSize) { + return clear0(h); + } else { + h.size = 0; + h.buckets = new Array(h_initialSize); + return /* () */0; + } +} + +function length0(h) { + return h.size; +} + +exports.emptyOpt = emptyOpt; +exports.power_2_above = power_2_above; +exports.create0 = create0; +exports.clear0 = clear0; +exports.reset0 = reset0; +exports.length0 = length0; +/* emptyOpt Not a pure module */ diff --git a/lib/js/bs_internalSetBuckets.js b/lib/js/bs_internalSetBuckets.js new file mode 100644 index 00000000000..eabe52027a5 --- /dev/null +++ b/lib/js/bs_internalSetBuckets.js @@ -0,0 +1,137 @@ +'use strict'; + +var Bs_Array = require("./bs_Array.js"); +var Caml_array = require("./caml_array.js"); + +function bucket_length(_accu, _buckets) { + while(true) { + var buckets = _buckets; + var accu = _accu; + if (buckets !== undefined) { + _buckets = buckets.next; + _accu = accu + 1 | 0; + continue ; + + } else { + return accu; + } + }; +} + +function max(m, n) { + if (m > n) { + return m; + } else { + return n; + } +} + +function do_bucket_iter(f, _buckets) { + while(true) { + var buckets = _buckets; + if (buckets !== undefined) { + f(buckets.key); + _buckets = buckets.next; + continue ; + + } else { + return /* () */0; + } + }; +} + +function iter0(f, h) { + var d = h.buckets; + for(var i = 0 ,i_finish = d.length - 1 | 0; i <= i_finish; ++i){ + do_bucket_iter(f, d[i]); + } + return /* () */0; +} + +function fillArray(_i, arr, _cell) { + while(true) { + var cell = _cell; + var i = _i; + arr[i] = cell.key; + var match = cell.next; + if (match !== undefined) { + _cell = match; + _i = i + 1 | 0; + continue ; + + } else { + return i + 1 | 0; + } + }; +} + +function toArray0(h) { + var d = h.buckets; + var current = 0; + var arr = new Array(h.size); + for(var i = 0 ,i_finish = d.length - 1 | 0; i <= i_finish; ++i){ + var cell = d[i]; + if (cell !== undefined) { + current = fillArray(current, arr, cell); + } + + } + return arr; +} + +function do_bucket_fold(f, _b, _accu) { + while(true) { + var accu = _accu; + var b = _b; + if (b !== undefined) { + _accu = f(b.key, accu); + _b = b.next; + continue ; + + } else { + return accu; + } + }; +} + +function fold0(f, h, init) { + var d = h.buckets; + var accu = init; + for(var i = 0 ,i_finish = d.length - 1 | 0; i <= i_finish; ++i){ + accu = do_bucket_fold(f, d[i], accu); + } + return accu; +} + +function logStats0(h) { + var mbl = Bs_Array.foldLeft((function (m, b) { + return max(m, bucket_length(0, b)); + }), 0, h.buckets); + var histo = Caml_array.caml_make_vect(mbl + 1 | 0, 0); + Bs_Array.iter((function (b) { + var l = bucket_length(0, b); + histo[l] = histo[l] + 1 | 0; + return /* () */0; + }), h.buckets); + console.log({ + num_bindings: h.size, + num_buckets: h.buckets.length, + max_bucket_length: mbl, + bucket_histogram: histo + }); + return /* () */0; +} + +var C = 0; + +exports.C = C; +exports.bucket_length = bucket_length; +exports.max = max; +exports.do_bucket_iter = do_bucket_iter; +exports.iter0 = iter0; +exports.fillArray = fillArray; +exports.toArray0 = toArray0; +exports.do_bucket_fold = do_bucket_fold; +exports.fold0 = fold0; +exports.logStats0 = logStats0; +/* No side effect */