From 56b1290161d3cbd6cea266f615c2c9df15c1e8d9 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Fri, 22 Dec 2017 10:55:42 +0800 Subject: [PATCH 1/7] stack safe list --- jscomp/others/.depend | 3 + jscomp/others/Makefile | 3 + jscomp/others/bs.ml | 3 +- jscomp/others/bs_LinkList.ml | 115 ++ jscomp/others/bs_List.ml | 561 ++++++++ jscomp/others/bs_internalLinkList.ml | 33 + jscomp/others/tmpLinkList.mli | 235 ++++ jscomp/test/.depend | 1 + jscomp/test/Makefile | 1 + jscomp/test/bs_link_list_test.js | 146 ++ jscomp/test/bs_link_list_test.ml | 51 + lib/js/bs.js | 6 + lib/js/bs_LinkList.js | 207 +++ lib/js/bs_List.js | 1834 ++++++++++++++++++++++++++ lib/js/bs_internalLinkList.js | 1 + 15 files changed, 3199 insertions(+), 1 deletion(-) create mode 100644 jscomp/others/bs_LinkList.ml create mode 100644 jscomp/others/bs_List.ml create mode 100644 jscomp/others/bs_internalLinkList.ml create mode 100644 jscomp/others/tmpLinkList.mli create mode 100644 jscomp/test/bs_link_list_test.js create mode 100644 jscomp/test/bs_link_list_test.ml create mode 100644 lib/js/bs_LinkList.js create mode 100644 lib/js/bs_List.js create mode 100644 lib/js/bs_internalLinkList.js diff --git a/jscomp/others/.depend b/jscomp/others/.depend index 6ff549ebed..36e7d90338 100644 --- a/jscomp/others/.depend +++ b/jscomp/others/.depend @@ -22,6 +22,9 @@ 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_internalLinkList.cmj : +bs_LinkList.cmj : bs_Array.cmj bs.cmj +bs_List.cmj : bs_Array.cmj 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 diff --git a/jscomp/others/Makefile b/jscomp/others/Makefile index 76842fa137..5ef78fc7b7 100644 --- a/jscomp/others/Makefile +++ b/jscomp/others/Makefile @@ -17,6 +17,9 @@ SOURCE_LIST= node_path node_fs node_process dict node_module js_array js_string bs_internalMutableAVL\ bs_Hash\ bs_Queue\ + bs_internalLinkList\ + bs_LinkList\ + bs_List\ bs_internalBucketsType\ bs_internalSetBuckets\ bs_internalBuckets\ diff --git a/jscomp/others/bs.ml b/jscomp/others/bs.ml index 7090267290..894a6a63bd 100644 --- a/jscomp/others/bs.ml +++ b/jscomp/others/bs.ml @@ -43,5 +43,6 @@ module MapInt = Bs_MapInt module MapString = Bs_MapString module SetInt = Bs_SetInt module SetString = Bs_SetString - +module LinkList = Bs_LinkList +module List = Bs_List diff --git a/jscomp/others/bs_LinkList.ml b/jscomp/others/bs_LinkList.ml new file mode 100644 index 0000000000..0d00f72267 --- /dev/null +++ b/jscomp/others/bs_LinkList.ml @@ -0,0 +1,115 @@ + + +type 'a cell = { + mutable head : 'a; + mutable tail : 'a opt_cell +} + +and 'a opt_cell = 'a cell Js.null + +and 'a t = { + length : int ; + data : 'a opt_cell +} [@@bs.deriving abstract] + + +external assertAsNonNull : 'a Js.null -> 'a = "%identity" +external tailOption : 'a cell -> 'a cell option = "tail" [@@bs.get] [@@bs.return null_to_opt] + +let toOpt = Js.nullToOption +let return = Js.Null.return +let empty = Js.Null.empty + +let headOpt ( x : _ t) = + toOpt (data x) + +let tailOpt (x : _ t) = + match toOpt (data x ) with + | None -> None + | Some x -> tailOption x + +let rec lengthCellAux (x : _ opt_cell) acc = + match toOpt x with + | None -> acc + | Some x -> lengthCellAux (tail x) (acc + 1) + +let checkInvariant (x : _ t) : unit = + [%assert length x = lengthCellAux ( data x ) 0] + +let rec nextAuxAssert (opt_cell : 'a opt_cell) n = + let cell = (assertAsNonNull opt_cell) in + if n = 0 then + (head cell) + else + nextAuxAssert (tail cell) (n - 1) + +let nthOpt x n = + if n < 0 then None + else if n < (length x) then + Some (nextAuxAssert (data x) n) + else + None + +let nthAssert x n = + if n < 0 then [%assert "Neg"] + else nextAuxAssert (data x) n + +let rec copyAux (cellX : _ opt_cell) (prec : _ cell) = + match toOpt cellX with + | None -> prec + | Some cellX -> + let h, t = head cellX, tail cellX in + let next = cell ~head:h ~tail:empty in + tailSet prec (return next); + copyAux t next + +let copyNonEmptyTo xs ys = + let cell = cell ~head:(head xs) ~tail:empty in + let newTail = copyAux (tail xs) cell in + tailSet newTail ys; + cell + +let append (x : 'a t) (y : 'a t) : 'a t = + let lenX = length x in + if lenX = 0 then y + else + let lenY = length y in + if lenY = 0 then x + else + let h = assertAsNonNull (data x) in + (* let cell = cell ~head:(head h) ~tail:empty in + let newTail = copyAux (tail h) cell in + tailSet newTail (data y) ; *) + let cell = copyNonEmptyTo h (data y) in + t ~length:(lenX + lenY) ~data:(return cell ) + + +let init n f = + if n < 0 then [%assert "Invalid_argument"] + else + if n = 0 then + t ~length:0 ~data:empty (* TODO could be shared *) + else + let headX = (cell ~head:(f 0 [@bs]) ~tail:empty) in + let cur = ref headX in + let i = ref 1 in + while !i < n do + let v = cell ~head:(f !i [@bs]) ~tail:empty in + tailSet !cur (return v); + cur := v; + incr i; + done ; + t ~length:n ~data:(return headX) + +let rec fillAux arr i (cell_opt : _ opt_cell) = + match toOpt cell_opt with + | None -> () + | Some x -> + Bs_Array.unsafe_set arr i (head x) ; + fillAux arr (i + 1) (tail x) + +let toArray (x : _ t) = + let len = length x in + let arr = Bs.Array.makeUninitializedUnsafe len in + fillAux arr 0 (data x); + arr \ No newline at end of file diff --git a/jscomp/others/bs_List.ml b/jscomp/others/bs_List.ml new file mode 100644 index 0000000000..d42289c888 --- /dev/null +++ b/jscomp/others/bs_List.ml @@ -0,0 +1,561 @@ + + +(* + perf is not everything, there are better memory represenations + {[ + type 'a cell = { + mutable head : 'a; + mutable tail : 'a opt_cell + } + + and 'a opt_cell = 'a cell Js.null + + and 'a t = { + length : int ; + data : 'a opt_cell + } + ]} + However, + - people use List not because of its perf, but its + convenencie, in that case, pattern match and compatibility seems + more attractive, we could keep a mutable list + - The built in types would indicate that + its construtor is immutable, a better optimizer would break such code + + {[ + type 'a t = { + head : 'a; + mutable tail : 'a t | int + } + ]} + In the future, we could come up with a safer version + {[ + type 'a t = + | Nil + | Cons of { hd : 'a ; mutable tail : 'a t } + ]} +*) + +type 'a t = 'a list + +external mutableCell : 'a -> 'a t = "%makemutable" + +(* + [mutableCell x] == [x] + but tell the compiler that is a mutable cell, so it wont + be mis-inlined in the future +*) + +let headOpt x = + match x with + | [] -> None + | x::_ -> Some x + +let tailOpt x = + match x with + | [] -> None + | _::xs -> Some xs + +(* Assume [n >=0] *) +let rec nthAux x n = + match x with + | h::t -> if n = 0 then Some h else nthAux t (n - 1) + | _ -> None + +let rec nthAuxAssert x n = + match x with + | h::t -> if n = 0 then h else nthAuxAssert t (n - 1) + | _ -> [%assert "nthAssert"] + +let nthOpt x n = + if n < 0 then None + else nthAux x n + +let nthAssert x n = + if n < 0 then [%assert "nthAssert"] + else nthAuxAssert x n + +(* return the tail *) +let rec copyAux cellX prec = + match cellX with + | [] -> prec + | h::t -> + let next = mutableCell h in + Obj.set_field (Obj.repr prec) 1 (Obj.repr next); + copyAux t next + +let rec copyAuxWithMap f cellX prec = + match cellX with + | [] -> Obj.set_field (Obj.repr prec) 1 (Obj.repr []) + | h::t -> + let next = mutableCell (f h [@bs]) in + Obj.set_field (Obj.repr prec) 1 (Obj.repr next); + copyAuxWithMap f t next + +let rec copyAuxWithMapI f i cellX prec = + match cellX with + | [] -> Obj.set_field (Obj.repr prec) 1 (Obj.repr []) + | h::t -> + let next = mutableCell (f i h [@bs]) in + Obj.set_field (Obj.repr prec) 1 (Obj.repr next); + copyAuxWithMapI f (i + 1) t next + +let append xs ys = + match xs with + | [] -> ys + | h::t -> + let cell = mutableCell h in + Obj.set_field (Obj.repr @@ copyAux t cell) 1 (Obj.repr ys); + cell + +let map xs f = + match xs with + | [] -> [] + | h::t -> + let cell = mutableCell (f h [@bs]) in + copyAuxWithMap f t cell; + cell + + +let rec mapi f = function + [] -> [] + | h::t -> + let cell = mutableCell (f 0 h [@bs]) in + copyAuxWithMapI f 1 t cell; + cell + + + + +let init n f = + if n < 0 then [%assert "Invalid_argument"] + else + if n = 0 then [] + else + let headX = mutableCell (f 0 [@bs]) in + let cur = ref headX in + let i = ref 1 in + while !i < n do + let v = mutableCell (f !i [@bs]) in + Obj.set_field (Obj.repr !cur) 1 (Obj.repr v) ; + cur := v ; + incr i ; + done + ; + headX + +let rec lengthAux x acc = + match x with + | [] -> acc + | _::t -> lengthAux t (acc + 1) + +let length xs = lengthAux xs 0 + +let rec fillAux arr i x = + match x with + | [] -> () + | h::t -> + Bs_Array.unsafe_set arr i h ; + fillAux arr (i + 1) t + +let toArray ( x : _ t) = + let len = length x in + let arr = Bs_Array.makeUninitializedUnsafe len in + fillAux arr 0 x; + arr + + +let rec revAppend l1 l2 = + match l1 with + [] -> l2 + | a :: l -> revAppend l (a :: l2) + +let rev l = revAppend l [] + +let rec flattenAux prec xs = + match xs with + | [] -> Obj.set_field (Obj.repr prec) 1 (Obj.repr []) + | h::r -> flattenAux (copyAux h prec) r + + +let rec flatten xs = + match xs with + | [] -> [] + | []::xs -> flatten xs + | (h::t):: r -> + let cell = mutableCell h in + flattenAux (copyAux t cell) r ; + cell + + + + + + +let rev_map f l = + let rec rmap_f accu = function + | [] -> accu + | a::l -> rmap_f (f a [@bs] :: accu) l + in + rmap_f [] l +;; + +let rec iter f = function + [] -> () + | a::l -> f a [@bs]; iter f l + +let rec iteri i f = function + [] -> () + | a::l -> f i a [@bs]; iteri (i + 1) f l + +let iteri f l = iteri 0 f l + +let rec fold_left f accu l = + match l with + [] -> accu + | a::l -> fold_left f (f accu a [@bs]) l + +let rec fold_right f l accu = + match l with + [] -> accu + | a::l -> f a (fold_right f l accu) [@bs] + +let rec map2 f l1 l2 = + match (l1, l2) with + ([], []) -> [] + | (a1::l1, a2::l2) -> let r = f a1 a2 [@bs] in r :: map2 f l1 l2 + | (_, _) -> invalid_arg "List.map2" + +let rev_map2 f l1 l2 = + let rec rmap2_f accu l1 l2 = + match (l1, l2) with + | ([], []) -> accu + | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 [@bs]:: accu) l1 l2 + | (_, _) -> invalid_arg "List.rev_map2" + in + rmap2_f [] l1 l2 +;; + +let rec iter2 f l1 l2 = + match (l1, l2) with + ([], []) -> () + | (a1::l1, a2::l2) -> f a1 a2 [@bs]; iter2 f l1 l2 + | (_, _) -> invalid_arg "List.iter2" + +let rec fold_left2 f accu l1 l2 = + match (l1, l2) with + ([], []) -> accu + | (a1::l1, a2::l2) -> fold_left2 f (f accu a1 a2 [@bs]) l1 l2 + | (_, _) -> invalid_arg "List.fold_left2" + +let rec fold_right2 f l1 l2 accu = + match (l1, l2) with + ([], []) -> accu + | (a1::l1, a2::l2) -> f a1 a2 (fold_right2 f l1 l2 accu) [@bs] + | (_, _) -> invalid_arg "List.fold_right2" + +let rec for_all p = function + [] -> true + | a::l -> p a [@bs] && for_all p l + +let rec exists p = function + [] -> false + | a::l -> p a [@bs] || exists p l + +let rec for_all2 p l1 l2 = + match (l1, l2) with + ([], []) -> true + | (a1::l1, a2::l2) -> p a1 a2 [@bs] && for_all2 p l1 l2 + | (_, _) -> invalid_arg "List.for_all2" + +let rec exists2 p l1 l2 = + match (l1, l2) with + ([], []) -> false + | (a1::l1, a2::l2) -> p a1 a2 [@bs] || exists2 p l1 l2 + | (_, _) -> invalid_arg "List.exists2" + +let rec mem eq x = function + [] -> false + | a::l -> eq a x [@bs] || mem eq x l + +let rec memq x = function + [] -> false + | a::l -> a == x || memq x l + +let rec assoc eq x = function + [] -> raise Not_found + | (a,b)::l -> if eq a x [@bs] then b else assoc eq x l + +let rec assq x = function + [] -> raise Not_found + | (a,b)::l -> if a == x then b else assq x l + +let rec mem_assoc eq x = function + | [] -> false + | (a, b) :: l -> eq a x [@bs] || mem_assoc eq x l + +let rec mem_assq x = function + | [] -> false + | (a, b) :: l -> a == x || mem_assq x l + +let rec remove_assoc eq x = function + | [] -> [] + | (a, b as pair) :: l -> + if eq a x [@bs] then l else pair :: remove_assoc eq x l + +let rec remove_assq x = function + | [] -> [] + | (a, b as pair) :: l -> if a == x then l else pair :: remove_assq x l + +let rec find p = function + | [] -> raise Not_found + | x :: l -> if p x [@bs] then x else find p l + +let find_all p = + let rec find accu = function + | [] -> rev accu + | x :: l -> if p x [@bs] then find (x :: accu) l else find accu l in + find [] + +let filter = find_all + +let partition p l = + let rec part yes no = function + | [] -> (rev yes, rev no) + | x :: l -> if p x [@bs] then part (x :: yes) no l else part yes (x :: no) l in + part [] [] l + +let rec split = function + [] -> ([], []) + | (x,y)::l -> + let (rx, ry) = split l in (x::rx, y::ry) + +let rec combine l1 l2 = + match (l1, l2) with + ([], []) -> [] + | (a1::l1, a2::l2) -> (a1, a2) :: combine l1 l2 + | (_, _) -> invalid_arg "List.combine" + +(** sorting *) + +let rec merge cmp l1 l2 = + match l1, l2 with + | [], l2 -> l2 + | l1, [] -> l1 + | h1 :: t1, h2 :: t2 -> + if cmp h1 h2 [@bs] <= 0 + then h1 :: merge cmp t1 l2 + else h2 :: merge cmp l1 t2 +;; + +let rec chop k l = + if k = 0 then l else begin + match l with + | x::t -> chop (k-1) t + | _ -> assert false + end +;; + +let stable_sort cmp l = + let rec rev_merge l1 l2 accu = + match l1, l2 with + | [], l2 -> revAppend l2 accu + | l1, [] -> revAppend l1 accu + | h1::t1, h2::t2 -> + if cmp h1 h2 [@bs] <= 0 + then rev_merge t1 l2 (h1::accu) + else rev_merge l1 t2 (h2::accu) + in + let rec rev_merge_rev l1 l2 accu = + match l1, l2 with + | [], l2 -> revAppend l2 accu + | l1, [] -> revAppend l1 accu + | h1::t1, h2::t2 -> + if cmp h1 h2 [@bs] > 0 + then rev_merge_rev t1 l2 (h1::accu) + else rev_merge_rev l1 t2 (h2::accu) + in + let rec sort n l = + match n, l with + | 2, x1 :: x2 :: _ -> + if cmp x1 x2 [@bs] <= 0 then [x1; x2] else [x2; x1] + | 3, x1 :: x2 :: x3 :: _ -> + if cmp x1 x2 [@bs] <= 0 then begin + if cmp x2 x3 [@bs] <= 0 then [x1; x2; x3] + else if cmp x1 x3 [@bs] <= 0 then [x1; x3; x2] + else [x3; x1; x2] + end else begin + if cmp x1 x3 [@bs] <= 0 then [x2; x1; x3] + else if cmp x2 x3 [@bs] <= 0 then [x2; x3; x1] + else [x3; x2; x1] + end + | n, l -> + let n1 = n asr 1 in + let n2 = n - n1 in + let l2 = chop n1 l in + let s1 = rev_sort n1 l in + let s2 = rev_sort n2 l2 in + rev_merge_rev s1 s2 [] + and rev_sort n l = + match n, l with + | 2, x1 :: x2 :: _ -> + if cmp x1 x2 [@bs] > 0 then [x1; x2] else [x2; x1] + | 3, x1 :: x2 :: x3 :: _ -> + if cmp x1 x2 [@bs] > 0 then begin + if cmp x2 x3 [@bs] > 0 then [x1; x2; x3] + else if cmp x1 x3 [@bs] > 0 then [x1; x3; x2] + else [x3; x1; x2] + end else begin + if cmp x1 x3 [@bs] > 0 then [x2; x1; x3] + else if cmp x2 x3 [@bs] > 0 then [x2; x3; x1] + else [x3; x2; x1] + end + | n, l -> + let n1 = n asr 1 in + let n2 = n - n1 in + let l2 = chop n1 l in + let s1 = sort n1 l in + let s2 = sort n2 l2 in + rev_merge s1 s2 [] + in + let len = length l in + if len < 2 then l else sort len l +;; + +let sort = stable_sort;; +let fast_sort = stable_sort;; + +(* Note: on a list of length between about 100000 (depending on the minor + heap size and the type of the list) and Sys.max_array_size, it is + actually faster to use the following, but it might also use more memory + because the argument list cannot be deallocated incrementally. + + Also, there seems to be a bug in this code or in the + implementation of obj_truncate. + + external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate" + + let array_to_list_in_place a = + let l = Array.length a in + let rec loop accu n p = + if p <= 0 then accu else begin + if p = n then begin + obj_truncate a p; + loop (a.(p-1) :: accu) (n-1000) (p-1) + end else begin + loop (a.(p-1) :: accu) n (p-1) + end + end + in + loop [] (l-1000) l + ;; + + let stable_sort cmp l = + let a = Array.of_list l in + Array.stable_sort cmp a; + array_to_list_in_place a + ;; +*) + + +(** sorting + removing duplicates *) + +let sort_uniq cmp l = + let rec rev_merge l1 l2 accu = + match l1, l2 with + | [], l2 -> revAppend l2 accu + | l1, [] -> revAppend l1 accu + | h1::t1, h2::t2 -> + let c = cmp h1 h2 [@bs] in + if c = 0 then rev_merge t1 t2 (h1::accu) + else if c < 0 + then rev_merge t1 l2 (h1::accu) + else rev_merge l1 t2 (h2::accu) + in + let rec rev_merge_rev l1 l2 accu = + match l1, l2 with + | [], l2 -> revAppend l2 accu + | l1, [] -> revAppend l1 accu + | h1::t1, h2::t2 -> + let c = cmp h1 h2 [@bs] in + if c = 0 then rev_merge_rev t1 t2 (h1::accu) + else if c > 0 + then rev_merge_rev t1 l2 (h1::accu) + else rev_merge_rev l1 t2 (h2::accu) + in + let rec sort n l = + match n, l with + | 2, x1 :: x2 :: _ -> + let c = cmp x1 x2 [@bs] in + if c = 0 then [x1] + else if c < 0 then [x1; x2] else [x2; x1] + | 3, x1 :: x2 :: x3 :: _ -> + let c = cmp x1 x2 [@bs] in + if c = 0 then begin + let c = cmp x2 x3 [@bs] in + if c = 0 then [x2] + else if c < 0 then [x2; x3] else [x3; x2] + end else if c < 0 then begin + let c = cmp x2 x3 [@bs] in + if c = 0 then [x1; x2] + else if c < 0 then [x1; x2; x3] + else let c = cmp x1 x3 [@bs] in + if c = 0 then [x1; x2] + else if c < 0 then [x1; x3; x2] + else [x3; x1; x2] + end else begin + let c = cmp x1 x3 [@bs] in + if c = 0 then [x2; x1] + else if c < 0 then [x2; x1; x3] + else let c = cmp x2 x3 [@bs] in + if c = 0 then [x2; x1] + else if c < 0 then [x2; x3; x1] + else [x3; x2; x1] + end + | n, l -> + let n1 = n asr 1 in + let n2 = n - n1 in + let l2 = chop n1 l in + let s1 = rev_sort n1 l in + let s2 = rev_sort n2 l2 in + rev_merge_rev s1 s2 [] + and rev_sort n l = + match n, l with + | 2, x1 :: x2 :: _ -> + let c = cmp x1 x2 [@bs] in + if c = 0 then [x1] + else if c > 0 then [x1; x2] else [x2; x1] + | 3, x1 :: x2 :: x3 :: _ -> + let c = cmp x1 x2 [@bs] in + if c = 0 then begin + let c = cmp x2 x3 [@bs] in + if c = 0 then [x2] + else if c > 0 then [x2; x3] else [x3; x2] + end else if c > 0 then begin + let c = cmp x2 x3 [@bs] in + if c = 0 then [x1; x2] + else if c > 0 then [x1; x2; x3] + else let c = cmp x1 x3 [@bs] in + if c = 0 then [x1; x2] + else if c > 0 then [x1; x3; x2] + else [x3; x1; x2] + end else begin + let c = cmp x1 x3 [@bs] in + if c = 0 then [x2; x1] + else if c > 0 then [x2; x1; x3] + else let c = cmp x2 x3 [@bs] in + if c = 0 then [x2; x1] + else if c > 0 then [x2; x3; x1] + else [x3; x2; x1] + end + | n, l -> + let n1 = n asr 1 in + let n2 = n - n1 in + let l2 = chop n1 l in + let s1 = sort n1 l in + let s2 = sort n2 l2 in + rev_merge s1 s2 [] + in + let len = length l in + if len < 2 then l else sort len l +;; diff --git a/jscomp/others/bs_internalLinkList.ml b/jscomp/others/bs_internalLinkList.ml new file mode 100644 index 0000000000..3a8ca0a8de --- /dev/null +++ b/jscomp/others/bs_internalLinkList.ml @@ -0,0 +1,33 @@ +(* 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 cell = { + head : 'a; + mutable tail : 'a opt_cell +} +and 'a opt_cell = 'a cell Js.null +[@@bs.deriving abstract] + +external tailOpt : 'a cell -> 'a cell option = "tail" +[@@bs.get] [@@bs.return null_to_opt] diff --git a/jscomp/others/tmpLinkList.mli b/jscomp/others/tmpLinkList.mli new file mode 100644 index 0000000000..1ef7301815 --- /dev/null +++ b/jscomp/others/tmpLinkList.mli @@ -0,0 +1,235 @@ +(** List operations. + + Some functions are flagged as not tail-recursive. A tail-recursive + function uses constant stack space, while a non-tail-recursive function + uses stack space proportional to the length of its list argument, which + can be a problem with very long lists. When the function takes several + list arguments, an approximate formula giving stack usage (in some + unspecified constant unit) is shown in parentheses. + + The above considerations can usually be ignored if your lists are not + longer than about 10000 elements. +*) +type 'a t +val length : 'a t -> int +(** Return the length (number of elements) of the given list. *) + +val hd : 'a t -> 'a +(** Return the first element of the given list. Raise + [Failure "hd"] if the list is empty. *) + +val tl : 'a t -> 'a t +(** Return the given list without its first element. Raise + [Failure "tl"] if the list is empty. *) + +val nth : 'a t -> int -> 'a +(** Return the [n]-th element of the given list. + The first element (head of the list) is at position 0. + Raise [Failure "nth"] if the list is too short. + Raise [Invalid_argument "List.nth"] if [n] is negative. *) + +val rev : 'a t -> 'a t +(** List reversal. *) + +val append : 'a t -> 'a t -> 'a t +(** Catenate two lists. Same function as the infix operator [@]. + Not tail-recursive (length of the first argument). The [@] + operator is not tail-recursive either. *) + +val rev_append : 'a t -> 'a t -> 'a t +(** [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2]. + This is equivalent to {!List.rev}[ l1 @ l2], but [rev_append] is + tail-recursive and more efficient. *) + +val concat : 'a t t -> 'a t +(** Concatenate a list of lists. The elements of the argument are all + concatenated together (in the same order) to give the result. + Not tail-recursive + (length of the argument + length of the longest sub-list). *) + +val flatten : 'a t t -> 'a t +(** Same as [concat]. Not tail-recursive + (length of the argument + length of the longest sub-list). *) + + +(** {6 Iterators} *) + + +val iter : ('a -> unit) -> 'a t -> unit +(** [List.iter f [a1; ...; an]] applies function [f] in turn to + [a1; ...; an]. It is equivalent to + [begin f a1; f a2; ...; f an; () end]. *) + +val iteri : (int -> 'a -> unit) -> 'a t -> unit +(** Same as {!List.iter}, but the function is applied to the index of + the element as first argument (counting from 0), and the element + itself as second argument. + @since 4.00.0 +*) + +val map : ('a -> 'b) -> 'a t -> 'b t +(** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], + and builds the list [[f a1; ...; f an]] + with the results returned by [f]. Not tail-recursive. *) + +val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t +(** Same as {!List.map}, but the function is applied to the index of + the element as first argument (counting from 0), and the element + itself as second argument. Not tail-recursive. + @since 4.00.0 +*) + +val rev_map : ('a -> 'b) -> 'a t -> 'b t +(** [List.rev_map f l] gives the same result as + {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and + more efficient. *) + +val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a +(** [List.fold_left f a [b1; ...; bn]] is + [f (... (f (f a b1) b2) ...) bn]. *) + +val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b +(** [List.fold_right f [a1; ...; an] b] is + [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *) + + +(** {6 Iterators on two lists} *) + + +val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit +(** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn + [f a1 b1; ...; f an bn]. + Raise [Invalid_argument] if the two lists have + different lengths. *) + +val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t +(** [List.map2 f [a1; ...; an] [b1; ...; bn]] is + [[f a1 b1; ...; f an bn]]. + Raise [Invalid_argument] if the two lists have + different lengths. Not tail-recursive. *) + +val rev_map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t +(** [List.rev_map2 f l1 l2] gives the same result as + {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and + more efficient. *) + +val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b t -> 'c t -> 'a +(** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is + [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. + Raise [Invalid_argument] if the two lists have + different lengths. *) + +val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a t -> 'b t -> 'c -> 'c +(** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is + [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. + Raise [Invalid_argument] if the two lists have + different lengths. Not tail-recursive. *) + + +(** {6 List scanning} *) + + +val for_all : ('a -> bool) -> 'a t -> bool +(** [for_all p [a1; ...; an]] checks if all elements of the t + satisfy the predicate [p]. That is, it returns + [(p a1) && (p a2) && ... && (p an)]. *) + +val exists : ('a -> bool) -> 'a t -> bool +(** [exists p [a1; ...; an]] checks if at least one element of + the list satisfies the predicate [p]. That is, it returns + [(p a1) || (p a2) || ... || (p an)]. *) + +val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool +(** Same as {!List.for_all}, but for a two-argument predicate. + Raise [Invalid_argument] if the two lists have + different lengths. *) + +val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool +(** Same as {!List.exists}, but for a two-argument predicate. + Raise [Invalid_argument] if the two lists have + different lengths. *) + +val mem : 'a -> 'a t -> bool +(** [mem a l] is true if and only if [a] is equal + to an element of [l]. *) + +val memq : 'a -> 'a t -> bool +(** Same as {!List.mem}, but uses physical equality instead of structural + equality to compare list elements. *) + + +(** {6 List searching} *) + + +val find : ('a -> bool) -> 'a t -> 'a +(** [find p l] returns the first element of the list [l] + that satisfies the predicate [p]. + Raise [Not_found] if there is no value that satisfies [p] in the + list [l]. *) + +val filter : ('a -> bool) -> 'a t -> 'a t +(** [filter p l] returns all the elements of the list [l] + that satisfy the predicate [p]. The order of the elements + in the input list is preserved. *) + +val find_all : ('a -> bool) -> 'a t -> 'a t +(** [find_all] is another name for {!List.filter}. *) + +val partition : ('a -> bool) -> 'a t -> 'a t * 'a t +(** [partition p l] returns a pair of lists [(l1, l2)], where + [l1] is the list of all the elements of [l] that + satisfy the predicate [p], and [l2] is the list of all the + elements of [l] that do not satisfy [p]. + The order of the elements in the input list is preserved. *) + + +(** {6 Association lists} *) + + +val assoc : 'a -> ('a * 'b) t -> 'b +(** [assoc a l] returns the value associated with key [a] in the list of + pairs [l]. That is, + [assoc a [ ...; (a,b); ...] = b] + if [(a,b)] is the leftmost binding of [a] in list [l]. + Raise [Not_found] if there is no value associated with [a] in the + list [l]. *) + +val assq : 'a -> ('a * 'b) t -> 'b +(** Same as {!List.assoc}, but uses physical equality instead of structural + equality to compare keys. *) + +val mem_assoc : 'a -> ('a * 'b) t -> bool +(** Same as {!List.assoc}, but simply return true if a binding exists, + and false if no bindings exist for the given key. *) + +val mem_assq : 'a -> ('a * 'b) t -> bool +(** Same as {!List.mem_assoc}, but uses physical equality instead of + structural equality to compare keys. *) + +val remove_assoc : 'a -> ('a * 'b) t -> ('a * 'b) t +(** [remove_assoc a l] returns the list of + pairs [l] without the first pair with key [a], if any. + Not tail-recursive. *) + +val remove_assq : 'a -> ('a * 'b) t -> ('a * 'b) t +(** Same as {!List.remove_assoc}, but uses physical equality instead + of structural equality to compare keys. Not tail-recursive. *) + + +(** {6 Lists of pairs} *) + + +val split : ('a * 'b) t -> 'a t * 'b t +(** Transform a list of pairs into a pair of lists: + [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. + Not tail-recursive. +*) + +val combine : 'a t -> 'b t -> ('a * 'b) t +(** Transform a pair of lists into a list of pairs: + [combine [a1; ...; an] [b1; ...; bn]] is + [[(a1,b1); ...; (an,bn)]]. + Raise [Invalid_argument] if the two lists + have different lengths. Not tail-recursive. *) + + diff --git a/jscomp/test/.depend b/jscomp/test/.depend index 9e2b7b3e10..c7e0d4fb5e 100644 --- a/jscomp/test/.depend +++ b/jscomp/test/.depend @@ -95,6 +95,7 @@ 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 +bs_link_list_test.cmj : mt.cmj ../others/bs.cmj bs_map_int_test.cmj : mt.cmj ../others/bs.cmj bs_map_test.cmj : ../runtime/js.cmj ../others/bs.cmj bs_mutable_set_test.cmj : ../runtime/js.cmj \ diff --git a/jscomp/test/Makefile b/jscomp/test/Makefile index ef702089c1..df63fd63cc 100644 --- a/jscomp/test/Makefile +++ b/jscomp/test/Makefile @@ -227,6 +227,7 @@ OTHERS := test_literals a test_ari test_export2 test_internalOO test_obj_simple_ bs_hashmap_test\ bs_hashset_int_test\ array_data_util\ + bs_link_list_test\ # bs_uncurry_test # needs Lam to get rid of Uncurry arity first # simple_derive_test diff --git a/jscomp/test/bs_link_list_test.js b/jscomp/test/bs_link_list_test.js new file mode 100644 index 0000000000..205722d0f5 --- /dev/null +++ b/jscomp/test/bs_link_list_test.js @@ -0,0 +1,146 @@ +'use strict'; + +var Mt = require("./mt.js"); +var Block = require("../../lib/js/block.js"); +var Bs_List = require("../../lib/js/bs_List.js"); +var Bs_Array = require("../../lib/js/bs_Array.js"); +var Caml_int32 = require("../../lib/js/caml_int32.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; +} + +function b(loc, x) { + test_id[0] = test_id[0] + 1 | 0; + suites[0] = /* :: */[ + /* tuple */[ + loc + (" id " + test_id[0]), + (function () { + return /* Ok */Block.__(4, [x]); + }) + ], + suites[0] + ]; + return /* () */0; +} + +var u = Bs_List.init(5, (function (i) { + return Caml_int32.imul(i, i); + })); + +function f(i) { + return eq("File \"bs_link_list_test.ml\", line 23, characters 7-14", Bs_List.nthAssert(u, i), Caml_int32.imul(i, i)); +} + +for(var i = 0; i <= 4; ++i){ + f(i); +} + +eq("File \"bs_link_list_test.ml\", line 27, characters 5-12", Bs_List.map(u, (function (i) { + return i + 1 | 0; + })), /* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 5, + /* :: */[ + 10, + /* :: */[ + 17, + /* [] */0 + ] + ] + ] + ] + ]); + +eq("File \"bs_link_list_test.ml\", line 30, characters 5-12", Bs_List.flatten(/* :: */[ + /* :: */[ + 1, + /* [] */0 + ], + /* :: */[ + /* :: */[ + 2, + /* [] */0 + ], + /* :: */[ + /* :: */[ + 3, + /* [] */0 + ], + /* :: */[ + /* [] */0, + /* :: */[ + Bs_List.init(4, (function (i) { + return i; + })), + /* [] */0 + ] + ] + ] + ] + ]), /* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* :: */[ + 0, + /* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* [] */0 + ] + ] + ] + ] + ] + ] + ]); + +eq("File \"bs_link_list_test.ml\", line 37, characters 5-12", Bs_List.toArray(Bs_List.append(Bs_List.init(100, (function (i) { + return i; + })), Bs_List.init(100, (function (i) { + return i; + })))), Bs_Array.append(Bs_Array.init(100, (function (i) { + return i; + })), Bs_Array.init(100, (function (i) { + return i; + })))); + +Mt.from_pair_suites("bs_link_list_test.ml", suites[0]); + +var N = 0; + +var A = 0; + +exports.suites = suites; +exports.test_id = test_id; +exports.eq = eq; +exports.b = b; +exports.N = N; +exports.A = A; +/* u Not a pure module */ diff --git a/jscomp/test/bs_link_list_test.ml b/jscomp/test/bs_link_list_test.ml new file mode 100644 index 0000000000..1798c81ba9 --- /dev/null +++ b/jscomp/test/bs_link_list_test.ml @@ -0,0 +1,51 @@ +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 + +let b loc x = + incr test_id ; + suites := + (loc ^" id " ^ (string_of_int !test_id), + (fun _ -> Mt.Ok x)) :: !suites + +(* module N = Bs.LinkList *) +module N = Bs.List +module A = Bs.Array + +let () = + let u = (N.init 5 (fun[@bs] i -> i * i )) in + + (* N.checkInvariant u ; *) + let f i = + eq __LOC__ (N.nthAssert u i) (i * i) in + for i = 0 to 4 do + f i + done ; + eq __LOC__ (N.map u (fun [@bs] i -> i + 1)) [1;2;5;10;17] + +let () = + eq __LOC__ + N.(flatten + [[1]; [2]; [3];[]; init 4 (fun [@bs] i -> i )] + ) + [1;2;3; 0;1;2;3] + +let () = + eq __LOC__ + (N. + (append + (init 100 (fun [@bs] i -> i) ) + (init 100 (fun [@bs] i -> i))) + |> N.toArray + ) + + (A. + (append + (init 100 (fun [@bs] i -> i) ) + (init 100 (fun [@bs] i -> i))) + ) + +;; Mt.from_pair_suites __FILE__ !suites diff --git a/lib/js/bs.js b/lib/js/bs.js index c02c81c379..5203289314 100644 --- a/lib/js/bs.js +++ b/lib/js/bs.js @@ -35,6 +35,10 @@ var SetInt = 0; var SetString = 0; +var LinkList = 0; + +var List = 0; + exports.Bag = Bag; exports.Cmp = Cmp; exports.Hash = Hash; @@ -52,4 +56,6 @@ exports.MapInt = MapInt; exports.MapString = MapString; exports.SetInt = SetInt; exports.SetString = SetString; +exports.LinkList = LinkList; +exports.List = List; /* No side effect */ diff --git a/lib/js/bs_LinkList.js b/lib/js/bs_LinkList.js new file mode 100644 index 0000000000..42ccef7575 --- /dev/null +++ b/lib/js/bs_LinkList.js @@ -0,0 +1,207 @@ +'use strict'; + +var Js_primitive = require("./js_primitive.js"); + +function toOpt(prim) { + if (prim === null) { + return /* None */0; + } else { + return [prim]; + } +} + +function $$return(prim) { + return prim; +} + +var empty = null; + +function headOpt(x) { + return Js_primitive.null_to_opt(x.data); +} + +function tailOpt(x) { + var match = x.data; + if (match !== null) { + return Js_primitive.null_to_opt(match.tail); + } else { + return /* None */0; + } +} + +function lengthCellAux(_x, _acc) { + while(true) { + var acc = _acc; + var x = _x; + if (x !== null) { + _acc = acc + 1 | 0; + _x = x.tail; + continue ; + + } else { + return acc; + } + }; +} + +function checkInvariant(x) { + if (x.length !== lengthCellAux(x.data, 0)) { + throw new Error("File \"bs_LinkList.ml\", line 37, characters 4-10"); + } else { + return 0; + } +} + +function nextAuxAssert(_opt_cell, _n) { + while(true) { + var n = _n; + var opt_cell = _opt_cell; + if (n) { + _n = n - 1 | 0; + _opt_cell = opt_cell.tail; + continue ; + + } else { + return opt_cell.head; + } + }; +} + +function nthOpt(x, n) { + if (n < 0 || n >= x.length) { + return /* None */0; + } else { + return /* Some */[nextAuxAssert(x.data, n)]; + } +} + +function nthAssert(x, n) { + if (n < 0) { + throw new Error("Neg"); + } else { + return nextAuxAssert(x.data, n); + } +} + +function copyAux(_cellX, _prec) { + while(true) { + var prec = _prec; + var cellX = _cellX; + if (cellX !== null) { + var h = cellX.head; + var t = cellX.tail; + var next = { + head: h, + tail: empty + }; + prec.tail = next; + _prec = next; + _cellX = t; + continue ; + + } else { + return prec; + } + }; +} + +function copyNonEmptyTo(xs, ys) { + var cell = { + head: xs.head, + tail: empty + }; + var newTail = copyAux(xs.tail, cell); + newTail.tail = ys; + return cell; +} + +function append(x, y) { + var lenX = x.length; + if (lenX) { + var lenY = y.length; + if (lenY) { + var h = x.data; + var cell = copyNonEmptyTo(h, y.data); + return { + length: lenX + lenY | 0, + data: cell + }; + } else { + return x; + } + } else { + return y; + } +} + +function init(n, f) { + if (n < 0) { + throw new Error("Invalid_argument"); + } else if (n) { + var headX = { + head: f(0), + tail: empty + }; + var cur = headX; + var i = 1; + while(i < n) { + var v = { + head: f(i), + tail: empty + }; + cur.tail = v; + cur = v; + i = i + 1 | 0; + }; + return { + length: n, + data: headX + }; + } else { + return { + length: 0, + data: empty + }; + } +} + +function fillAux(arr, _i, _cell_opt) { + while(true) { + var cell_opt = _cell_opt; + var i = _i; + if (cell_opt !== null) { + arr[i] = cell_opt.head; + _cell_opt = cell_opt.tail; + _i = i + 1 | 0; + continue ; + + } else { + return /* () */0; + } + }; +} + +function toArray(x) { + var len = x.length; + var arr = new Array(len); + fillAux(arr, 0, x.data); + return arr; +} + +exports.toOpt = toOpt; +exports.$$return = $$return; +exports.empty = empty; +exports.headOpt = headOpt; +exports.tailOpt = tailOpt; +exports.lengthCellAux = lengthCellAux; +exports.checkInvariant = checkInvariant; +exports.nextAuxAssert = nextAuxAssert; +exports.nthOpt = nthOpt; +exports.nthAssert = nthAssert; +exports.copyAux = copyAux; +exports.copyNonEmptyTo = copyNonEmptyTo; +exports.append = append; +exports.init = init; +exports.fillAux = fillAux; +exports.toArray = toArray; +/* empty Not a pure module */ diff --git a/lib/js/bs_List.js b/lib/js/bs_List.js new file mode 100644 index 0000000000..faec01a0fd --- /dev/null +++ b/lib/js/bs_List.js @@ -0,0 +1,1834 @@ +'use strict'; + +var Caml_builtin_exceptions = require("./caml_builtin_exceptions.js"); + +function headOpt(x) { + if (x) { + return /* Some */[x[0]]; + } else { + return /* None */0; + } +} + +function tailOpt(x) { + if (x) { + return /* Some */[x[1]]; + } else { + return /* None */0; + } +} + +function nthAux(_x, _n) { + while(true) { + var n = _n; + var x = _x; + if (x) { + if (n) { + _n = n - 1 | 0; + _x = x[1]; + continue ; + + } else { + return /* Some */[x[0]]; + } + } else { + return /* None */0; + } + }; +} + +function nthAuxAssert(_x, _n) { + while(true) { + var n = _n; + var x = _x; + if (x) { + if (n) { + _n = n - 1 | 0; + _x = x[1]; + continue ; + + } else { + return x[0]; + } + } else { + throw new Error("nthAssert"); + } + }; +} + +function nthOpt(x, n) { + if (n < 0) { + return /* None */0; + } else { + return nthAux(x, n); + } +} + +function nthAssert(x, n) { + if (n < 0) { + throw new Error("nthAssert"); + } else { + return nthAuxAssert(x, n); + } +} + +function copyAux(_cellX, _prec) { + while(true) { + var prec = _prec; + var cellX = _cellX; + if (cellX) { + var next = [cellX[0]]; + prec[1] = next; + _prec = next; + _cellX = cellX[1]; + continue ; + + } else { + return prec; + } + }; +} + +function copyAuxWithMap(f, _cellX, _prec) { + while(true) { + var prec = _prec; + var cellX = _cellX; + if (cellX) { + var next = [f(cellX[0])]; + prec[1] = next; + _prec = next; + _cellX = cellX[1]; + continue ; + + } else { + prec[1] = /* [] */0; + return /* () */0; + } + }; +} + +function copyAuxWithMapI(f, _i, _cellX, _prec) { + while(true) { + var prec = _prec; + var cellX = _cellX; + var i = _i; + if (cellX) { + var next = [f(i, cellX[0])]; + prec[1] = next; + _prec = next; + _cellX = cellX[1]; + _i = i + 1 | 0; + continue ; + + } else { + prec[1] = /* [] */0; + return /* () */0; + } + }; +} + +function append(xs, ys) { + if (xs) { + var cell = [xs[0]]; + copyAux(xs[1], cell)[1] = ys; + return cell; + } else { + return ys; + } +} + +function map(xs, f) { + if (xs) { + var cell = [f(xs[0])]; + copyAuxWithMap(f, xs[1], cell); + return cell; + } else { + return /* [] */0; + } +} + +function mapi(f, param) { + if (param) { + var cell = [f(0, param[0])]; + copyAuxWithMapI(f, 1, param[1], cell); + return cell; + } else { + return /* [] */0; + } +} + +function init(n, f) { + if (n < 0) { + throw new Error("Invalid_argument"); + } else if (n) { + var headX = [f(0)]; + var cur = headX; + var i = 1; + while(i < n) { + var v = [f(i)]; + cur[1] = v; + cur = v; + i = i + 1 | 0; + }; + return headX; + } else { + return /* [] */0; + } +} + +function lengthAux(_x, _acc) { + while(true) { + var acc = _acc; + var x = _x; + if (x) { + _acc = acc + 1 | 0; + _x = x[1]; + continue ; + + } else { + return acc; + } + }; +} + +function length(xs) { + return lengthAux(xs, 0); +} + +function fillAux(arr, _i, _x) { + while(true) { + var x = _x; + var i = _i; + if (x) { + arr[i] = x[0]; + _x = x[1]; + _i = i + 1 | 0; + continue ; + + } else { + return /* () */0; + } + }; +} + +function toArray(x) { + var len = lengthAux(x, 0); + var arr = new Array(len); + fillAux(arr, 0, x); + return arr; +} + +function revAppend(_l1, _l2) { + while(true) { + var l2 = _l2; + var l1 = _l1; + if (l1) { + _l2 = /* :: */[ + l1[0], + l2 + ]; + _l1 = l1[1]; + continue ; + + } else { + return l2; + } + }; +} + +function rev(l) { + return revAppend(l, /* [] */0); +} + +function flattenAux(_prec, _xs) { + while(true) { + var xs = _xs; + var prec = _prec; + if (xs) { + _xs = xs[1]; + _prec = copyAux(xs[0], prec); + continue ; + + } else { + prec[1] = /* [] */0; + return /* () */0; + } + }; +} + +function flatten(_xs) { + while(true) { + var xs = _xs; + if (xs) { + var match = xs[0]; + if (match) { + var cell = [match[0]]; + flattenAux(copyAux(match[1], cell), xs[1]); + return cell; + } else { + _xs = xs[1]; + continue ; + + } + } else { + return /* [] */0; + } + }; +} + +function rev_map(f, l) { + var _accu = /* [] */0; + var _param = l; + while(true) { + var param = _param; + var accu = _accu; + if (param) { + _param = param[1]; + _accu = /* :: */[ + f(param[0]), + accu + ]; + continue ; + + } else { + return accu; + } + }; +} + +function iter(f, _param) { + while(true) { + var param = _param; + if (param) { + f(param[0]); + _param = param[1]; + continue ; + + } else { + return /* () */0; + } + }; +} + +function iteri(f, l) { + var _i = 0; + var f$1 = f; + var _param = l; + while(true) { + var param = _param; + var i = _i; + if (param) { + f$1(i, param[0]); + _param = param[1]; + _i = i + 1 | 0; + continue ; + + } else { + return /* () */0; + } + }; +} + +function fold_left(f, _accu, _l) { + while(true) { + var l = _l; + var accu = _accu; + if (l) { + _l = l[1]; + _accu = f(accu, l[0]); + continue ; + + } else { + return accu; + } + }; +} + +function fold_right(f, l, accu) { + if (l) { + return f(l[0], fold_right(f, l[1], accu)); + } else { + return accu; + } +} + +function map2(f, l1, l2) { + if (l1) { + if (l2) { + var r = f(l1[0], l2[0]); + return /* :: */[ + r, + map2(f, l1[1], l2[1]) + ]; + } else { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.map2" + ]; + } + } else if (l2) { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.map2" + ]; + } else { + return /* [] */0; + } +} + +function rev_map2(f, l1, l2) { + var _accu = /* [] */0; + var _l1 = l1; + var _l2 = l2; + while(true) { + var l2$1 = _l2; + var l1$1 = _l1; + var accu = _accu; + if (l1$1) { + if (l2$1) { + _l2 = l2$1[1]; + _l1 = l1$1[1]; + _accu = /* :: */[ + f(l1$1[0], l2$1[0]), + accu + ]; + continue ; + + } else { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.rev_map2" + ]; + } + } else if (l2$1) { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.rev_map2" + ]; + } else { + return accu; + } + }; +} + +function iter2(f, _l1, _l2) { + while(true) { + var l2 = _l2; + var l1 = _l1; + if (l1) { + if (l2) { + f(l1[0], l2[0]); + _l2 = l2[1]; + _l1 = l1[1]; + continue ; + + } else { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.iter2" + ]; + } + } else if (l2) { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.iter2" + ]; + } else { + return /* () */0; + } + }; +} + +function fold_left2(f, _accu, _l1, _l2) { + while(true) { + var l2 = _l2; + var l1 = _l1; + var accu = _accu; + if (l1) { + if (l2) { + _l2 = l2[1]; + _l1 = l1[1]; + _accu = f(accu, l1[0], l2[0]); + continue ; + + } else { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.fold_left2" + ]; + } + } else if (l2) { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.fold_left2" + ]; + } else { + return accu; + } + }; +} + +function fold_right2(f, l1, l2, accu) { + if (l1) { + if (l2) { + return f(l1[0], l2[0], fold_right2(f, l1[1], l2[1], accu)); + } else { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.fold_right2" + ]; + } + } else if (l2) { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.fold_right2" + ]; + } else { + return accu; + } +} + +function for_all(p, _param) { + while(true) { + var param = _param; + if (param) { + if (p(param[0])) { + _param = param[1]; + continue ; + + } else { + return /* false */0; + } + } else { + return /* true */1; + } + }; +} + +function exists(p, _param) { + while(true) { + var param = _param; + if (param) { + if (p(param[0])) { + return /* true */1; + } else { + _param = param[1]; + continue ; + + } + } else { + return /* false */0; + } + }; +} + +function for_all2(p, _l1, _l2) { + while(true) { + var l2 = _l2; + var l1 = _l1; + if (l1) { + if (l2) { + if (p(l1[0], l2[0])) { + _l2 = l2[1]; + _l1 = l1[1]; + continue ; + + } else { + return /* false */0; + } + } else { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.for_all2" + ]; + } + } else if (l2) { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.for_all2" + ]; + } else { + return /* true */1; + } + }; +} + +function exists2(p, _l1, _l2) { + while(true) { + var l2 = _l2; + var l1 = _l1; + if (l1) { + if (l2) { + if (p(l1[0], l2[0])) { + return /* true */1; + } else { + _l2 = l2[1]; + _l1 = l1[1]; + continue ; + + } + } else { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.exists2" + ]; + } + } else if (l2) { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.exists2" + ]; + } else { + return /* false */0; + } + }; +} + +function mem(eq, x, _param) { + while(true) { + var param = _param; + if (param) { + if (eq(param[0], x)) { + return /* true */1; + } else { + _param = param[1]; + continue ; + + } + } else { + return /* false */0; + } + }; +} + +function memq(x, _param) { + while(true) { + var param = _param; + if (param) { + if (param[0] === x) { + return /* true */1; + } else { + _param = param[1]; + continue ; + + } + } else { + return /* false */0; + } + }; +} + +function assoc(eq, x, _param) { + while(true) { + var param = _param; + if (param) { + var match = param[0]; + if (eq(match[0], x)) { + return match[1]; + } else { + _param = param[1]; + continue ; + + } + } else { + throw Caml_builtin_exceptions.not_found; + } + }; +} + +function assq(x, _param) { + while(true) { + var param = _param; + if (param) { + var match = param[0]; + if (match[0] === x) { + return match[1]; + } else { + _param = param[1]; + continue ; + + } + } else { + throw Caml_builtin_exceptions.not_found; + } + }; +} + +function mem_assoc(eq, x, _param) { + while(true) { + var param = _param; + if (param) { + if (eq(param[0][0], x)) { + return /* true */1; + } else { + _param = param[1]; + continue ; + + } + } else { + return /* false */0; + } + }; +} + +function mem_assq(x, _param) { + while(true) { + var param = _param; + if (param) { + if (param[0][0] === x) { + return /* true */1; + } else { + _param = param[1]; + continue ; + + } + } else { + return /* false */0; + } + }; +} + +function remove_assoc(eq, x, param) { + if (param) { + var l = param[1]; + var pair = param[0]; + if (eq(pair[0], x)) { + return l; + } else { + return /* :: */[ + pair, + remove_assoc(eq, x, l) + ]; + } + } else { + return /* [] */0; + } +} + +function remove_assq(x, param) { + if (param) { + var l = param[1]; + var pair = param[0]; + if (pair[0] === x) { + return l; + } else { + return /* :: */[ + pair, + remove_assq(x, l) + ]; + } + } else { + return /* [] */0; + } +} + +function find(p, _param) { + while(true) { + var param = _param; + if (param) { + var x = param[0]; + if (p(x)) { + return x; + } else { + _param = param[1]; + continue ; + + } + } else { + throw Caml_builtin_exceptions.not_found; + } + }; +} + +function find_all(p) { + return (function (param) { + var _accu = /* [] */0; + var _param = param; + while(true) { + var param$1 = _param; + var accu = _accu; + if (param$1) { + var l = param$1[1]; + var x = param$1[0]; + if (p(x)) { + _param = l; + _accu = /* :: */[ + x, + accu + ]; + continue ; + + } else { + _param = l; + continue ; + + } + } else { + return revAppend(accu, /* [] */0); + } + }; + }); +} + +function partition(p, l) { + var _yes = /* [] */0; + var _no = /* [] */0; + var _param = l; + while(true) { + var param = _param; + var no = _no; + var yes = _yes; + if (param) { + var l$1 = param[1]; + var x = param[0]; + if (p(x)) { + _param = l$1; + _yes = /* :: */[ + x, + yes + ]; + continue ; + + } else { + _param = l$1; + _no = /* :: */[ + x, + no + ]; + continue ; + + } + } else { + return /* tuple */[ + revAppend(yes, /* [] */0), + revAppend(no, /* [] */0) + ]; + } + }; +} + +function split(param) { + if (param) { + var match = param[0]; + var match$1 = split(param[1]); + return /* tuple */[ + /* :: */[ + match[0], + match$1[0] + ], + /* :: */[ + match[1], + match$1[1] + ] + ]; + } else { + return /* tuple */[ + /* [] */0, + /* [] */0 + ]; + } +} + +function combine(l1, l2) { + if (l1) { + if (l2) { + return /* :: */[ + /* tuple */[ + l1[0], + l2[0] + ], + combine(l1[1], l2[1]) + ]; + } else { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.combine" + ]; + } + } else if (l2) { + throw [ + Caml_builtin_exceptions.invalid_argument, + "List.combine" + ]; + } else { + return /* [] */0; + } +} + +function merge(cmp, l1, l2) { + if (l1) { + if (l2) { + var h2 = l2[0]; + var h1 = l1[0]; + if (cmp(h1, h2) <= 0) { + return /* :: */[ + h1, + merge(cmp, l1[1], l2) + ]; + } else { + return /* :: */[ + h2, + merge(cmp, l1, l2[1]) + ]; + } + } else { + return l1; + } + } else { + return l2; + } +} + +function chop(_k, _l) { + while(true) { + var l = _l; + var k = _k; + if (k) { + if (l) { + _l = l[1]; + _k = k - 1 | 0; + continue ; + + } else { + return /* assert false */0; + } + } else { + return l; + } + }; +} + +function stable_sort(cmp, l) { + var sort = function (n, l) { + var exit = 0; + if (n !== 2) { + if (n !== 3) { + exit = 1; + } else if (l) { + var match = l[1]; + if (match) { + var match$1 = match[1]; + if (match$1) { + var x3 = match$1[0]; + var x2 = match[0]; + var x1 = l[0]; + if (cmp(x1, x2) <= 0) { + if (cmp(x2, x3) <= 0) { + return /* :: */[ + x1, + /* :: */[ + x2, + /* :: */[ + x3, + /* [] */0 + ] + ] + ]; + } else if (cmp(x1, x3) <= 0) { + return /* :: */[ + x1, + /* :: */[ + x3, + /* :: */[ + x2, + /* [] */0 + ] + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x1, + /* :: */[ + x2, + /* [] */0 + ] + ] + ]; + } + } else if (cmp(x1, x3) <= 0) { + return /* :: */[ + x2, + /* :: */[ + x1, + /* :: */[ + x3, + /* [] */0 + ] + ] + ]; + } else if (cmp(x2, x3) <= 0) { + return /* :: */[ + x2, + /* :: */[ + x3, + /* :: */[ + x1, + /* [] */0 + ] + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x2, + /* :: */[ + x1, + /* [] */0 + ] + ] + ]; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + } else if (l) { + var match$2 = l[1]; + if (match$2) { + var x2$1 = match$2[0]; + var x1$1 = l[0]; + if (cmp(x1$1, x2$1) <= 0) { + return /* :: */[ + x1$1, + /* :: */[ + x2$1, + /* [] */0 + ] + ]; + } else { + return /* :: */[ + x2$1, + /* :: */[ + x1$1, + /* [] */0 + ] + ]; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + if (exit === 1) { + var n1 = (n >> 1); + var n2 = n - n1 | 0; + var l2 = chop(n1, l); + var s1 = rev_sort(n1, l); + var s2 = rev_sort(n2, l2); + var _l1 = s1; + var _l2 = s2; + var _accu = /* [] */0; + while(true) { + var accu = _accu; + var l2$1 = _l2; + var l1 = _l1; + if (l1) { + if (l2$1) { + var h2 = l2$1[0]; + var h1 = l1[0]; + if (cmp(h1, h2) > 0) { + _accu = /* :: */[ + h1, + accu + ]; + _l1 = l1[1]; + continue ; + + } else { + _accu = /* :: */[ + h2, + accu + ]; + _l2 = l2$1[1]; + continue ; + + } + } else { + return revAppend(l1, accu); + } + } else { + return revAppend(l2$1, accu); + } + }; + } + + }; + var rev_sort = function (n, l) { + var exit = 0; + if (n !== 2) { + if (n !== 3) { + exit = 1; + } else if (l) { + var match = l[1]; + if (match) { + var match$1 = match[1]; + if (match$1) { + var x3 = match$1[0]; + var x2 = match[0]; + var x1 = l[0]; + if (cmp(x1, x2) > 0) { + if (cmp(x2, x3) > 0) { + return /* :: */[ + x1, + /* :: */[ + x2, + /* :: */[ + x3, + /* [] */0 + ] + ] + ]; + } else if (cmp(x1, x3) > 0) { + return /* :: */[ + x1, + /* :: */[ + x3, + /* :: */[ + x2, + /* [] */0 + ] + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x1, + /* :: */[ + x2, + /* [] */0 + ] + ] + ]; + } + } else if (cmp(x1, x3) > 0) { + return /* :: */[ + x2, + /* :: */[ + x1, + /* :: */[ + x3, + /* [] */0 + ] + ] + ]; + } else if (cmp(x2, x3) > 0) { + return /* :: */[ + x2, + /* :: */[ + x3, + /* :: */[ + x1, + /* [] */0 + ] + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x2, + /* :: */[ + x1, + /* [] */0 + ] + ] + ]; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + } else if (l) { + var match$2 = l[1]; + if (match$2) { + var x2$1 = match$2[0]; + var x1$1 = l[0]; + if (cmp(x1$1, x2$1) > 0) { + return /* :: */[ + x1$1, + /* :: */[ + x2$1, + /* [] */0 + ] + ]; + } else { + return /* :: */[ + x2$1, + /* :: */[ + x1$1, + /* [] */0 + ] + ]; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + if (exit === 1) { + var n1 = (n >> 1); + var n2 = n - n1 | 0; + var l2 = chop(n1, l); + var s1 = sort(n1, l); + var s2 = sort(n2, l2); + var _l1 = s1; + var _l2 = s2; + var _accu = /* [] */0; + while(true) { + var accu = _accu; + var l2$1 = _l2; + var l1 = _l1; + if (l1) { + if (l2$1) { + var h2 = l2$1[0]; + var h1 = l1[0]; + if (cmp(h1, h2) <= 0) { + _accu = /* :: */[ + h1, + accu + ]; + _l1 = l1[1]; + continue ; + + } else { + _accu = /* :: */[ + h2, + accu + ]; + _l2 = l2$1[1]; + continue ; + + } + } else { + return revAppend(l1, accu); + } + } else { + return revAppend(l2$1, accu); + } + }; + } + + }; + var len = lengthAux(l, 0); + if (len < 2) { + return l; + } else { + return sort(len, l); + } +} + +function sort_uniq(cmp, l) { + var sort = function (n, l) { + var exit = 0; + if (n !== 2) { + if (n !== 3) { + exit = 1; + } else if (l) { + var match = l[1]; + if (match) { + var match$1 = match[1]; + if (match$1) { + var x3 = match$1[0]; + var x2 = match[0]; + var x1 = l[0]; + var c = cmp(x1, x2); + if (c) { + if (c < 0) { + var c$1 = cmp(x2, x3); + if (c$1) { + if (c$1 < 0) { + return /* :: */[ + x1, + /* :: */[ + x2, + /* :: */[ + x3, + /* [] */0 + ] + ] + ]; + } else { + var c$2 = cmp(x1, x3); + if (c$2) { + if (c$2 < 0) { + return /* :: */[ + x1, + /* :: */[ + x3, + /* :: */[ + x2, + /* [] */0 + ] + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x1, + /* :: */[ + x2, + /* [] */0 + ] + ] + ]; + } + } else { + return /* :: */[ + x1, + /* :: */[ + x2, + /* [] */0 + ] + ]; + } + } + } else { + return /* :: */[ + x1, + /* :: */[ + x2, + /* [] */0 + ] + ]; + } + } else { + var c$3 = cmp(x1, x3); + if (c$3) { + if (c$3 < 0) { + return /* :: */[ + x2, + /* :: */[ + x1, + /* :: */[ + x3, + /* [] */0 + ] + ] + ]; + } else { + var c$4 = cmp(x2, x3); + if (c$4) { + if (c$4 < 0) { + return /* :: */[ + x2, + /* :: */[ + x3, + /* :: */[ + x1, + /* [] */0 + ] + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x2, + /* :: */[ + x1, + /* [] */0 + ] + ] + ]; + } + } else { + return /* :: */[ + x2, + /* :: */[ + x1, + /* [] */0 + ] + ]; + } + } + } else { + return /* :: */[ + x2, + /* :: */[ + x1, + /* [] */0 + ] + ]; + } + } + } else { + var c$5 = cmp(x2, x3); + if (c$5) { + if (c$5 < 0) { + return /* :: */[ + x2, + /* :: */[ + x3, + /* [] */0 + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x2, + /* [] */0 + ] + ]; + } + } else { + return /* :: */[ + x2, + /* [] */0 + ]; + } + } + } else { + exit = 1; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + } else if (l) { + var match$2 = l[1]; + if (match$2) { + var x2$1 = match$2[0]; + var x1$1 = l[0]; + var c$6 = cmp(x1$1, x2$1); + if (c$6) { + if (c$6 < 0) { + return /* :: */[ + x1$1, + /* :: */[ + x2$1, + /* [] */0 + ] + ]; + } else { + return /* :: */[ + x2$1, + /* :: */[ + x1$1, + /* [] */0 + ] + ]; + } + } else { + return /* :: */[ + x1$1, + /* [] */0 + ]; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + if (exit === 1) { + var n1 = (n >> 1); + var n2 = n - n1 | 0; + var l2 = chop(n1, l); + var s1 = rev_sort(n1, l); + var s2 = rev_sort(n2, l2); + var _l1 = s1; + var _l2 = s2; + var _accu = /* [] */0; + while(true) { + var accu = _accu; + var l2$1 = _l2; + var l1 = _l1; + if (l1) { + if (l2$1) { + var t2 = l2$1[1]; + var h2 = l2$1[0]; + var t1 = l1[1]; + var h1 = l1[0]; + var c$7 = cmp(h1, h2); + if (c$7) { + if (c$7 > 0) { + _accu = /* :: */[ + h1, + accu + ]; + _l1 = t1; + continue ; + + } else { + _accu = /* :: */[ + h2, + accu + ]; + _l2 = t2; + continue ; + + } + } else { + _accu = /* :: */[ + h1, + accu + ]; + _l2 = t2; + _l1 = t1; + continue ; + + } + } else { + return revAppend(l1, accu); + } + } else { + return revAppend(l2$1, accu); + } + }; + } + + }; + var rev_sort = function (n, l) { + var exit = 0; + if (n !== 2) { + if (n !== 3) { + exit = 1; + } else if (l) { + var match = l[1]; + if (match) { + var match$1 = match[1]; + if (match$1) { + var x3 = match$1[0]; + var x2 = match[0]; + var x1 = l[0]; + var c = cmp(x1, x2); + if (c) { + if (c > 0) { + var c$1 = cmp(x2, x3); + if (c$1) { + if (c$1 > 0) { + return /* :: */[ + x1, + /* :: */[ + x2, + /* :: */[ + x3, + /* [] */0 + ] + ] + ]; + } else { + var c$2 = cmp(x1, x3); + if (c$2) { + if (c$2 > 0) { + return /* :: */[ + x1, + /* :: */[ + x3, + /* :: */[ + x2, + /* [] */0 + ] + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x1, + /* :: */[ + x2, + /* [] */0 + ] + ] + ]; + } + } else { + return /* :: */[ + x1, + /* :: */[ + x2, + /* [] */0 + ] + ]; + } + } + } else { + return /* :: */[ + x1, + /* :: */[ + x2, + /* [] */0 + ] + ]; + } + } else { + var c$3 = cmp(x1, x3); + if (c$3) { + if (c$3 > 0) { + return /* :: */[ + x2, + /* :: */[ + x1, + /* :: */[ + x3, + /* [] */0 + ] + ] + ]; + } else { + var c$4 = cmp(x2, x3); + if (c$4) { + if (c$4 > 0) { + return /* :: */[ + x2, + /* :: */[ + x3, + /* :: */[ + x1, + /* [] */0 + ] + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x2, + /* :: */[ + x1, + /* [] */0 + ] + ] + ]; + } + } else { + return /* :: */[ + x2, + /* :: */[ + x1, + /* [] */0 + ] + ]; + } + } + } else { + return /* :: */[ + x2, + /* :: */[ + x1, + /* [] */0 + ] + ]; + } + } + } else { + var c$5 = cmp(x2, x3); + if (c$5) { + if (c$5 > 0) { + return /* :: */[ + x2, + /* :: */[ + x3, + /* [] */0 + ] + ]; + } else { + return /* :: */[ + x3, + /* :: */[ + x2, + /* [] */0 + ] + ]; + } + } else { + return /* :: */[ + x2, + /* [] */0 + ]; + } + } + } else { + exit = 1; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + } else if (l) { + var match$2 = l[1]; + if (match$2) { + var x2$1 = match$2[0]; + var x1$1 = l[0]; + var c$6 = cmp(x1$1, x2$1); + if (c$6) { + if (c$6 > 0) { + return /* :: */[ + x1$1, + /* :: */[ + x2$1, + /* [] */0 + ] + ]; + } else { + return /* :: */[ + x2$1, + /* :: */[ + x1$1, + /* [] */0 + ] + ]; + } + } else { + return /* :: */[ + x1$1, + /* [] */0 + ]; + } + } else { + exit = 1; + } + } else { + exit = 1; + } + if (exit === 1) { + var n1 = (n >> 1); + var n2 = n - n1 | 0; + var l2 = chop(n1, l); + var s1 = sort(n1, l); + var s2 = sort(n2, l2); + var _l1 = s1; + var _l2 = s2; + var _accu = /* [] */0; + while(true) { + var accu = _accu; + var l2$1 = _l2; + var l1 = _l1; + if (l1) { + if (l2$1) { + var t2 = l2$1[1]; + var h2 = l2$1[0]; + var t1 = l1[1]; + var h1 = l1[0]; + var c$7 = cmp(h1, h2); + if (c$7) { + if (c$7 < 0) { + _accu = /* :: */[ + h1, + accu + ]; + _l1 = t1; + continue ; + + } else { + _accu = /* :: */[ + h2, + accu + ]; + _l2 = t2; + continue ; + + } + } else { + _accu = /* :: */[ + h1, + accu + ]; + _l2 = t2; + _l1 = t1; + continue ; + + } + } else { + return revAppend(l1, accu); + } + } else { + return revAppend(l2$1, accu); + } + }; + } + + }; + var len = lengthAux(l, 0); + if (len < 2) { + return l; + } else { + return sort(len, l); + } +} + +var filter = find_all; + +var sort = stable_sort; + +var fast_sort = stable_sort; + +exports.headOpt = headOpt; +exports.tailOpt = tailOpt; +exports.nthAux = nthAux; +exports.nthAuxAssert = nthAuxAssert; +exports.nthOpt = nthOpt; +exports.nthAssert = nthAssert; +exports.copyAux = copyAux; +exports.copyAuxWithMap = copyAuxWithMap; +exports.copyAuxWithMapI = copyAuxWithMapI; +exports.append = append; +exports.map = map; +exports.mapi = mapi; +exports.init = init; +exports.lengthAux = lengthAux; +exports.length = length; +exports.fillAux = fillAux; +exports.toArray = toArray; +exports.revAppend = revAppend; +exports.rev = rev; +exports.flattenAux = flattenAux; +exports.flatten = flatten; +exports.rev_map = rev_map; +exports.iter = iter; +exports.iteri = iteri; +exports.fold_left = fold_left; +exports.fold_right = fold_right; +exports.map2 = map2; +exports.rev_map2 = rev_map2; +exports.iter2 = iter2; +exports.fold_left2 = fold_left2; +exports.fold_right2 = fold_right2; +exports.for_all = for_all; +exports.exists = exists; +exports.for_all2 = for_all2; +exports.exists2 = exists2; +exports.mem = mem; +exports.memq = memq; +exports.assoc = assoc; +exports.assq = assq; +exports.mem_assoc = mem_assoc; +exports.mem_assq = mem_assq; +exports.remove_assoc = remove_assoc; +exports.remove_assq = remove_assq; +exports.find = find; +exports.find_all = find_all; +exports.filter = filter; +exports.partition = partition; +exports.split = split; +exports.combine = combine; +exports.merge = merge; +exports.chop = chop; +exports.stable_sort = stable_sort; +exports.sort = sort; +exports.fast_sort = fast_sort; +exports.sort_uniq = sort_uniq; +/* No side effect */ diff --git a/lib/js/bs_internalLinkList.js b/lib/js/bs_internalLinkList.js new file mode 100644 index 0000000000..ae1b9f17e6 --- /dev/null +++ b/lib/js/bs_internalLinkList.js @@ -0,0 +1 @@ +/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */ From 862ef6448bf832eec56cafd59258003451679619 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sun, 24 Dec 2017 10:20:44 +0800 Subject: [PATCH 2/7] use specalized primitive to gain more safety --- jscomp/core/lam.ml | 18 +++--- jscomp/others/bs_List.ml | 61 ++++++++++--------- lib/js/bs_List.js | 125 ++++++++++++++++----------------------- lib/whole_compiler.ml | 18 +++--- 4 files changed, 108 insertions(+), 114 deletions(-) diff --git a/jscomp/core/lam.ml b/jscomp/core/lam.ml index 863fd6a4d0..701e4fdd2b 100644 --- a/jscomp/core/lam.ml +++ b/jscomp/core/lam.ml @@ -1799,32 +1799,32 @@ let convert exports lam : _ * _ = and convert_js_primitive (p: Primitive.description) (args : Lambda.lambda list) loc = let s = p.prim_name in match () with - | () when s = "#raw_expr" -> + | _ when s = "#raw_expr" -> begin match args with | [Lconst( Const_base (Const_string(s,_)))] -> prim ~primitive:(Praw_js_code_exp s) ~args:[] loc | _ -> assert false end - | () when s = "#raw_stmt" -> + | _ when s = "#raw_stmt" -> begin match args with | [Lconst( Const_base (Const_string(s,_)))] -> prim ~primitive:(Praw_js_code_stmt s) ~args:[] loc | _ -> assert false end - | () when s = "#debugger" -> + | _ when s = "#debugger" -> (* ATT: Currently, the arity is one due to PPX *) prim ~primitive:Pdebugger ~args:[] loc - | () when s = "#null" -> + | _ when s = "#null" -> Lconst (Const_js_null) - | () when s = "#undefined" -> + | _ when s = "#undefined" -> Lconst (Const_js_undefined) - | () -> + | _ -> let primitive = match s with - | "#apply" -> Pjs_runtime_apply + | "#apply" -> Pjs_runtime_apply | "#apply1" | "#apply2" | "#apply3" @@ -1833,6 +1833,10 @@ let convert exports lam : _ * _ = | "#apply6" | "#apply7" | "#apply8" -> Pjs_apply + | "#makemutablelist" -> + Pmakeblock(0,Lambda.Blk_constructor("::",1),Mutable) + | "#setfield1" -> + Psetfield(1, true, Fld_set_na) | "#undefined_to_opt" -> Pundefined_to_opt | "#null_undefined_to_opt" -> Pnull_undefined_to_opt | "#null_to_opt" -> Pnull_to_opt diff --git a/jscomp/others/bs_List.ml b/jscomp/others/bs_List.ml index d42289c888..2ab5b75e66 100644 --- a/jscomp/others/bs_List.ml +++ b/jscomp/others/bs_List.ml @@ -38,8 +38,10 @@ type 'a t = 'a list -external mutableCell : 'a -> 'a t = "%makemutable" - +external mutableCell : + 'a -> 'a t -> 'a t = "#makemutablelist" +external unsafeMutateTail : + 'a t -> 'a t -> unit = "#setfield1" (* [mutableCell x] == [x] but tell the compiler that is a mutable cell, so it wont @@ -80,39 +82,44 @@ let rec copyAux cellX prec = match cellX with | [] -> prec | h::t -> - let next = mutableCell h in - Obj.set_field (Obj.repr prec) 1 (Obj.repr next); + let next = mutableCell h [] in + (* here the mutable is mostly to telling compilers + dont inline [next], it is mutable + *) + unsafeMutateTail prec next ; copyAux t next let rec copyAuxWithMap f cellX prec = match cellX with - | [] -> Obj.set_field (Obj.repr prec) 1 (Obj.repr []) + | [] -> + unsafeMutateTail prec [] | h::t -> - let next = mutableCell (f h [@bs]) in - Obj.set_field (Obj.repr prec) 1 (Obj.repr next); + let next = mutableCell (f h [@bs]) [] in + unsafeMutateTail prec next ; copyAuxWithMap f t next let rec copyAuxWithMapI f i cellX prec = match cellX with - | [] -> Obj.set_field (Obj.repr prec) 1 (Obj.repr []) + | [] -> + unsafeMutateTail prec [] | h::t -> - let next = mutableCell (f i h [@bs]) in - Obj.set_field (Obj.repr prec) 1 (Obj.repr next); + let next = mutableCell (f i h [@bs]) [] in + unsafeMutateTail prec next ; copyAuxWithMapI f (i + 1) t next let append xs ys = match xs with | [] -> ys | h::t -> - let cell = mutableCell h in - Obj.set_field (Obj.repr @@ copyAux t cell) 1 (Obj.repr ys); + let cell = mutableCell h [] in + unsafeMutateTail (copyAux t cell) ys; cell let map xs f = match xs with | [] -> [] | h::t -> - let cell = mutableCell (f h [@bs]) in + let cell = mutableCell (f h [@bs]) [] in copyAuxWithMap f t cell; cell @@ -120,7 +127,7 @@ let map xs f = let rec mapi f = function [] -> [] | h::t -> - let cell = mutableCell (f 0 h [@bs]) in + let cell = mutableCell (f 0 h [@bs]) [] in copyAuxWithMapI f 1 t cell; cell @@ -132,12 +139,12 @@ let init n f = else if n = 0 then [] else - let headX = mutableCell (f 0 [@bs]) in + let headX = mutableCell (f 0 [@bs]) [] in let cur = ref headX in let i = ref 1 in while !i < n do - let v = mutableCell (f !i [@bs]) in - Obj.set_field (Obj.repr !cur) 1 (Obj.repr v) ; + let v = mutableCell (f !i [@bs]) [] in + unsafeMutateTail !cur v ; cur := v ; incr i ; done @@ -174,7 +181,7 @@ let rev l = revAppend l [] let rec flattenAux prec xs = match xs with - | [] -> Obj.set_field (Obj.repr prec) 1 (Obj.repr []) + | [] -> unsafeMutateTail prec [] | h::r -> flattenAux (copyAux h prec) r @@ -183,7 +190,7 @@ let rec flatten xs = | [] -> [] | []::xs -> flatten xs | (h::t):: r -> - let cell = mutableCell h in + let cell = mutableCell h [] in flattenAux (copyAux t cell) r ; cell @@ -224,14 +231,14 @@ let rec map2 f l1 l2 = match (l1, l2) with ([], []) -> [] | (a1::l1, a2::l2) -> let r = f a1 a2 [@bs] in r :: map2 f l1 l2 - | (_, _) -> invalid_arg "List.map2" + | (_, _) -> [%assert "List.map2"] let rev_map2 f l1 l2 = let rec rmap2_f accu l1 l2 = match (l1, l2) with | ([], []) -> accu | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 [@bs]:: accu) l1 l2 - | (_, _) -> invalid_arg "List.rev_map2" + | (_, _) -> [%assert "List.rev_map2"] in rmap2_f [] l1 l2 ;; @@ -240,19 +247,19 @@ let rec iter2 f l1 l2 = match (l1, l2) with ([], []) -> () | (a1::l1, a2::l2) -> f a1 a2 [@bs]; iter2 f l1 l2 - | (_, _) -> invalid_arg "List.iter2" + | (_, _) -> [%assert "List.iter2"] let rec fold_left2 f accu l1 l2 = match (l1, l2) with ([], []) -> accu | (a1::l1, a2::l2) -> fold_left2 f (f accu a1 a2 [@bs]) l1 l2 - | (_, _) -> invalid_arg "List.fold_left2" + | (_, _) -> [%assert "List.fold_left2"] let rec fold_right2 f l1 l2 accu = match (l1, l2) with ([], []) -> accu | (a1::l1, a2::l2) -> f a1 a2 (fold_right2 f l1 l2 accu) [@bs] - | (_, _) -> invalid_arg "List.fold_right2" + | (_, _) -> [%assert "List.fold_right2"] let rec for_all p = function [] -> true @@ -266,13 +273,13 @@ let rec for_all2 p l1 l2 = match (l1, l2) with ([], []) -> true | (a1::l1, a2::l2) -> p a1 a2 [@bs] && for_all2 p l1 l2 - | (_, _) -> invalid_arg "List.for_all2" + | (_, _) -> [%assert "List.for_all2"] let rec exists2 p l1 l2 = match (l1, l2) with ([], []) -> false | (a1::l1, a2::l2) -> p a1 a2 [@bs] || exists2 p l1 l2 - | (_, _) -> invalid_arg "List.exists2" + | (_, _) -> [%assert "List.exists2"] let rec mem eq x = function [] -> false @@ -334,7 +341,7 @@ let rec combine l1 l2 = match (l1, l2) with ([], []) -> [] | (a1::l1, a2::l2) -> (a1, a2) :: combine l1 l2 - | (_, _) -> invalid_arg "List.combine" + | (_, _) -> [%assert "List.combine"] (** sorting *) diff --git a/lib/js/bs_List.js b/lib/js/bs_List.js index faec01a0fd..6265e41233 100644 --- a/lib/js/bs_List.js +++ b/lib/js/bs_List.js @@ -77,7 +77,10 @@ function copyAux(_cellX, _prec) { var prec = _prec; var cellX = _cellX; if (cellX) { - var next = [cellX[0]]; + var next = /* :: */[ + cellX[0], + /* [] */0 + ]; prec[1] = next; _prec = next; _cellX = cellX[1]; @@ -94,7 +97,10 @@ function copyAuxWithMap(f, _cellX, _prec) { var prec = _prec; var cellX = _cellX; if (cellX) { - var next = [f(cellX[0])]; + var next = /* :: */[ + f(cellX[0]), + /* [] */0 + ]; prec[1] = next; _prec = next; _cellX = cellX[1]; @@ -113,7 +119,10 @@ function copyAuxWithMapI(f, _i, _cellX, _prec) { var cellX = _cellX; var i = _i; if (cellX) { - var next = [f(i, cellX[0])]; + var next = /* :: */[ + f(i, cellX[0]), + /* [] */0 + ]; prec[1] = next; _prec = next; _cellX = cellX[1]; @@ -129,7 +138,10 @@ function copyAuxWithMapI(f, _i, _cellX, _prec) { function append(xs, ys) { if (xs) { - var cell = [xs[0]]; + var cell = /* :: */[ + xs[0], + /* [] */0 + ]; copyAux(xs[1], cell)[1] = ys; return cell; } else { @@ -139,7 +151,10 @@ function append(xs, ys) { function map(xs, f) { if (xs) { - var cell = [f(xs[0])]; + var cell = /* :: */[ + f(xs[0]), + /* [] */0 + ]; copyAuxWithMap(f, xs[1], cell); return cell; } else { @@ -149,7 +164,10 @@ function map(xs, f) { function mapi(f, param) { if (param) { - var cell = [f(0, param[0])]; + var cell = /* :: */[ + f(0, param[0]), + /* [] */0 + ]; copyAuxWithMapI(f, 1, param[1], cell); return cell; } else { @@ -161,11 +179,17 @@ function init(n, f) { if (n < 0) { throw new Error("Invalid_argument"); } else if (n) { - var headX = [f(0)]; + var headX = /* :: */[ + f(0), + /* [] */0 + ]; var cur = headX; var i = 1; while(i < n) { - var v = [f(i)]; + var v = /* :: */[ + f(i), + /* [] */0 + ]; cur[1] = v; cur = v; i = i + 1 | 0; @@ -262,7 +286,10 @@ function flatten(_xs) { if (xs) { var match = xs[0]; if (match) { - var cell = [match[0]]; + var cell = /* :: */[ + match[0], + /* [] */0 + ]; flattenAux(copyAux(match[1], cell), xs[1]); return cell; } else { @@ -361,16 +388,10 @@ function map2(f, l1, l2) { map2(f, l1[1], l2[1]) ]; } else { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.map2" - ]; + throw new Error("List.map2"); } } else if (l2) { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.map2" - ]; + throw new Error("List.map2"); } else { return /* [] */0; } @@ -395,16 +416,10 @@ function rev_map2(f, l1, l2) { continue ; } else { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.rev_map2" - ]; + throw new Error("List.rev_map2"); } } else if (l2$1) { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.rev_map2" - ]; + throw new Error("List.rev_map2"); } else { return accu; } @@ -423,16 +438,10 @@ function iter2(f, _l1, _l2) { continue ; } else { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.iter2" - ]; + throw new Error("List.iter2"); } } else if (l2) { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.iter2" - ]; + throw new Error("List.iter2"); } else { return /* () */0; } @@ -452,16 +461,10 @@ function fold_left2(f, _accu, _l1, _l2) { continue ; } else { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.fold_left2" - ]; + throw new Error("List.fold_left2"); } } else if (l2) { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.fold_left2" - ]; + throw new Error("List.fold_left2"); } else { return accu; } @@ -473,16 +476,10 @@ function fold_right2(f, l1, l2, accu) { if (l2) { return f(l1[0], l2[0], fold_right2(f, l1[1], l2[1], accu)); } else { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.fold_right2" - ]; + throw new Error("List.fold_right2"); } } else if (l2) { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.fold_right2" - ]; + throw new Error("List.fold_right2"); } else { return accu; } @@ -537,16 +534,10 @@ function for_all2(p, _l1, _l2) { return /* false */0; } } else { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.for_all2" - ]; + throw new Error("List.for_all2"); } } else if (l2) { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.for_all2" - ]; + throw new Error("List.for_all2"); } else { return /* true */1; } @@ -568,16 +559,10 @@ function exists2(p, _l1, _l2) { } } else { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.exists2" - ]; + throw new Error("List.exists2"); } } else if (l2) { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.exists2" - ]; + throw new Error("List.exists2"); } else { return /* false */0; } @@ -840,16 +825,10 @@ function combine(l1, l2) { combine(l1[1], l2[1]) ]; } else { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.combine" - ]; + throw new Error("List.combine"); } } else if (l2) { - throw [ - Caml_builtin_exceptions.invalid_argument, - "List.combine" - ]; + throw new Error("List.combine"); } else { return /* [] */0; } diff --git a/lib/whole_compiler.ml b/lib/whole_compiler.ml index 46ddd3988f..15825022c2 100644 --- a/lib/whole_compiler.ml +++ b/lib/whole_compiler.ml @@ -68718,32 +68718,32 @@ let convert exports lam : _ * _ = and convert_js_primitive (p: Primitive.description) (args : Lambda.lambda list) loc = let s = p.prim_name in match () with - | () when s = "#raw_expr" -> + | _ when s = "#raw_expr" -> begin match args with | [Lconst( Const_base (Const_string(s,_)))] -> prim ~primitive:(Praw_js_code_exp s) ~args:[] loc | _ -> assert false end - | () when s = "#raw_stmt" -> + | _ when s = "#raw_stmt" -> begin match args with | [Lconst( Const_base (Const_string(s,_)))] -> prim ~primitive:(Praw_js_code_stmt s) ~args:[] loc | _ -> assert false end - | () when s = "#debugger" -> + | _ when s = "#debugger" -> (* ATT: Currently, the arity is one due to PPX *) prim ~primitive:Pdebugger ~args:[] loc - | () when s = "#null" -> + | _ when s = "#null" -> Lconst (Const_js_null) - | () when s = "#undefined" -> + | _ when s = "#undefined" -> Lconst (Const_js_undefined) - | () -> + | _ -> let primitive = match s with - | "#apply" -> Pjs_runtime_apply + | "#apply" -> Pjs_runtime_apply | "#apply1" | "#apply2" | "#apply3" @@ -68752,6 +68752,10 @@ let convert exports lam : _ * _ = | "#apply6" | "#apply7" | "#apply8" -> Pjs_apply + | "#makemutablelist" -> + Pmakeblock(0,Lambda.Blk_constructor("::",1),Mutable) + | "#setfield1" -> + Psetfield(1, true, Fld_set_na) | "#undefined_to_opt" -> Pundefined_to_opt | "#null_undefined_to_opt" -> Pnull_undefined_to_opt | "#null_to_opt" -> Pnull_to_opt From 42ec1616445c4c4716e5210430a11ead46c1d9a9 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sun, 24 Dec 2017 11:05:40 +0800 Subject: [PATCH 3/7] more stack safety --- jscomp/others/bs_List.ml | 209 +++++++++++------- lib/js/bs_List.js | 454 ++++++++++++++++++++++----------------- 2 files changed, 393 insertions(+), 270 deletions(-) diff --git a/jscomp/others/bs_List.ml b/jscomp/others/bs_List.ml index 2ab5b75e66..9cecd4b619 100644 --- a/jscomp/others/bs_List.ml +++ b/jscomp/others/bs_List.ml @@ -42,6 +42,8 @@ external mutableCell : 'a -> 'a t -> 'a t = "#makemutablelist" external unsafeMutateTail : 'a t -> 'a t -> unit = "#setfield1" +external unsafeTail : + 'a t -> 'a t = "%field1" (* [mutableCell x] == [x] but tell the compiler that is a mutable cell, so it wont @@ -77,6 +79,29 @@ let nthAssert x n = if n < 0 then [%assert "nthAssert"] else nthAuxAssert x n +(* [precX] or [precY] can be empty + in that case, the address may change, so we need + return some value +*) +let rec partitionAux p cell precX precY = + match cell with + | [] -> () + | h::t -> + let next = mutableCell h [] in + if p h [@bs] then + begin + unsafeMutateTail precX next ; + partitionAux p t next precY + end + else + begin + unsafeMutateTail precY next ; + partitionAux p t precX next + end + + + + (* return the tail *) let rec copyAux cellX prec = match cellX with @@ -84,11 +109,24 @@ let rec copyAux cellX prec = | h::t -> let next = mutableCell h [] in (* here the mutable is mostly to telling compilers - dont inline [next], it is mutable + dont inline [next], it is mutable *) unsafeMutateTail prec next ; copyAux t next +let rec copyAuxWitFilter f cellX prec = + match cellX with + | [] -> + unsafeMutateTail prec [] + | h::t -> + if f h [@bs] then + begin + let next = mutableCell h [] in + unsafeMutateTail prec next ; + copyAuxWitFilter f t next + end + else copyAuxWitFilter f t prec + let rec copyAuxWithMap f cellX prec = match cellX with | [] -> @@ -98,6 +136,16 @@ let rec copyAuxWithMap f cellX prec = unsafeMutateTail prec next ; copyAuxWithMap f t next + +let rec copyAuxWithMap2 f cellX cellY prec = + match cellX, cellY with + | h1::t1, h2::t2 -> + let next = mutableCell (f h1 h2 [@bs]) [] in + unsafeMutateTail prec next ; + copyAuxWithMap2 f t1 t2 next + | [],_ | _,[] -> + unsafeMutateTail prec [] + let rec copyAuxWithMapI f i cellX prec = match cellX with | [] -> @@ -106,7 +154,7 @@ let rec copyAuxWithMapI f i cellX prec = let next = mutableCell (f i h [@bs]) [] in unsafeMutateTail prec next ; copyAuxWithMapI f (i + 1) t next - + let append xs ys = match xs with | [] -> ys @@ -122,7 +170,13 @@ let map xs f = let cell = mutableCell (f h [@bs]) [] in copyAuxWithMap f t cell; cell - +let rec map2 f l1 l2 = + match (l1, l2) with + | (a1::l1, a2::l2) -> + let cell = mutableCell (f a1 a2 [@bs]) [] in + copyAuxWithMap2 f l1 l2 cell; + cell + | [], _ | _, [] -> [] let rec mapi f = function [] -> [] @@ -183,7 +237,7 @@ let rec flattenAux prec xs = match xs with | [] -> unsafeMutateTail prec [] | h::r -> flattenAux (copyAux h prec) r - + let rec flatten xs = match xs with @@ -197,15 +251,14 @@ let rec flatten xs = +let rec mapRevAux f accu xs = + match xs with + | [] -> accu + | a::l -> mapRevAux f (f a [@bs] :: accu) l +let mapRev f l = + mapRevAux f [] l -let rev_map f l = - let rec rmap_f accu = function - | [] -> accu - | a::l -> rmap_f (f a [@bs] :: accu) l - in - rmap_f [] l -;; let rec iter f = function [] -> () @@ -217,69 +270,60 @@ let rec iteri i f = function let iteri f l = iteri 0 f l -let rec fold_left f accu l = +let rec foldLeft f accu l = match l with [] -> accu - | a::l -> fold_left f (f accu a [@bs]) l + | a::l -> foldLeft f (f accu a [@bs]) l -let rec fold_right f l accu = +let rec foldRight f l accu = match l with [] -> accu - | a::l -> f a (fold_right f l accu) [@bs] + | a::l -> f a (foldRight f l accu) [@bs] -let rec map2 f l1 l2 = - match (l1, l2) with - ([], []) -> [] - | (a1::l1, a2::l2) -> let r = f a1 a2 [@bs] in r :: map2 f l1 l2 - | (_, _) -> [%assert "List.map2"] - -let rev_map2 f l1 l2 = - let rec rmap2_f accu l1 l2 = - match (l1, l2) with - | ([], []) -> accu - | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 [@bs]:: accu) l1 l2 - | (_, _) -> [%assert "List.rev_map2"] - in - rmap2_f [] l1 l2 -;; + +let rec mapRevAux2 f accu l1 l2 = + match (l1, l2) with + | (a1::l1, a2::l2) -> mapRevAux2 f (f a1 a2 [@bs]:: accu) l1 l2 + | (_, _) -> [] + +let mapRev2 f l1 l2 = + mapRevAux2 f [] l1 l2 let rec iter2 f l1 l2 = match (l1, l2) with - ([], []) -> () | (a1::l1, a2::l2) -> f a1 a2 [@bs]; iter2 f l1 l2 - | (_, _) -> [%assert "List.iter2"] + | [],_ | _, [] -> () -let rec fold_left2 f accu l1 l2 = +let rec foldLeft2 f accu l1 l2 = match (l1, l2) with - ([], []) -> accu - | (a1::l1, a2::l2) -> fold_left2 f (f accu a1 a2 [@bs]) l1 l2 - | (_, _) -> [%assert "List.fold_left2"] + | (a1::l1, a2::l2) -> foldLeft2 f (f accu a1 a2 [@bs]) l1 l2 + | [], _ | _, [] -> accu -let rec fold_right2 f l1 l2 accu = +let rec foldRight2 f l1 l2 accu = match (l1, l2) with ([], []) -> accu - | (a1::l1, a2::l2) -> f a1 a2 (fold_right2 f l1 l2 accu) [@bs] - | (_, _) -> [%assert "List.fold_right2"] + | (a1::l1, a2::l2) -> f a1 a2 (foldRight2 f l1 l2 accu) [@bs] + | _, [] | [], _ -> accu -let rec for_all p = function +let rec forAll p = function [] -> true - | a::l -> p a [@bs] && for_all p l + | a::l -> p a [@bs] && forAll p l let rec exists p = function [] -> false | a::l -> p a [@bs] || exists p l -let rec for_all2 p l1 l2 = +let rec forAll2 p l1 l2 = match (l1, l2) with - ([], []) -> true - | (a1::l1, a2::l2) -> p a1 a2 [@bs] && for_all2 p l1 l2 - | (_, _) -> [%assert "List.for_all2"] + (_, []) | [],_ -> true + | (a1::l1, a2::l2) -> p a1 a2 [@bs] && forAll2 p l1 l2 + let rec exists2 p l1 l2 = match (l1, l2) with - ([], []) -> false + [], _ | _, [] -> false | (a1::l1, a2::l2) -> p a1 a2 [@bs] || exists2 p l1 l2 - | (_, _) -> [%assert "List.exists2"] + let rec mem eq x = function [] -> false @@ -289,48 +333,63 @@ let rec memq x = function [] -> false | a::l -> a == x || memq x l -let rec assoc eq x = function - [] -> raise Not_found - | (a,b)::l -> if eq a x [@bs] then b else assoc eq x l +let rec assocOpt eq x = function + [] -> None + | (a,b)::l -> if eq a x [@bs] then Some b else assocOpt eq x l -let rec assq x = function - [] -> raise Not_found - | (a,b)::l -> if a == x then b else assq x l +let rec assqOpt x = function + [] -> None + | (a,b)::l -> if a == x then Some b else assqOpt x l -let rec mem_assoc eq x = function +let rec memAssoc eq x = function | [] -> false - | (a, b) :: l -> eq a x [@bs] || mem_assoc eq x l + | (a, b) :: l -> eq a x [@bs] || memAssoc eq x l -let rec mem_assq x = function +let rec memAssq x = function | [] -> false - | (a, b) :: l -> a == x || mem_assq x l + | (a, b) :: l -> a == x || memAssq x l -let rec remove_assoc eq x = function +let rec removeAssoc eq x = function | [] -> [] | (a, b as pair) :: l -> - if eq a x [@bs] then l else pair :: remove_assoc eq x l + if eq a x [@bs] then l else pair :: removeAssoc eq x l -let rec remove_assq x = function +let rec removeAssq x = function | [] -> [] - | (a, b as pair) :: l -> if a == x then l else pair :: remove_assq x l + | (a, b as pair) :: l -> if a == x then l else pair :: removeAssq x l -let rec find p = function - | [] -> raise Not_found - | x :: l -> if p x [@bs] then x else find p l +let rec findOpt p = function + | [] -> None + | x :: l -> if p x [@bs] then Some x else findOpt p l -let find_all p = - let rec find accu = function - | [] -> rev accu - | x :: l -> if p x [@bs] then find (x :: accu) l else find accu l in - find [] -let filter = find_all +let rec filter p xs = + match xs with + | [] -> [] + | h::t -> + if p h [@bs] then + begin + let cell = (mutableCell h []) in + copyAuxWitFilter p t cell ; + cell + end + else + filter p t + + +let partition p l = + match l with + | [] -> [],[] + | h::t -> + let nextX = mutableCell h [] in + let nextY = mutableCell h [] in + let b = p h [@bs] in + partitionAux p t nextX nextY; + if b then + nextX, unsafeTail nextY + else + unsafeTail nextX, nextY -let partition p l = - let rec part yes no = function - | [] -> (rev yes, rev no) - | x :: l -> if p x [@bs] then part (x :: yes) no l else part yes (x :: no) l in - part [] [] l let rec split = function [] -> ([], []) diff --git a/lib/js/bs_List.js b/lib/js/bs_List.js index 6265e41233..6272efefcf 100644 --- a/lib/js/bs_List.js +++ b/lib/js/bs_List.js @@ -1,6 +1,5 @@ 'use strict'; -var Caml_builtin_exceptions = require("./caml_builtin_exceptions.js"); function headOpt(x) { if (x) { @@ -72,6 +71,37 @@ function nthAssert(x, n) { } } +function partitionAux(p, _cell, _precX, _precY) { + while(true) { + var precY = _precY; + var precX = _precX; + var cell = _cell; + if (cell) { + var t = cell[1]; + var h = cell[0]; + var next = /* :: */[ + h, + /* [] */0 + ]; + if (p(h)) { + precX[1] = next; + _precX = next; + _cell = t; + continue ; + + } else { + precY[1] = next; + _precY = next; + _cell = t; + continue ; + + } + } else { + return /* () */0; + } + }; +} + function copyAux(_cellX, _prec) { while(true) { var prec = _prec; @@ -92,6 +122,35 @@ function copyAux(_cellX, _prec) { }; } +function copyAuxWitFilter(f, _cellX, _prec) { + while(true) { + var prec = _prec; + var cellX = _cellX; + if (cellX) { + var t = cellX[1]; + var h = cellX[0]; + if (f(h)) { + var next = /* :: */[ + h, + /* [] */0 + ]; + prec[1] = next; + _prec = next; + _cellX = t; + continue ; + + } else { + _cellX = t; + continue ; + + } + } else { + prec[1] = /* [] */0; + return /* () */0; + } + }; +} + function copyAuxWithMap(f, _cellX, _prec) { while(true) { var prec = _prec; @@ -113,6 +172,34 @@ function copyAuxWithMap(f, _cellX, _prec) { }; } +function copyAuxWithMap2(f, _cellX, _cellY, _prec) { + while(true) { + var prec = _prec; + var cellY = _cellY; + var cellX = _cellX; + if (cellX) { + if (cellY) { + var next = /* :: */[ + f(cellX[0], cellY[0]), + /* [] */0 + ]; + prec[1] = next; + _prec = next; + _cellY = cellY[1]; + _cellX = cellX[1]; + continue ; + + } else { + prec[1] = /* [] */0; + return /* () */0; + } + } else { + prec[1] = /* [] */0; + return /* () */0; + } + }; +} + function copyAuxWithMapI(f, _i, _cellX, _prec) { while(true) { var prec = _prec; @@ -162,6 +249,23 @@ function map(xs, f) { } } +function map2(f, l1, l2) { + if (l1) { + if (l2) { + var cell = /* :: */[ + f(l1[0], l2[0]), + /* [] */0 + ]; + copyAuxWithMap2(f, l1[1], l2[1], cell); + return cell; + } else { + return /* [] */0; + } + } else { + return /* [] */0; + } +} + function mapi(f, param) { if (param) { var cell = /* :: */[ @@ -303,16 +407,14 @@ function flatten(_xs) { }; } -function rev_map(f, l) { - var _accu = /* [] */0; - var _param = l; +function mapRevAux(f, _accu, _xs) { while(true) { - var param = _param; + var xs = _xs; var accu = _accu; - if (param) { - _param = param[1]; + if (xs) { + _xs = xs[1]; _accu = /* :: */[ - f(param[0]), + f(xs[0]), accu ]; continue ; @@ -323,6 +425,10 @@ function rev_map(f, l) { }; } +function mapRev(f, l) { + return mapRevAux(f, /* [] */0, l); +} + function iter(f, _param) { while(true) { var param = _param; @@ -356,7 +462,7 @@ function iteri(f, l) { }; } -function fold_left(f, _accu, _l) { +function foldLeft(f, _accu, _l) { while(true) { var l = _l; var accu = _accu; @@ -371,61 +477,42 @@ function fold_left(f, _accu, _l) { }; } -function fold_right(f, l, accu) { +function foldRight(f, l, accu) { if (l) { - return f(l[0], fold_right(f, l[1], accu)); + return f(l[0], foldRight(f, l[1], accu)); } else { return accu; } } -function map2(f, l1, l2) { - if (l1) { - if (l2) { - var r = f(l1[0], l2[0]); - return /* :: */[ - r, - map2(f, l1[1], l2[1]) - ]; - } else { - throw new Error("List.map2"); - } - } else if (l2) { - throw new Error("List.map2"); - } else { - return /* [] */0; - } -} - -function rev_map2(f, l1, l2) { - var _accu = /* [] */0; - var _l1 = l1; - var _l2 = l2; +function mapRevAux2(f, _accu, _l1, _l2) { while(true) { - var l2$1 = _l2; - var l1$1 = _l1; + var l2 = _l2; + var l1 = _l1; var accu = _accu; - if (l1$1) { - if (l2$1) { - _l2 = l2$1[1]; - _l1 = l1$1[1]; + if (l1) { + if (l2) { + _l2 = l2[1]; + _l1 = l1[1]; _accu = /* :: */[ - f(l1$1[0], l2$1[0]), + f(l1[0], l2[0]), accu ]; continue ; } else { - throw new Error("List.rev_map2"); + return /* [] */0; } - } else if (l2$1) { - throw new Error("List.rev_map2"); } else { - return accu; + return /* [] */0; } }; } +function mapRev2(f, l1, l2) { + return mapRevAux2(f, /* [] */0, l1, l2); +} + function iter2(f, _l1, _l2) { while(true) { var l2 = _l2; @@ -438,17 +525,15 @@ function iter2(f, _l1, _l2) { continue ; } else { - throw new Error("List.iter2"); + return /* () */0; } - } else if (l2) { - throw new Error("List.iter2"); } else { return /* () */0; } }; } -function fold_left2(f, _accu, _l1, _l2) { +function foldLeft2(f, _accu, _l1, _l2) { while(true) { var l2 = _l2; var l1 = _l1; @@ -461,31 +546,23 @@ function fold_left2(f, _accu, _l1, _l2) { continue ; } else { - throw new Error("List.fold_left2"); + return accu; } - } else if (l2) { - throw new Error("List.fold_left2"); } else { return accu; } }; } -function fold_right2(f, l1, l2, accu) { - if (l1) { - if (l2) { - return f(l1[0], l2[0], fold_right2(f, l1[1], l2[1], accu)); - } else { - throw new Error("List.fold_right2"); - } - } else if (l2) { - throw new Error("List.fold_right2"); +function foldRight2(f, l1, l2, accu) { + if (l1 && l2) { + return f(l1[0], l2[0], foldRight2(f, l1[1], l2[1], accu)); } else { return accu; } } -function for_all(p, _param) { +function forAll(p, _param) { while(true) { var param = _param; if (param) { @@ -519,7 +596,7 @@ function exists(p, _param) { }; } -function for_all2(p, _l1, _l2) { +function forAll2(p, _l1, _l2) { while(true) { var l2 = _l2; var l1 = _l1; @@ -534,10 +611,8 @@ function for_all2(p, _l1, _l2) { return /* false */0; } } else { - throw new Error("List.for_all2"); + return /* true */1; } - } else if (l2) { - throw new Error("List.for_all2"); } else { return /* true */1; } @@ -559,10 +634,8 @@ function exists2(p, _l1, _l2) { } } else { - throw new Error("List.exists2"); + return /* false */0; } - } else if (l2) { - throw new Error("List.exists2"); } else { return /* false */0; } @@ -603,43 +676,43 @@ function memq(x, _param) { }; } -function assoc(eq, x, _param) { +function assocOpt(eq, x, _param) { while(true) { var param = _param; if (param) { var match = param[0]; if (eq(match[0], x)) { - return match[1]; + return /* Some */[match[1]]; } else { _param = param[1]; continue ; } } else { - throw Caml_builtin_exceptions.not_found; + return /* None */0; } }; } -function assq(x, _param) { +function assqOpt(x, _param) { while(true) { var param = _param; if (param) { var match = param[0]; if (match[0] === x) { - return match[1]; + return /* Some */[match[1]]; } else { _param = param[1]; continue ; } } else { - throw Caml_builtin_exceptions.not_found; + return /* None */0; } }; } -function mem_assoc(eq, x, _param) { +function memAssoc(eq, x, _param) { while(true) { var param = _param; if (param) { @@ -656,7 +729,7 @@ function mem_assoc(eq, x, _param) { }; } -function mem_assq(x, _param) { +function memAssq(x, _param) { while(true) { var param = _param; if (param) { @@ -673,7 +746,7 @@ function mem_assq(x, _param) { }; } -function remove_assoc(eq, x, param) { +function removeAssoc(eq, x, param) { if (param) { var l = param[1]; var pair = param[0]; @@ -682,7 +755,7 @@ function remove_assoc(eq, x, param) { } else { return /* :: */[ pair, - remove_assoc(eq, x, l) + removeAssoc(eq, x, l) ]; } } else { @@ -690,7 +763,7 @@ function remove_assoc(eq, x, param) { } } -function remove_assq(x, param) { +function removeAssq(x, param) { if (param) { var l = param[1]; var pair = param[0]; @@ -699,7 +772,7 @@ function remove_assq(x, param) { } else { return /* :: */[ pair, - remove_assq(x, l) + removeAssq(x, l) ]; } } else { @@ -707,89 +780,78 @@ function remove_assq(x, param) { } } -function find(p, _param) { +function findOpt(p, _param) { while(true) { var param = _param; if (param) { var x = param[0]; if (p(x)) { - return x; + return /* Some */[x]; } else { _param = param[1]; continue ; } } else { - throw Caml_builtin_exceptions.not_found; + return /* None */0; } }; } -function find_all(p) { - return (function (param) { - var _accu = /* [] */0; - var _param = param; - while(true) { - var param$1 = _param; - var accu = _accu; - if (param$1) { - var l = param$1[1]; - var x = param$1[0]; - if (p(x)) { - _param = l; - _accu = /* :: */[ - x, - accu - ]; - continue ; - - } else { - _param = l; - continue ; - - } - } else { - return revAppend(accu, /* [] */0); - } - }; - }); -} - -function partition(p, l) { - var _yes = /* [] */0; - var _no = /* [] */0; - var _param = l; +function filter(p, _xs) { while(true) { - var param = _param; - var no = _no; - var yes = _yes; - if (param) { - var l$1 = param[1]; - var x = param[0]; - if (p(x)) { - _param = l$1; - _yes = /* :: */[ - x, - yes + var xs = _xs; + if (xs) { + var t = xs[1]; + var h = xs[0]; + if (p(h)) { + var cell = /* :: */[ + h, + /* [] */0 ]; - continue ; - + copyAuxWitFilter(p, t, cell); + return cell; } else { - _param = l$1; - _no = /* :: */[ - x, - no - ]; + _xs = t; continue ; } + } else { + return /* [] */0; + } + }; +} + +function partition(p, l) { + if (l) { + var h = l[0]; + var nextX = /* :: */[ + h, + /* [] */0 + ]; + var nextY = /* :: */[ + h, + /* [] */0 + ]; + var b = p(h); + partitionAux(p, l[1], nextX, nextY); + if (b) { + return /* tuple */[ + nextX, + nextY[1] + ]; } else { return /* tuple */[ - revAppend(yes, /* [] */0), - revAppend(no, /* [] */0) + nextX[1], + nextY ]; } - }; + } else { + return /* tuple */[ + /* [] */0, + /* [] */0 + ]; + } } function split(param) { @@ -1749,65 +1811,67 @@ function sort_uniq(cmp, l) { } } -var filter = find_all; - var sort = stable_sort; var fast_sort = stable_sort; -exports.headOpt = headOpt; -exports.tailOpt = tailOpt; -exports.nthAux = nthAux; -exports.nthAuxAssert = nthAuxAssert; -exports.nthOpt = nthOpt; -exports.nthAssert = nthAssert; -exports.copyAux = copyAux; -exports.copyAuxWithMap = copyAuxWithMap; -exports.copyAuxWithMapI = copyAuxWithMapI; -exports.append = append; -exports.map = map; -exports.mapi = mapi; -exports.init = init; -exports.lengthAux = lengthAux; -exports.length = length; -exports.fillAux = fillAux; -exports.toArray = toArray; -exports.revAppend = revAppend; -exports.rev = rev; -exports.flattenAux = flattenAux; -exports.flatten = flatten; -exports.rev_map = rev_map; -exports.iter = iter; -exports.iteri = iteri; -exports.fold_left = fold_left; -exports.fold_right = fold_right; -exports.map2 = map2; -exports.rev_map2 = rev_map2; -exports.iter2 = iter2; -exports.fold_left2 = fold_left2; -exports.fold_right2 = fold_right2; -exports.for_all = for_all; -exports.exists = exists; -exports.for_all2 = for_all2; -exports.exists2 = exists2; -exports.mem = mem; -exports.memq = memq; -exports.assoc = assoc; -exports.assq = assq; -exports.mem_assoc = mem_assoc; -exports.mem_assq = mem_assq; -exports.remove_assoc = remove_assoc; -exports.remove_assq = remove_assq; -exports.find = find; -exports.find_all = find_all; -exports.filter = filter; -exports.partition = partition; -exports.split = split; -exports.combine = combine; -exports.merge = merge; -exports.chop = chop; -exports.stable_sort = stable_sort; -exports.sort = sort; -exports.fast_sort = fast_sort; -exports.sort_uniq = sort_uniq; +exports.headOpt = headOpt; +exports.tailOpt = tailOpt; +exports.nthAux = nthAux; +exports.nthAuxAssert = nthAuxAssert; +exports.nthOpt = nthOpt; +exports.nthAssert = nthAssert; +exports.partitionAux = partitionAux; +exports.copyAux = copyAux; +exports.copyAuxWitFilter = copyAuxWitFilter; +exports.copyAuxWithMap = copyAuxWithMap; +exports.copyAuxWithMap2 = copyAuxWithMap2; +exports.copyAuxWithMapI = copyAuxWithMapI; +exports.append = append; +exports.map = map; +exports.map2 = map2; +exports.mapi = mapi; +exports.init = init; +exports.lengthAux = lengthAux; +exports.length = length; +exports.fillAux = fillAux; +exports.toArray = toArray; +exports.revAppend = revAppend; +exports.rev = rev; +exports.flattenAux = flattenAux; +exports.flatten = flatten; +exports.mapRevAux = mapRevAux; +exports.mapRev = mapRev; +exports.iter = iter; +exports.iteri = iteri; +exports.foldLeft = foldLeft; +exports.foldRight = foldRight; +exports.mapRevAux2 = mapRevAux2; +exports.mapRev2 = mapRev2; +exports.iter2 = iter2; +exports.foldLeft2 = foldLeft2; +exports.foldRight2 = foldRight2; +exports.forAll = forAll; +exports.exists = exists; +exports.forAll2 = forAll2; +exports.exists2 = exists2; +exports.mem = mem; +exports.memq = memq; +exports.assocOpt = assocOpt; +exports.assqOpt = assqOpt; +exports.memAssoc = memAssoc; +exports.memAssq = memAssq; +exports.removeAssoc = removeAssoc; +exports.removeAssq = removeAssq; +exports.findOpt = findOpt; +exports.filter = filter; +exports.partition = partition; +exports.split = split; +exports.combine = combine; +exports.merge = merge; +exports.chop = chop; +exports.stable_sort = stable_sort; +exports.sort = sort; +exports.fast_sort = fast_sort; +exports.sort_uniq = sort_uniq; /* No side effect */ From 3aa4fde4244b385a90901ba29d282bbfac0b4c74 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sun, 24 Dec 2017 12:06:06 +0800 Subject: [PATCH 4/7] more api tests --- jscomp/others/.depend | 3 +- jscomp/others/bs_List.ml | 325 ++------ jscomp/others/bs_List.mli | 109 +++ jscomp/test/bs_link_list_test.js | 382 +++++++++ jscomp/test/bs_link_list_test.ml | 52 ++ lib/js/bs_List.js | 1252 +++++------------------------- 6 files changed, 804 insertions(+), 1319 deletions(-) create mode 100644 jscomp/others/bs_List.mli diff --git a/jscomp/others/.depend b/jscomp/others/.depend index 36e7d90338..81ed02c640 100644 --- a/jscomp/others/.depend +++ b/jscomp/others/.depend @@ -24,7 +24,7 @@ bs_Hash.cmj : bs_Hash.cmi bs_Queue.cmj : bs_Array.cmj bs_Queue.cmi bs_internalLinkList.cmj : bs_LinkList.cmj : bs_Array.cmj bs.cmj -bs_List.cmj : bs_Array.cmj +bs_List.cmj : bs_Array.cmj bs_List.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 @@ -71,6 +71,7 @@ js_mapperRt.cmi : bs_Array.cmi : bs_Hash.cmi : bs_Queue.cmi : +bs_List.cmi : bs_HashMap.cmi : bs_Hash.cmi bs_Bag.cmj bs_HashSet.cmi : bs_Hash.cmi bs_Bag.cmj bs_HashSetString.cmi : diff --git a/jscomp/others/bs_List.ml b/jscomp/others/bs_List.ml index 9cecd4b619..ef8980549d 100644 --- a/jscomp/others/bs_List.ml +++ b/jscomp/others/bs_List.ml @@ -1,3 +1,26 @@ +(* 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. *) (* @@ -40,14 +63,22 @@ type 'a t = 'a list external mutableCell : 'a -> 'a t -> 'a t = "#makemutablelist" +(* + [mutableCell x []] == [x] + but tell the compiler that is a mutable cell, so it wont + be mis-inlined in the future + dont inline a binding to mutable cell, it is mutable +*) external unsafeMutateTail : 'a t -> 'a t -> unit = "#setfield1" +(* + - the cell is not empty + - it is mutated +*) external unsafeTail : 'a t -> 'a t = "%field1" (* - [mutableCell x] == [x] - but tell the compiler that is a mutable cell, so it wont - be mis-inlined in the future + - the cell is not empty *) let headOpt x = @@ -79,10 +110,6 @@ let nthAssert x n = if n < 0 then [%assert "nthAssert"] else nthAuxAssert x n -(* [precX] or [precY] can be empty - in that case, the address may change, so we need - return some value -*) let rec partitionAux p cell precX precY = match cell with | [] -> () @@ -99,20 +126,26 @@ let rec partitionAux p cell precX precY = partitionAux p t precX next end - - - -(* return the tail *) -let rec copyAux cellX prec = +let rec splitAux cell precX precY = + match cell with + | [] -> () + | (a,b)::t -> + let nextA = mutableCell a [] in + let nextB = mutableCell b [] in + unsafeMutateTail precX nextA; + unsafeMutateTail precY nextB; + splitAux t nextA nextB + +(* return the tail pointer so it can continue copy other + list +*) +let rec copyAuxCont cellX prec = match cellX with | [] -> prec | h::t -> let next = mutableCell h [] in - (* here the mutable is mostly to telling compilers - dont inline [next], it is mutable - *) unsafeMutateTail prec next ; - copyAux t next + copyAuxCont t next let rec copyAuxWitFilter f cellX prec = match cellX with @@ -137,6 +170,15 @@ let rec copyAuxWithMap f cellX prec = copyAuxWithMap f t next +let rec zipAux cellX cellY prec = + match cellX, cellY with + | h1::t1, h2::t2 -> + let next = mutableCell ( h1, h2) [] in + unsafeMutateTail prec next ; + zipAux t1 t2 next + | [],_ | _,[] -> + () + let rec copyAuxWithMap2 f cellX cellY prec = match cellX, cellY with | h1::t1, h2::t2 -> @@ -160,7 +202,7 @@ let append xs ys = | [] -> ys | h::t -> let cell = mutableCell h [] in - unsafeMutateTail (copyAux t cell) ys; + unsafeMutateTail (copyAuxCont t cell) ys; cell let map xs f = @@ -236,7 +278,7 @@ let rev l = revAppend l [] let rec flattenAux prec xs = match xs with | [] -> unsafeMutateTail prec [] - | h::r -> flattenAux (copyAux h prec) r + | h::r -> flattenAux (copyAuxCont h prec) r let rec flatten xs = @@ -245,7 +287,7 @@ let rec flatten xs = | []::xs -> flatten xs | (h::t):: r -> let cell = mutableCell h [] in - flattenAux (copyAux t cell) r ; + flattenAux (copyAuxCont t cell) r ; cell @@ -391,237 +433,22 @@ let partition p l = unsafeTail nextX, nextY -let rec split = function - [] -> ([], []) +let rec split xs = + match xs with + | [] -> ([], []) | (x,y)::l -> - let (rx, ry) = split l in (x::rx, y::ry) + let cellX = mutableCell x [] in + let cellY = mutableCell y [] in + splitAux l cellX cellY ; + cellX, cellY + -let rec combine l1 l2 = +let rec zip l1 l2 = match (l1, l2) with - ([], []) -> [] - | (a1::l1, a2::l2) -> (a1, a2) :: combine l1 l2 - | (_, _) -> [%assert "List.combine"] - -(** sorting *) - -let rec merge cmp l1 l2 = - match l1, l2 with - | [], l2 -> l2 - | l1, [] -> l1 - | h1 :: t1, h2 :: t2 -> - if cmp h1 h2 [@bs] <= 0 - then h1 :: merge cmp t1 l2 - else h2 :: merge cmp l1 t2 -;; - -let rec chop k l = - if k = 0 then l else begin - match l with - | x::t -> chop (k-1) t - | _ -> assert false - end -;; - -let stable_sort cmp l = - let rec rev_merge l1 l2 accu = - match l1, l2 with - | [], l2 -> revAppend l2 accu - | l1, [] -> revAppend l1 accu - | h1::t1, h2::t2 -> - if cmp h1 h2 [@bs] <= 0 - then rev_merge t1 l2 (h1::accu) - else rev_merge l1 t2 (h2::accu) - in - let rec rev_merge_rev l1 l2 accu = - match l1, l2 with - | [], l2 -> revAppend l2 accu - | l1, [] -> revAppend l1 accu - | h1::t1, h2::t2 -> - if cmp h1 h2 [@bs] > 0 - then rev_merge_rev t1 l2 (h1::accu) - else rev_merge_rev l1 t2 (h2::accu) - in - let rec sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - if cmp x1 x2 [@bs] <= 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - if cmp x1 x2 [@bs] <= 0 then begin - if cmp x2 x3 [@bs] <= 0 then [x1; x2; x3] - else if cmp x1 x3 [@bs] <= 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - if cmp x1 x3 [@bs] <= 0 then [x2; x1; x3] - else if cmp x2 x3 [@bs] <= 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = rev_sort n1 l in - let s2 = rev_sort n2 l2 in - rev_merge_rev s1 s2 [] - and rev_sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - if cmp x1 x2 [@bs] > 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - if cmp x1 x2 [@bs] > 0 then begin - if cmp x2 x3 [@bs] > 0 then [x1; x2; x3] - else if cmp x1 x3 [@bs] > 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - if cmp x1 x3 [@bs] > 0 then [x2; x1; x3] - else if cmp x2 x3 [@bs] > 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = sort n1 l in - let s2 = sort n2 l2 in - rev_merge s1 s2 [] - in - let len = length l in - if len < 2 then l else sort len l -;; - -let sort = stable_sort;; -let fast_sort = stable_sort;; - -(* Note: on a list of length between about 100000 (depending on the minor - heap size and the type of the list) and Sys.max_array_size, it is - actually faster to use the following, but it might also use more memory - because the argument list cannot be deallocated incrementally. - - Also, there seems to be a bug in this code or in the - implementation of obj_truncate. - - external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate" - - let array_to_list_in_place a = - let l = Array.length a in - let rec loop accu n p = - if p <= 0 then accu else begin - if p = n then begin - obj_truncate a p; - loop (a.(p-1) :: accu) (n-1000) (p-1) - end else begin - loop (a.(p-1) :: accu) n (p-1) - end - end - in - loop [] (l-1000) l - ;; - - let stable_sort cmp l = - let a = Array.of_list l in - Array.stable_sort cmp a; - array_to_list_in_place a - ;; -*) - + _, [] | [], _ -> [] + | (a1::l1, a2::l2) -> + let cell = mutableCell (a1,a2) [] in + zipAux l1 l2 cell; + cell -(** sorting + removing duplicates *) - -let sort_uniq cmp l = - let rec rev_merge l1 l2 accu = - match l1, l2 with - | [], l2 -> revAppend l2 accu - | l1, [] -> revAppend l1 accu - | h1::t1, h2::t2 -> - let c = cmp h1 h2 [@bs] in - if c = 0 then rev_merge t1 t2 (h1::accu) - else if c < 0 - then rev_merge t1 l2 (h1::accu) - else rev_merge l1 t2 (h2::accu) - in - let rec rev_merge_rev l1 l2 accu = - match l1, l2 with - | [], l2 -> revAppend l2 accu - | l1, [] -> revAppend l1 accu - | h1::t1, h2::t2 -> - let c = cmp h1 h2 [@bs] in - if c = 0 then rev_merge_rev t1 t2 (h1::accu) - else if c > 0 - then rev_merge_rev t1 l2 (h1::accu) - else rev_merge_rev l1 t2 (h2::accu) - in - let rec sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - let c = cmp x1 x2 [@bs] in - if c = 0 then [x1] - else if c < 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - let c = cmp x1 x2 [@bs] in - if c = 0 then begin - let c = cmp x2 x3 [@bs] in - if c = 0 then [x2] - else if c < 0 then [x2; x3] else [x3; x2] - end else if c < 0 then begin - let c = cmp x2 x3 [@bs] in - if c = 0 then [x1; x2] - else if c < 0 then [x1; x2; x3] - else let c = cmp x1 x3 [@bs] in - if c = 0 then [x1; x2] - else if c < 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - let c = cmp x1 x3 [@bs] in - if c = 0 then [x2; x1] - else if c < 0 then [x2; x1; x3] - else let c = cmp x2 x3 [@bs] in - if c = 0 then [x2; x1] - else if c < 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = rev_sort n1 l in - let s2 = rev_sort n2 l2 in - rev_merge_rev s1 s2 [] - and rev_sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - let c = cmp x1 x2 [@bs] in - if c = 0 then [x1] - else if c > 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - let c = cmp x1 x2 [@bs] in - if c = 0 then begin - let c = cmp x2 x3 [@bs] in - if c = 0 then [x2] - else if c > 0 then [x2; x3] else [x3; x2] - end else if c > 0 then begin - let c = cmp x2 x3 [@bs] in - if c = 0 then [x1; x2] - else if c > 0 then [x1; x2; x3] - else let c = cmp x1 x3 [@bs] in - if c = 0 then [x1; x2] - else if c > 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - let c = cmp x1 x3 [@bs] in - if c = 0 then [x2; x1] - else if c > 0 then [x2; x1; x3] - else let c = cmp x2 x3 [@bs] in - if c = 0 then [x2; x1] - else if c > 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = sort n1 l in - let s2 = sort n2 l2 in - rev_merge s1 s2 [] - in - let len = length l in - if len < 2 then l else sort len l -;; +(* TODO: add take/drop*) \ No newline at end of file diff --git a/jscomp/others/bs_List.mli b/jscomp/others/bs_List.mli new file mode 100644 index 0000000000..4616abb5c3 --- /dev/null +++ b/jscomp/others/bs_List.mli @@ -0,0 +1,109 @@ +(* 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 t = 'a list + +val headOpt : 'a list -> 'a option + +val tailOpt : 'a list -> 'a list option + +val nthOpt : 'a list -> int -> 'a option + +val nthAssert : 'a list -> int -> 'a + +val append : 'a list -> 'a t -> 'a t + +val map : 'a list -> ('a -> 'b [@bs]) -> 'b t + +val map2 : ('a -> 'b -> 'c [@bs]) -> 'a list -> 'b list -> 'c t + +val mapi : (int -> 'a -> 'b [@bs]) -> 'a list -> 'b t + +val init : int -> (int -> 'a [@bs]) -> 'a t + +val length : 'a list -> int + +val toArray : 'a t -> 'a array + +val revAppend : 'a list -> 'a list -> 'a list + +val rev : 'a list -> 'a list + + +val flatten : 'a list list -> 'a t + +val mapRev : ('a -> 'b [@bs]) -> 'a list -> 'b list + +val iter : ('a -> 'b [@bs]) -> 'a list -> unit + +val iteri : (int -> 'a -> 'b [@bs]) -> 'a list -> unit + +val foldLeft : ('a -> 'b -> 'a [@bs]) -> 'a -> 'b list -> 'a + +val foldRight : ('a -> 'b -> 'b [@bs]) -> 'a list -> 'b -> 'b + +val mapRev2 : ('a -> 'b -> 'c [@bs]) -> 'a list -> 'b list -> 'd list + +val iter2 : ('a -> 'b -> 'c [@bs]) -> 'a list -> 'b list -> unit + +val foldLeft2 : + ('a -> 'b -> 'c -> 'a [@bs]) -> 'a -> 'b list -> 'c list -> 'a + +val foldRight2 : + ('a -> 'b -> 'c -> 'c [@bs]) -> 'a list -> 'b list -> 'c -> 'c + +val forAll : ('a -> bool [@bs]) -> 'a list -> bool + +val exists : ('a -> bool [@bs]) -> 'a list -> bool + +val forAll2 : ('a -> 'b -> bool [@bs]) -> 'a list -> 'b list -> bool + +val exists2 : ('a -> 'b -> bool [@bs]) -> 'a list -> 'b list -> bool + +val mem : ('a -> 'b -> bool [@bs]) -> 'b -> 'a list -> bool + +val memq : 'a -> 'a list -> bool + +val assocOpt : ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) list -> 'c option + +val assqOpt : 'a -> ('a * 'b) list -> 'b option + +val memAssoc : ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) list -> bool + +val memAssq : 'a -> ('a * 'b) list -> bool + +val removeAssoc : + ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) list -> ('a * 'c) list + +val removeAssq : 'a -> ('a * 'b) list -> ('a * 'b) list + +val findOpt : ('a -> bool [@bs]) -> 'a list -> 'a option + +val filter : ('a -> bool [@bs]) -> 'a list -> 'a t + +val partition : ('a -> bool [@bs]) -> 'a list -> 'a t * 'a t + +val split : ('a * 'b) list -> 'a t * 'b t + +val zip : 'a list -> 'b list -> ('a * 'b) t diff --git a/jscomp/test/bs_link_list_test.js b/jscomp/test/bs_link_list_test.js index 205722d0f5..b4c0d2d2eb 100644 --- a/jscomp/test/bs_link_list_test.js +++ b/jscomp/test/bs_link_list_test.js @@ -131,6 +131,385 @@ eq("File \"bs_link_list_test.ml\", line 37, characters 5-12", Bs_List.toArray(Bs return i; })))); +eq("ZIP", Bs_List.zip(/* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* [] */0 + ] + ] + ], /* :: */[ + 3, + /* :: */[ + 4, + /* [] */0 + ] + ]), /* :: */[ + /* tuple */[ + 1, + 3 + ], + /* :: */[ + /* tuple */[ + 2, + 4 + ], + /* [] */0 + ] + ]); + +eq("ZIP", Bs_List.zip(/* [] */0, /* :: */[ + 1, + /* [] */0 + ]), /* [] */0); + +eq("ZIP", Bs_List.zip(/* [] */0, /* [] */0), /* [] */0); + +eq("ZIP", Bs_List.zip(/* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* [] */0 + ] + ] + ], /* [] */0), /* [] */0); + +eq("ZIP", Bs_List.zip(/* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* [] */0 + ] + ] + ], /* :: */[ + 2, + /* :: */[ + 3, + /* :: */[ + 4, + /* [] */0 + ] + ] + ]), /* :: */[ + /* tuple */[ + 1, + 2 + ], + /* :: */[ + /* tuple */[ + 2, + 3 + ], + /* :: */[ + /* tuple */[ + 3, + 4 + ], + /* [] */0 + ] + ] + ]); + +function mod2(x) { + return +(x % 2 === 0); +} + +eq("PARTITION", Bs_List.partition(mod2, /* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* :: */[ + 2, + /* :: */[ + 3, + /* :: */[ + 4, + /* [] */0 + ] + ] + ] + ] + ] + ]), /* tuple */[ + /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 4, + /* [] */0 + ] + ] + ], + /* :: */[ + 1, + /* :: */[ + 3, + /* :: */[ + 3, + /* [] */0 + ] + ] + ] + ]); + +eq("PARTITION", Bs_List.partition(mod2, /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 4, + /* [] */0 + ] + ] + ] + ]), /* tuple */[ + /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 4, + /* [] */0 + ] + ] + ] + ], + /* [] */0 + ]); + +eq("PARTITION", Bs_List.partition((function (x) { + return 1 - mod2(x); + }), /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 4, + /* [] */0 + ] + ] + ] + ]), /* tuple */[ + /* [] */0, + /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 4, + /* [] */0 + ] + ] + ] + ] + ]); + +eq("SPLIT", Bs_List.split(/* [] */0), /* tuple */[ + /* [] */0, + /* [] */0 + ]); + +eq("SPLIT", Bs_List.split(/* :: */[ + /* tuple */[ + 1, + 2 + ], + /* [] */0 + ]), /* tuple */[ + /* :: */[ + 1, + /* [] */0 + ], + /* :: */[ + 2, + /* [] */0 + ] + ]); + +eq("SPLIT", Bs_List.split(/* :: */[ + /* tuple */[ + 1, + 2 + ], + /* :: */[ + /* tuple */[ + 3, + 4 + ], + /* [] */0 + ] + ]), /* tuple */[ + /* :: */[ + 1, + /* :: */[ + 3, + /* [] */0 + ] + ], + /* :: */[ + 2, + /* :: */[ + 4, + /* [] */0 + ] + ] + ]); + +eq("FILTER", Bs_List.filter(mod2, /* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* :: */[ + 4, + /* [] */0 + ] + ] + ] + ]), /* :: */[ + 2, + /* :: */[ + 4, + /* [] */0 + ] + ]); + +eq("FILTER", Bs_List.filter(mod2, /* :: */[ + 1, + /* :: */[ + 3, + /* :: */[ + 41, + /* [] */0 + ] + ] + ]), /* [] */0); + +eq("FILTER", Bs_List.filter(mod2, /* [] */0), /* [] */0); + +eq("FILTER", Bs_List.filter(mod2, /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 4, + /* :: */[ + 6, + /* [] */0 + ] + ] + ] + ] + ]), /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 2, + /* :: */[ + 4, + /* :: */[ + 6, + /* [] */0 + ] + ] + ] + ] + ]); + +function id(x) { + return x; +} + +eq("MAP", Bs_List.map(Bs_List.init(5, id), (function (x) { + return (x << 1); + })), /* :: */[ + 0, + /* :: */[ + 2, + /* :: */[ + 4, + /* :: */[ + 6, + /* :: */[ + 8, + /* [] */0 + ] + ] + ] + ] + ]); + +eq("MAP", Bs_List.map(/* [] */0, id), /* [] */0); + +eq("MAP", Bs_List.map(/* :: */[ + 1, + /* [] */0 + ], (function (x) { + return -x | 0; + })), /* :: */[ + -1, + /* [] */0 + ]); + +function add(a, b) { + return a + b | 0; +} + +var a = Bs_List.init(10, id); + +var b$1 = Bs_List.init(10, id); + +var c = Bs_List.init(8, id); + +var d = Bs_List.init(10, (function (x) { + return (x << 1); + })); + +eq("MAP2", Bs_List.map2(add, a, b$1), d); + +eq("MAP2", Bs_List.map2(add, /* [] */0, /* :: */[ + 1, + /* [] */0 + ]), /* [] */0); + +eq("MAP2", Bs_List.map2(add, /* :: */[ + 1, + /* [] */0 + ], /* [] */0), /* [] */0); + +eq("MAP2", Bs_List.map2(add, /* [] */0, /* [] */0), /* [] */0); + +eq("MAP2", Bs_List.map2(add, a, b$1), Bs_List.append(Bs_List.map(c, (function (x) { + return (x << 1); + })), /* :: */[ + 16, + /* :: */[ + 18, + /* [] */0 + ] + ])); + Mt.from_pair_suites("bs_link_list_test.ml", suites[0]); var N = 0; @@ -143,4 +522,7 @@ exports.eq = eq; exports.b = b; exports.N = N; exports.A = A; +exports.mod2 = mod2; +exports.id = id; +exports.add = add; /* u Not a pure module */ diff --git a/jscomp/test/bs_link_list_test.ml b/jscomp/test/bs_link_list_test.ml index 1798c81ba9..d316785dd9 100644 --- a/jscomp/test/bs_link_list_test.ml +++ b/jscomp/test/bs_link_list_test.ml @@ -48,4 +48,56 @@ let () = (init 100 (fun [@bs] i -> i))) ) +let () = + let (=~) = eq "ZIP" in + + (N.zip [1;2;3] [3;4]) =~ [1,3; 2,4]; + N.zip [] [1] =~ []; + N.zip [] [] =~ []; + N.zip [1;2;3] [] =~ [] ; + N.zip [1;2;3] [2;3;4] =~ [1,2;2,3;3,4] +let mod2 = (fun[@bs] x -> x mod 2 = 0) +let () = + let (=~) = eq "PARTITION" in + + (N.partition mod2 [1;2;3;2;3;4]) + =~ ([2;2;4], [1;3;3]); + (N.partition mod2 [2;2;2;4]) + =~ ([2;2;2;4], []); + (N.partition (fun[@bs] x -> not (mod2 x [@bs] )) [2;2;2;4]) + =~ ([], [2;2;2;4]) + +let () = + let (=~) = eq "SPLIT" in + N.split [] =~ ([],[]) ; + N.split [1,2] =~ ([1] ,[2]); + N.split [1,2;3,4] =~ ([1;3], [2;4]) + +let () = + let (=~) = eq "FILTER" in + N.filter mod2 [1;2;3;4] =~ [2;4]; + N.filter mod2 [1;3;41] =~ []; + N.filter mod2 [] =~ []; + N.filter mod2 [2;2;2;4;6] =~ [2;2;2;4;6] +let id : int -> int [@bs] = fun [@bs] x -> x + +let () = + let (=~) = eq "MAP" in + N.map (N.init 5 id )(fun [@bs] x -> x * 2 ) + =~ [0;2;4;6;8]; + N.map [] id =~ []; + N.map [1] (fun [@bs] x-> -x) =~ [-1] +let add = (fun [@bs] a b -> a + b) +let () = + let (=~) = eq "MAP2" in + let a = N.init 10 id in + let b = N.init 10 id in + let c = N.init 8 id in + let d = N.init 10 (fun [@bs] x -> 2 * x ) in + N.map2 add a b =~ d ; + N.map2 add [] [1] =~ []; + N.map2 add [1] [] =~ []; + N.map2 add [] [] =~ []; + N.map2 add a b =~ N.(append (map c (fun[@bs] x -> x * 2)) [16;18]) + ;; Mt.from_pair_suites __FILE__ !suites diff --git a/lib/js/bs_List.js b/lib/js/bs_List.js index 6272efefcf..5d19959626 100644 --- a/lib/js/bs_List.js +++ b/lib/js/bs_List.js @@ -17,49 +17,28 @@ function tailOpt(x) { } } -function nthAux(_x, _n) { - while(true) { - var n = _n; - var x = _x; - if (x) { - if (n) { - _n = n - 1 | 0; - _x = x[1]; - continue ; - - } else { - return /* Some */[x[0]]; - } - } else { - return /* None */0; - } - }; -} - -function nthAuxAssert(_x, _n) { - while(true) { - var n = _n; - var x = _x; - if (x) { - if (n) { - _n = n - 1 | 0; - _x = x[1]; - continue ; - - } else { - return x[0]; - } - } else { - throw new Error("nthAssert"); - } - }; -} - function nthOpt(x, n) { if (n < 0) { return /* None */0; } else { - return nthAux(x, n); + var _x = x; + var _n = n; + while(true) { + var n$1 = _n; + var x$1 = _x; + if (x$1) { + if (n$1) { + _n = n$1 - 1 | 0; + _x = x$1[1]; + continue ; + + } else { + return /* Some */[x$1[0]]; + } + } else { + return /* None */0; + } + }; } } @@ -67,7 +46,24 @@ function nthAssert(x, n) { if (n < 0) { throw new Error("nthAssert"); } else { - return nthAuxAssert(x, n); + var _x = x; + var _n = n; + while(true) { + var n$1 = _n; + var x$1 = _x; + if (x$1) { + if (n$1) { + _n = n$1 - 1 | 0; + _x = x$1[1]; + continue ; + + } else { + return x$1[0]; + } + } else { + throw new Error("nthAssert"); + } + }; } } @@ -102,7 +98,35 @@ function partitionAux(p, _cell, _precX, _precY) { }; } -function copyAux(_cellX, _prec) { +function splitAux(_cell, _precX, _precY) { + while(true) { + var precY = _precY; + var precX = _precX; + var cell = _cell; + if (cell) { + var match = cell[0]; + var nextA = /* :: */[ + match[0], + /* [] */0 + ]; + var nextB = /* :: */[ + match[1], + /* [] */0 + ]; + precX[1] = nextA; + precY[1] = nextB; + _precY = nextB; + _precX = nextA; + _cell = cell[1]; + continue ; + + } else { + return /* () */0; + } + }; +} + +function copyAuxCont(_cellX, _prec) { while(true) { var prec = _prec; var cellX = _cellX; @@ -172,6 +196,35 @@ function copyAuxWithMap(f, _cellX, _prec) { }; } +function zipAux(_cellX, _cellY, _prec) { + while(true) { + var prec = _prec; + var cellY = _cellY; + var cellX = _cellX; + if (cellX) { + if (cellY) { + var next = /* :: */[ + /* tuple */[ + cellX[0], + cellY[0] + ], + /* [] */0 + ]; + prec[1] = next; + _prec = next; + _cellY = cellY[1]; + _cellX = cellX[1]; + continue ; + + } else { + return /* () */0; + } + } else { + return /* () */0; + } + }; +} + function copyAuxWithMap2(f, _cellX, _cellY, _prec) { while(true) { var prec = _prec; @@ -229,7 +282,7 @@ function append(xs, ys) { xs[0], /* [] */0 ]; - copyAux(xs[1], cell)[1] = ys; + copyAuxCont(xs[1], cell)[1] = ys; return cell; } else { return ys; @@ -304,7 +357,9 @@ function init(n, f) { } } -function lengthAux(_x, _acc) { +function length(xs) { + var _x = xs; + var _acc = 0; while(true) { var acc = _acc; var x = _x; @@ -319,10 +374,6 @@ function lengthAux(_x, _acc) { }; } -function length(xs) { - return lengthAux(xs, 0); -} - function fillAux(arr, _i, _x) { while(true) { var x = _x; @@ -340,7 +391,7 @@ function fillAux(arr, _i, _x) { } function toArray(x) { - var len = lengthAux(x, 0); + var len = length(x); var arr = new Array(len); fillAux(arr, 0, x); return arr; @@ -374,7 +425,7 @@ function flattenAux(_prec, _xs) { var prec = _prec; if (xs) { _xs = xs[1]; - _prec = copyAux(xs[0], prec); + _prec = copyAuxCont(xs[0], prec); continue ; } else { @@ -394,7 +445,7 @@ function flatten(_xs) { match[0], /* [] */0 ]; - flattenAux(copyAux(match[1], cell), xs[1]); + flattenAux(copyAuxCont(match[1], cell), xs[1]); return cell; } else { _xs = xs[1]; @@ -407,14 +458,17 @@ function flatten(_xs) { }; } -function mapRevAux(f, _accu, _xs) { +function mapRev(f, l) { + var f$1 = f; + var _accu = /* [] */0; + var _xs = l; while(true) { var xs = _xs; var accu = _accu; if (xs) { _xs = xs[1]; _accu = /* :: */[ - f(xs[0]), + f$1(xs[0]), accu ]; continue ; @@ -425,10 +479,6 @@ function mapRevAux(f, _accu, _xs) { }; } -function mapRev(f, l) { - return mapRevAux(f, /* [] */0, l); -} - function iter(f, _param) { while(true) { var param = _param; @@ -485,17 +535,21 @@ function foldRight(f, l, accu) { } } -function mapRevAux2(f, _accu, _l1, _l2) { +function mapRev2(f, l1, l2) { + var f$1 = f; + var _accu = /* [] */0; + var _l1 = l1; + var _l2 = l2; while(true) { - var l2 = _l2; - var l1 = _l1; + var l2$1 = _l2; + var l1$1 = _l1; var accu = _accu; - if (l1) { - if (l2) { - _l2 = l2[1]; - _l1 = l1[1]; + if (l1$1) { + if (l2$1) { + _l2 = l2$1[1]; + _l1 = l1$1[1]; _accu = /* :: */[ - f(l1[0], l2[0]), + f$1(l1$1[0], l2$1[0]), accu ]; continue ; @@ -509,10 +563,6 @@ function mapRevAux2(f, _accu, _l1, _l2) { }; } -function mapRev2(f, l1, l2) { - return mapRevAux2(f, /* [] */0, l1, l2); -} - function iter2(f, _l1, _l2) { while(true) { var l2 = _l2; @@ -854,19 +904,21 @@ function partition(p, l) { } } -function split(param) { - if (param) { - var match = param[0]; - var match$1 = split(param[1]); +function split(xs) { + if (xs) { + var match = xs[0]; + var cellX = /* :: */[ + match[0], + /* [] */0 + ]; + var cellY = /* :: */[ + match[1], + /* [] */0 + ]; + splitAux(xs[1], cellX, cellY); return /* tuple */[ - /* :: */[ - match[0], - match$1[0] - ], - /* :: */[ - match[1], - match$1[1] - ] + cellX, + cellY ]; } else { return /* tuple */[ @@ -876,1002 +928,64 @@ function split(param) { } } -function combine(l1, l2) { +function zip(l1, l2) { if (l1) { if (l2) { - return /* :: */[ - /* tuple */[ - l1[0], - l2[0] - ], - combine(l1[1], l2[1]) - ]; + var cell = /* :: */[ + /* tuple */[ + l1[0], + l2[0] + ], + /* [] */0 + ]; + zipAux(l1[1], l2[1], cell); + return cell; } else { - throw new Error("List.combine"); + return /* [] */0; } - } else if (l2) { - throw new Error("List.combine"); } else { return /* [] */0; } } -function merge(cmp, l1, l2) { - if (l1) { - if (l2) { - var h2 = l2[0]; - var h1 = l1[0]; - if (cmp(h1, h2) <= 0) { - return /* :: */[ - h1, - merge(cmp, l1[1], l2) - ]; - } else { - return /* :: */[ - h2, - merge(cmp, l1, l2[1]) - ]; - } - } else { - return l1; - } - } else { - return l2; - } -} - -function chop(_k, _l) { - while(true) { - var l = _l; - var k = _k; - if (k) { - if (l) { - _l = l[1]; - _k = k - 1 | 0; - continue ; - - } else { - return /* assert false */0; - } - } else { - return l; - } - }; -} - -function stable_sort(cmp, l) { - var sort = function (n, l) { - var exit = 0; - if (n !== 2) { - if (n !== 3) { - exit = 1; - } else if (l) { - var match = l[1]; - if (match) { - var match$1 = match[1]; - if (match$1) { - var x3 = match$1[0]; - var x2 = match[0]; - var x1 = l[0]; - if (cmp(x1, x2) <= 0) { - if (cmp(x2, x3) <= 0) { - return /* :: */[ - x1, - /* :: */[ - x2, - /* :: */[ - x3, - /* [] */0 - ] - ] - ]; - } else if (cmp(x1, x3) <= 0) { - return /* :: */[ - x1, - /* :: */[ - x3, - /* :: */[ - x2, - /* [] */0 - ] - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x1, - /* :: */[ - x2, - /* [] */0 - ] - ] - ]; - } - } else if (cmp(x1, x3) <= 0) { - return /* :: */[ - x2, - /* :: */[ - x1, - /* :: */[ - x3, - /* [] */0 - ] - ] - ]; - } else if (cmp(x2, x3) <= 0) { - return /* :: */[ - x2, - /* :: */[ - x3, - /* :: */[ - x1, - /* [] */0 - ] - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x2, - /* :: */[ - x1, - /* [] */0 - ] - ] - ]; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - } else if (l) { - var match$2 = l[1]; - if (match$2) { - var x2$1 = match$2[0]; - var x1$1 = l[0]; - if (cmp(x1$1, x2$1) <= 0) { - return /* :: */[ - x1$1, - /* :: */[ - x2$1, - /* [] */0 - ] - ]; - } else { - return /* :: */[ - x2$1, - /* :: */[ - x1$1, - /* [] */0 - ] - ]; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - if (exit === 1) { - var n1 = (n >> 1); - var n2 = n - n1 | 0; - var l2 = chop(n1, l); - var s1 = rev_sort(n1, l); - var s2 = rev_sort(n2, l2); - var _l1 = s1; - var _l2 = s2; - var _accu = /* [] */0; - while(true) { - var accu = _accu; - var l2$1 = _l2; - var l1 = _l1; - if (l1) { - if (l2$1) { - var h2 = l2$1[0]; - var h1 = l1[0]; - if (cmp(h1, h2) > 0) { - _accu = /* :: */[ - h1, - accu - ]; - _l1 = l1[1]; - continue ; - - } else { - _accu = /* :: */[ - h2, - accu - ]; - _l2 = l2$1[1]; - continue ; - - } - } else { - return revAppend(l1, accu); - } - } else { - return revAppend(l2$1, accu); - } - }; - } - - }; - var rev_sort = function (n, l) { - var exit = 0; - if (n !== 2) { - if (n !== 3) { - exit = 1; - } else if (l) { - var match = l[1]; - if (match) { - var match$1 = match[1]; - if (match$1) { - var x3 = match$1[0]; - var x2 = match[0]; - var x1 = l[0]; - if (cmp(x1, x2) > 0) { - if (cmp(x2, x3) > 0) { - return /* :: */[ - x1, - /* :: */[ - x2, - /* :: */[ - x3, - /* [] */0 - ] - ] - ]; - } else if (cmp(x1, x3) > 0) { - return /* :: */[ - x1, - /* :: */[ - x3, - /* :: */[ - x2, - /* [] */0 - ] - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x1, - /* :: */[ - x2, - /* [] */0 - ] - ] - ]; - } - } else if (cmp(x1, x3) > 0) { - return /* :: */[ - x2, - /* :: */[ - x1, - /* :: */[ - x3, - /* [] */0 - ] - ] - ]; - } else if (cmp(x2, x3) > 0) { - return /* :: */[ - x2, - /* :: */[ - x3, - /* :: */[ - x1, - /* [] */0 - ] - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x2, - /* :: */[ - x1, - /* [] */0 - ] - ] - ]; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - } else if (l) { - var match$2 = l[1]; - if (match$2) { - var x2$1 = match$2[0]; - var x1$1 = l[0]; - if (cmp(x1$1, x2$1) > 0) { - return /* :: */[ - x1$1, - /* :: */[ - x2$1, - /* [] */0 - ] - ]; - } else { - return /* :: */[ - x2$1, - /* :: */[ - x1$1, - /* [] */0 - ] - ]; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - if (exit === 1) { - var n1 = (n >> 1); - var n2 = n - n1 | 0; - var l2 = chop(n1, l); - var s1 = sort(n1, l); - var s2 = sort(n2, l2); - var _l1 = s1; - var _l2 = s2; - var _accu = /* [] */0; - while(true) { - var accu = _accu; - var l2$1 = _l2; - var l1 = _l1; - if (l1) { - if (l2$1) { - var h2 = l2$1[0]; - var h1 = l1[0]; - if (cmp(h1, h2) <= 0) { - _accu = /* :: */[ - h1, - accu - ]; - _l1 = l1[1]; - continue ; - - } else { - _accu = /* :: */[ - h2, - accu - ]; - _l2 = l2$1[1]; - continue ; - - } - } else { - return revAppend(l1, accu); - } - } else { - return revAppend(l2$1, accu); - } - }; - } - - }; - var len = lengthAux(l, 0); - if (len < 2) { - return l; - } else { - return sort(len, l); - } -} - -function sort_uniq(cmp, l) { - var sort = function (n, l) { - var exit = 0; - if (n !== 2) { - if (n !== 3) { - exit = 1; - } else if (l) { - var match = l[1]; - if (match) { - var match$1 = match[1]; - if (match$1) { - var x3 = match$1[0]; - var x2 = match[0]; - var x1 = l[0]; - var c = cmp(x1, x2); - if (c) { - if (c < 0) { - var c$1 = cmp(x2, x3); - if (c$1) { - if (c$1 < 0) { - return /* :: */[ - x1, - /* :: */[ - x2, - /* :: */[ - x3, - /* [] */0 - ] - ] - ]; - } else { - var c$2 = cmp(x1, x3); - if (c$2) { - if (c$2 < 0) { - return /* :: */[ - x1, - /* :: */[ - x3, - /* :: */[ - x2, - /* [] */0 - ] - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x1, - /* :: */[ - x2, - /* [] */0 - ] - ] - ]; - } - } else { - return /* :: */[ - x1, - /* :: */[ - x2, - /* [] */0 - ] - ]; - } - } - } else { - return /* :: */[ - x1, - /* :: */[ - x2, - /* [] */0 - ] - ]; - } - } else { - var c$3 = cmp(x1, x3); - if (c$3) { - if (c$3 < 0) { - return /* :: */[ - x2, - /* :: */[ - x1, - /* :: */[ - x3, - /* [] */0 - ] - ] - ]; - } else { - var c$4 = cmp(x2, x3); - if (c$4) { - if (c$4 < 0) { - return /* :: */[ - x2, - /* :: */[ - x3, - /* :: */[ - x1, - /* [] */0 - ] - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x2, - /* :: */[ - x1, - /* [] */0 - ] - ] - ]; - } - } else { - return /* :: */[ - x2, - /* :: */[ - x1, - /* [] */0 - ] - ]; - } - } - } else { - return /* :: */[ - x2, - /* :: */[ - x1, - /* [] */0 - ] - ]; - } - } - } else { - var c$5 = cmp(x2, x3); - if (c$5) { - if (c$5 < 0) { - return /* :: */[ - x2, - /* :: */[ - x3, - /* [] */0 - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x2, - /* [] */0 - ] - ]; - } - } else { - return /* :: */[ - x2, - /* [] */0 - ]; - } - } - } else { - exit = 1; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - } else if (l) { - var match$2 = l[1]; - if (match$2) { - var x2$1 = match$2[0]; - var x1$1 = l[0]; - var c$6 = cmp(x1$1, x2$1); - if (c$6) { - if (c$6 < 0) { - return /* :: */[ - x1$1, - /* :: */[ - x2$1, - /* [] */0 - ] - ]; - } else { - return /* :: */[ - x2$1, - /* :: */[ - x1$1, - /* [] */0 - ] - ]; - } - } else { - return /* :: */[ - x1$1, - /* [] */0 - ]; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - if (exit === 1) { - var n1 = (n >> 1); - var n2 = n - n1 | 0; - var l2 = chop(n1, l); - var s1 = rev_sort(n1, l); - var s2 = rev_sort(n2, l2); - var _l1 = s1; - var _l2 = s2; - var _accu = /* [] */0; - while(true) { - var accu = _accu; - var l2$1 = _l2; - var l1 = _l1; - if (l1) { - if (l2$1) { - var t2 = l2$1[1]; - var h2 = l2$1[0]; - var t1 = l1[1]; - var h1 = l1[0]; - var c$7 = cmp(h1, h2); - if (c$7) { - if (c$7 > 0) { - _accu = /* :: */[ - h1, - accu - ]; - _l1 = t1; - continue ; - - } else { - _accu = /* :: */[ - h2, - accu - ]; - _l2 = t2; - continue ; - - } - } else { - _accu = /* :: */[ - h1, - accu - ]; - _l2 = t2; - _l1 = t1; - continue ; - - } - } else { - return revAppend(l1, accu); - } - } else { - return revAppend(l2$1, accu); - } - }; - } - - }; - var rev_sort = function (n, l) { - var exit = 0; - if (n !== 2) { - if (n !== 3) { - exit = 1; - } else if (l) { - var match = l[1]; - if (match) { - var match$1 = match[1]; - if (match$1) { - var x3 = match$1[0]; - var x2 = match[0]; - var x1 = l[0]; - var c = cmp(x1, x2); - if (c) { - if (c > 0) { - var c$1 = cmp(x2, x3); - if (c$1) { - if (c$1 > 0) { - return /* :: */[ - x1, - /* :: */[ - x2, - /* :: */[ - x3, - /* [] */0 - ] - ] - ]; - } else { - var c$2 = cmp(x1, x3); - if (c$2) { - if (c$2 > 0) { - return /* :: */[ - x1, - /* :: */[ - x3, - /* :: */[ - x2, - /* [] */0 - ] - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x1, - /* :: */[ - x2, - /* [] */0 - ] - ] - ]; - } - } else { - return /* :: */[ - x1, - /* :: */[ - x2, - /* [] */0 - ] - ]; - } - } - } else { - return /* :: */[ - x1, - /* :: */[ - x2, - /* [] */0 - ] - ]; - } - } else { - var c$3 = cmp(x1, x3); - if (c$3) { - if (c$3 > 0) { - return /* :: */[ - x2, - /* :: */[ - x1, - /* :: */[ - x3, - /* [] */0 - ] - ] - ]; - } else { - var c$4 = cmp(x2, x3); - if (c$4) { - if (c$4 > 0) { - return /* :: */[ - x2, - /* :: */[ - x3, - /* :: */[ - x1, - /* [] */0 - ] - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x2, - /* :: */[ - x1, - /* [] */0 - ] - ] - ]; - } - } else { - return /* :: */[ - x2, - /* :: */[ - x1, - /* [] */0 - ] - ]; - } - } - } else { - return /* :: */[ - x2, - /* :: */[ - x1, - /* [] */0 - ] - ]; - } - } - } else { - var c$5 = cmp(x2, x3); - if (c$5) { - if (c$5 > 0) { - return /* :: */[ - x2, - /* :: */[ - x3, - /* [] */0 - ] - ]; - } else { - return /* :: */[ - x3, - /* :: */[ - x2, - /* [] */0 - ] - ]; - } - } else { - return /* :: */[ - x2, - /* [] */0 - ]; - } - } - } else { - exit = 1; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - } else if (l) { - var match$2 = l[1]; - if (match$2) { - var x2$1 = match$2[0]; - var x1$1 = l[0]; - var c$6 = cmp(x1$1, x2$1); - if (c$6) { - if (c$6 > 0) { - return /* :: */[ - x1$1, - /* :: */[ - x2$1, - /* [] */0 - ] - ]; - } else { - return /* :: */[ - x2$1, - /* :: */[ - x1$1, - /* [] */0 - ] - ]; - } - } else { - return /* :: */[ - x1$1, - /* [] */0 - ]; - } - } else { - exit = 1; - } - } else { - exit = 1; - } - if (exit === 1) { - var n1 = (n >> 1); - var n2 = n - n1 | 0; - var l2 = chop(n1, l); - var s1 = sort(n1, l); - var s2 = sort(n2, l2); - var _l1 = s1; - var _l2 = s2; - var _accu = /* [] */0; - while(true) { - var accu = _accu; - var l2$1 = _l2; - var l1 = _l1; - if (l1) { - if (l2$1) { - var t2 = l2$1[1]; - var h2 = l2$1[0]; - var t1 = l1[1]; - var h1 = l1[0]; - var c$7 = cmp(h1, h2); - if (c$7) { - if (c$7 < 0) { - _accu = /* :: */[ - h1, - accu - ]; - _l1 = t1; - continue ; - - } else { - _accu = /* :: */[ - h2, - accu - ]; - _l2 = t2; - continue ; - - } - } else { - _accu = /* :: */[ - h1, - accu - ]; - _l2 = t2; - _l1 = t1; - continue ; - - } - } else { - return revAppend(l1, accu); - } - } else { - return revAppend(l2$1, accu); - } - }; - } - - }; - var len = lengthAux(l, 0); - if (len < 2) { - return l; - } else { - return sort(len, l); - } -} - -var sort = stable_sort; - -var fast_sort = stable_sort; - -exports.headOpt = headOpt; -exports.tailOpt = tailOpt; -exports.nthAux = nthAux; -exports.nthAuxAssert = nthAuxAssert; -exports.nthOpt = nthOpt; -exports.nthAssert = nthAssert; -exports.partitionAux = partitionAux; -exports.copyAux = copyAux; -exports.copyAuxWitFilter = copyAuxWitFilter; -exports.copyAuxWithMap = copyAuxWithMap; -exports.copyAuxWithMap2 = copyAuxWithMap2; -exports.copyAuxWithMapI = copyAuxWithMapI; -exports.append = append; -exports.map = map; -exports.map2 = map2; -exports.mapi = mapi; -exports.init = init; -exports.lengthAux = lengthAux; -exports.length = length; -exports.fillAux = fillAux; -exports.toArray = toArray; -exports.revAppend = revAppend; -exports.rev = rev; -exports.flattenAux = flattenAux; -exports.flatten = flatten; -exports.mapRevAux = mapRevAux; -exports.mapRev = mapRev; -exports.iter = iter; -exports.iteri = iteri; -exports.foldLeft = foldLeft; -exports.foldRight = foldRight; -exports.mapRevAux2 = mapRevAux2; -exports.mapRev2 = mapRev2; -exports.iter2 = iter2; -exports.foldLeft2 = foldLeft2; -exports.foldRight2 = foldRight2; -exports.forAll = forAll; -exports.exists = exists; -exports.forAll2 = forAll2; -exports.exists2 = exists2; -exports.mem = mem; -exports.memq = memq; -exports.assocOpt = assocOpt; -exports.assqOpt = assqOpt; -exports.memAssoc = memAssoc; -exports.memAssq = memAssq; -exports.removeAssoc = removeAssoc; -exports.removeAssq = removeAssq; -exports.findOpt = findOpt; -exports.filter = filter; -exports.partition = partition; -exports.split = split; -exports.combine = combine; -exports.merge = merge; -exports.chop = chop; -exports.stable_sort = stable_sort; -exports.sort = sort; -exports.fast_sort = fast_sort; -exports.sort_uniq = sort_uniq; +exports.headOpt = headOpt; +exports.tailOpt = tailOpt; +exports.nthOpt = nthOpt; +exports.nthAssert = nthAssert; +exports.append = append; +exports.map = map; +exports.map2 = map2; +exports.mapi = mapi; +exports.init = init; +exports.length = length; +exports.toArray = toArray; +exports.revAppend = revAppend; +exports.rev = rev; +exports.flatten = flatten; +exports.mapRev = mapRev; +exports.iter = iter; +exports.iteri = iteri; +exports.foldLeft = foldLeft; +exports.foldRight = foldRight; +exports.mapRev2 = mapRev2; +exports.iter2 = iter2; +exports.foldLeft2 = foldLeft2; +exports.foldRight2 = foldRight2; +exports.forAll = forAll; +exports.exists = exists; +exports.forAll2 = forAll2; +exports.exists2 = exists2; +exports.mem = mem; +exports.memq = memq; +exports.assocOpt = assocOpt; +exports.assqOpt = assqOpt; +exports.memAssoc = memAssoc; +exports.memAssq = memAssq; +exports.removeAssoc = removeAssoc; +exports.removeAssq = removeAssq; +exports.findOpt = findOpt; +exports.filter = filter; +exports.partition = partition; +exports.split = split; +exports.zip = zip; /* No side effect */ From a6e56318efd69869cab623fc690703f10e571ecb Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sun, 24 Dec 2017 15:10:03 +0800 Subject: [PATCH 5/7] more tests --- jscomp/test/bs_link_list_test.js | 189 ++++++++++++++++++++++++++++--- jscomp/test/bs_link_list_test.ml | 49 ++++++-- 2 files changed, 210 insertions(+), 28 deletions(-) diff --git a/jscomp/test/bs_link_list_test.js b/jscomp/test/bs_link_list_test.js index b4c0d2d2eb..c9797f9787 100644 --- a/jscomp/test/bs_link_list_test.js +++ b/jscomp/test/bs_link_list_test.js @@ -321,12 +321,12 @@ eq("PARTITION", Bs_List.partition((function (x) { ] ]); -eq("SPLIT", Bs_List.split(/* [] */0), /* tuple */[ +eq("UNZIP", Bs_List.unzip(/* [] */0), /* tuple */[ /* [] */0, /* [] */0 ]); -eq("SPLIT", Bs_List.split(/* :: */[ +eq("UNZIP", Bs_List.unzip(/* :: */[ /* tuple */[ 1, 2 @@ -343,7 +343,7 @@ eq("SPLIT", Bs_List.split(/* :: */[ ] ]); -eq("SPLIT", Bs_List.split(/* :: */[ +eq("UNZIP", Bs_List.unzip(/* :: */[ /* tuple */[ 1, 2 @@ -476,17 +476,15 @@ function add(a, b) { return a + b | 0; } -var a = Bs_List.init(10, id); +var length_10_id = Bs_List.init(10, id); -var b$1 = Bs_List.init(10, id); - -var c = Bs_List.init(8, id); +var length_8_id = Bs_List.init(8, id); var d = Bs_List.init(10, (function (x) { return (x << 1); })); -eq("MAP2", Bs_List.map2(add, a, b$1), d); +eq("MAP2", Bs_List.map2(add, length_10_id, length_10_id), d); eq("MAP2", Bs_List.map2(add, /* [] */0, /* :: */[ 1, @@ -500,7 +498,7 @@ eq("MAP2", Bs_List.map2(add, /* :: */[ eq("MAP2", Bs_List.map2(add, /* [] */0, /* [] */0), /* [] */0); -eq("MAP2", Bs_List.map2(add, a, b$1), Bs_List.append(Bs_List.map(c, (function (x) { +eq("MAP2", Bs_List.map2(add, length_10_id, length_10_id), Bs_List.append(Bs_List.map(length_8_id, (function (x) { return (x << 1); })), /* :: */[ 16, @@ -510,19 +508,174 @@ eq("MAP2", Bs_List.map2(add, a, b$1), Bs_List.append(Bs_List.map(c, (function (x ] ])); +eq("TAKE", Bs_List.takeOpt(/* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* [] */0 + ] + ] + ], 2), /* Some */[/* :: */[ + 1, + /* :: */[ + 2, + /* [] */0 + ] + ]]); + +eq("TAKE", Bs_List.takeOpt(/* [] */0, 1), /* None */0); + +eq("TAKE", Bs_List.takeOpt(/* :: */[ + 1, + /* :: */[ + 2, + /* [] */0 + ] + ], 3), /* None */0); + +eq("TAKE", Bs_List.takeOpt(/* :: */[ + 1, + /* :: */[ + 2, + /* [] */0 + ] + ], 2), /* Some */[/* :: */[ + 1, + /* :: */[ + 2, + /* [] */0 + ] + ]]); + +eq("TAKE", Bs_List.takeOpt(length_10_id, 8), /* Some */[length_8_id]); + +eq("TAKE", Bs_List.takeOpt(length_10_id, 0), /* Some */[/* [] */0]); + +eq("DROP", Bs_List.dropOpt(length_10_id, 10), /* Some */[/* [] */0]); + +eq("DROP", Bs_List.dropOpt(length_10_id, 8), /* Some */[/* :: */[ + 8, + /* :: */[ + 9, + /* [] */0 + ] + ]]); + +eq("DROP", Bs_List.dropOpt(length_10_id, 0), /* Some */[length_10_id]); + +var a = Bs_List.init(5, id); + +eq("SPLIT", Bs_List.splitAtOpt(a, 6), /* None */0); + +eq("SPLIT", Bs_List.splitAtOpt(a, 5), /* Some */[/* tuple */[ + a, + /* [] */0 + ]]); + +eq("SPLIT", Bs_List.splitAtOpt(a, 4), /* Some */[/* tuple */[ + /* :: */[ + 0, + /* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* [] */0 + ] + ] + ] + ], + /* :: */[ + 4, + /* [] */0 + ] + ]]); + +eq("SPLIT", Bs_List.splitAtOpt(a, 3), /* Some */[/* tuple */[ + /* :: */[ + 0, + /* :: */[ + 1, + /* :: */[ + 2, + /* [] */0 + ] + ] + ], + /* :: */[ + 3, + /* :: */[ + 4, + /* [] */0 + ] + ] + ]]); + +eq("SPLIT", Bs_List.splitAtOpt(a, 2), /* Some */[/* tuple */[ + /* :: */[ + 0, + /* :: */[ + 1, + /* [] */0 + ] + ], + /* :: */[ + 2, + /* :: */[ + 3, + /* :: */[ + 4, + /* [] */0 + ] + ] + ] + ]]); + +eq("SPLIT", Bs_List.splitAtOpt(a, 1), /* Some */[/* tuple */[ + /* :: */[ + 0, + /* [] */0 + ], + /* :: */[ + 1, + /* :: */[ + 2, + /* :: */[ + 3, + /* :: */[ + 4, + /* [] */0 + ] + ] + ] + ] + ]]); + +eq("SPLIT", Bs_List.splitAtOpt(a, 0), /* Some */[/* tuple */[ + /* [] */0, + a + ]]); + +eq("SPLIT", Bs_List.splitAtOpt(a, -1), /* None */0); + Mt.from_pair_suites("bs_link_list_test.ml", suites[0]); var N = 0; var A = 0; -exports.suites = suites; -exports.test_id = test_id; -exports.eq = eq; -exports.b = b; -exports.N = N; -exports.A = A; -exports.mod2 = mod2; -exports.id = id; -exports.add = add; +exports.suites = suites; +exports.test_id = test_id; +exports.eq = eq; +exports.b = b; +exports.N = N; +exports.A = A; +exports.mod2 = mod2; +exports.id = id; +exports.add = add; +exports.length_10_id = length_10_id; +exports.length_8_id = length_8_id; /* u Not a pure module */ diff --git a/jscomp/test/bs_link_list_test.ml b/jscomp/test/bs_link_list_test.ml index d316785dd9..fc17a54d01 100644 --- a/jscomp/test/bs_link_list_test.ml +++ b/jscomp/test/bs_link_list_test.ml @@ -68,10 +68,10 @@ let () = =~ ([], [2;2;2;4]) let () = - let (=~) = eq "SPLIT" in - N.split [] =~ ([],[]) ; - N.split [1,2] =~ ([1] ,[2]); - N.split [1,2;3,4] =~ ([1;3], [2;4]) + let (=~) = eq "UNZIP" in + N.unzip [] =~ ([],[]) ; + N.unzip [1,2] =~ ([1] ,[2]); + N.unzip [1,2;3,4] =~ ([1;3], [2;4]) let () = let (=~) = eq "FILTER" in @@ -88,16 +88,45 @@ let () = N.map [] id =~ []; N.map [1] (fun [@bs] x-> -x) =~ [-1] let add = (fun [@bs] a b -> a + b) +let length_10_id = N.init 10 id +let length_8_id = N.init 8 id let () = - let (=~) = eq "MAP2" in - let a = N.init 10 id in - let b = N.init 10 id in - let c = N.init 8 id in + let (=~) = eq "MAP2" in + let b = length_10_id in + let c = length_8_id in let d = N.init 10 (fun [@bs] x -> 2 * x ) in - N.map2 add a b =~ d ; + N.map2 add length_10_id b =~ d ; N.map2 add [] [1] =~ []; N.map2 add [1] [] =~ []; N.map2 add [] [] =~ []; - N.map2 add a b =~ N.(append (map c (fun[@bs] x -> x * 2)) [16;18]) + N.map2 add length_10_id b =~ N.(append (map c (fun[@bs] x -> x * 2)) [16;18]) + +let () = + let (=~) = eq "TAKE" in + N.takeOpt [1;2;3] 2 =~ Some [1;2]; + N.takeOpt [] 1 =~ None; + N.takeOpt [1;2] 3 =~ None ; + N.takeOpt [1;2] 2 =~ Some [1;2]; + N.takeOpt length_10_id 8 =~ Some length_8_id ; + N.takeOpt length_10_id 0 =~ Some [] + +let () = + let (=~) = eq "DROP" in + N.dropOpt length_10_id 10 =~ Some []; + N.dropOpt length_10_id 8 =~ Some [8;9]; + N.dropOpt length_10_id 0 =~ Some length_10_id + +let () = + let (=~) = eq "SPLIT" in + let a = N.init 5 id in + N.splitAtOpt a 6 =~ None; + N.splitAtOpt a 5 =~ Some (a,[]); + N.splitAtOpt a 4 =~ Some ([0;1;2;3],[4]); + N.splitAtOpt a 3 =~ Some ([0;1;2],[3;4]); + N.splitAtOpt a 2 =~ Some ([0;1],[2;3;4]); + N.splitAtOpt a 1 =~ Some ([0],[1;2;3;4]); + N.splitAtOpt a 0 =~ Some ([],a); + N.splitAtOpt a (-1) =~ None; + ;; Mt.from_pair_suites __FILE__ !suites From 435a03e51ba7ee1149fa071af401df2ff8d14c08 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sun, 24 Dec 2017 15:10:27 +0800 Subject: [PATCH 6/7] more tests --- jscomp/others/bs_List.ml | 67 +++++++++++++++++-- jscomp/others/bs_List.mli | 82 ++++++++++++----------- lib/js/bs_List.js | 136 +++++++++++++++++++++++++++++++++++++- 3 files changed, 241 insertions(+), 44 deletions(-) diff --git a/jscomp/others/bs_List.ml b/jscomp/others/bs_List.ml index ef8980549d..acf40f5515 100644 --- a/jscomp/others/bs_List.ml +++ b/jscomp/others/bs_List.ml @@ -137,7 +137,7 @@ let rec splitAux cell precX precY = splitAux t nextA nextB (* return the tail pointer so it can continue copy other - list + list *) let rec copyAuxCont cellX prec = match cellX with @@ -197,6 +197,66 @@ let rec copyAuxWithMapI f i cellX prec = unsafeMutateTail prec next ; copyAuxWithMapI f (i + 1) t next +let rec takeAux n cell prec = + if n = 0 then true + else + match cell with + | [] -> false + | x::xs -> + let cell = mutableCell x [] in + unsafeMutateTail prec cell; + takeAux (n - 1) xs cell + +let rec splitAtAux n cell prec = + if n = 0 then Some cell + else + match cell with + | [] -> None + | x::xs -> + let cell = mutableCell x [] in + unsafeMutateTail prec cell; + splitAtAux (n - 1) xs cell + +(* invarint [n >= 0] *) +let takeOpt lst n = + if n < 0 then None + else + if n = 0 then Some [] + else + match lst with + | [] -> None + | x::xs -> + let cell = mutableCell x [] in + let has = takeAux (n-1) xs cell in + if has then Some cell + else None +(* invariant [n >= 0 ] *) +let rec dropAux l n = + if n = 0 then Some l + else + match l with + | _::tl -> dropAux tl (n -1) + | [] -> None + +let dropOpt lst n = + if n < 0 then None + else + dropAux lst n + +let splitAtOpt lst n = + if n < 0 then None + else + if n = 0 then Some ([],lst) + else + match lst with + | [] -> None + | x::xs -> + let cell = mutableCell x [] in + let rest = splitAtAux (n - 1) xs cell in + match rest with + | Some rest -> Some (cell, rest) + | None -> None + let append xs ys = match xs with | [] -> ys @@ -433,7 +493,7 @@ let partition p l = unsafeTail nextX, nextY -let rec split xs = +let rec unzip xs = match xs with | [] -> ([], []) | (x,y)::l -> @@ -441,7 +501,7 @@ let rec split xs = let cellY = mutableCell y [] in splitAux l cellX cellY ; cellX, cellY - + let rec zip l1 l2 = match (l1, l2) with @@ -451,4 +511,3 @@ let rec zip l1 l2 = zipAux l1 l2 cell; cell -(* TODO: add take/drop*) \ No newline at end of file diff --git a/jscomp/others/bs_List.mli b/jscomp/others/bs_List.mli index 4616abb5c3..9e822dbc3c 100644 --- a/jscomp/others/bs_List.mli +++ b/jscomp/others/bs_List.mli @@ -24,86 +24,92 @@ type 'a t = 'a list -val headOpt : 'a list -> 'a option +val headOpt : 'a t -> 'a option -val tailOpt : 'a list -> 'a list option +val tailOpt : 'a t -> 'a t option -val nthOpt : 'a list -> int -> 'a option +val nthOpt : 'a t -> int -> 'a option -val nthAssert : 'a list -> int -> 'a +val nthAssert : 'a t -> int -> 'a -val append : 'a list -> 'a t -> 'a t +val dropOpt : 'a t -> int -> 'a t option -val map : 'a list -> ('a -> 'b [@bs]) -> 'b t +val takeOpt : 'a t -> int -> 'a t option -val map2 : ('a -> 'b -> 'c [@bs]) -> 'a list -> 'b list -> 'c t +val splitAtOpt : 'a t -> int -> ('a list * 'a list) option -val mapi : (int -> 'a -> 'b [@bs]) -> 'a list -> 'b t +val append : 'a t -> 'a t -> 'a t + +val map : 'a t -> ('a -> 'b [@bs]) -> 'b t + +val map2 : ('a -> 'b -> 'c [@bs]) -> 'a t -> 'b t -> 'c t + +val mapi : (int -> 'a -> 'b [@bs]) -> 'a t -> 'b t val init : int -> (int -> 'a [@bs]) -> 'a t -val length : 'a list -> int +val length : 'a t -> int val toArray : 'a t -> 'a array -val revAppend : 'a list -> 'a list -> 'a list +val revAppend : 'a t -> 'a t -> 'a t -val rev : 'a list -> 'a list +val rev : 'a t -> 'a t -val flatten : 'a list list -> 'a t +val flatten : 'a t t -> 'a t -val mapRev : ('a -> 'b [@bs]) -> 'a list -> 'b list +val mapRev : ('a -> 'b [@bs]) -> 'a t -> 'b t -val iter : ('a -> 'b [@bs]) -> 'a list -> unit +val iter : ('a -> 'b [@bs]) -> 'a t -> unit -val iteri : (int -> 'a -> 'b [@bs]) -> 'a list -> unit +val iteri : (int -> 'a -> 'b [@bs]) -> 'a t -> unit -val foldLeft : ('a -> 'b -> 'a [@bs]) -> 'a -> 'b list -> 'a +val foldLeft : ('a -> 'b -> 'a [@bs]) -> 'a -> 'b t -> 'a -val foldRight : ('a -> 'b -> 'b [@bs]) -> 'a list -> 'b -> 'b +val foldRight : ('a -> 'b -> 'b [@bs]) -> 'a t -> 'b -> 'b -val mapRev2 : ('a -> 'b -> 'c [@bs]) -> 'a list -> 'b list -> 'd list +val mapRev2 : ('a -> 'b -> 'c [@bs]) -> 'a t -> 'b t -> 'd t -val iter2 : ('a -> 'b -> 'c [@bs]) -> 'a list -> 'b list -> unit +val iter2 : ('a -> 'b -> 'c [@bs]) -> 'a t -> 'b t -> unit val foldLeft2 : - ('a -> 'b -> 'c -> 'a [@bs]) -> 'a -> 'b list -> 'c list -> 'a + ('a -> 'b -> 'c -> 'a [@bs]) -> 'a -> 'b t -> 'c t -> 'a val foldRight2 : - ('a -> 'b -> 'c -> 'c [@bs]) -> 'a list -> 'b list -> 'c -> 'c + ('a -> 'b -> 'c -> 'c [@bs]) -> 'a t -> 'b t -> 'c -> 'c -val forAll : ('a -> bool [@bs]) -> 'a list -> bool +val forAll : ('a -> bool [@bs]) -> 'a t -> bool -val exists : ('a -> bool [@bs]) -> 'a list -> bool +val exists : ('a -> bool [@bs]) -> 'a t -> bool -val forAll2 : ('a -> 'b -> bool [@bs]) -> 'a list -> 'b list -> bool +val forAll2 : ('a -> 'b -> bool [@bs]) -> 'a t -> 'b t -> bool -val exists2 : ('a -> 'b -> bool [@bs]) -> 'a list -> 'b list -> bool +val exists2 : ('a -> 'b -> bool [@bs]) -> 'a t -> 'b t -> bool -val mem : ('a -> 'b -> bool [@bs]) -> 'b -> 'a list -> bool +val mem : ('a -> 'b -> bool [@bs]) -> 'b -> 'a t -> bool -val memq : 'a -> 'a list -> bool +val memq : 'a -> 'a t -> bool -val assocOpt : ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) list -> 'c option +val assocOpt : ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) t -> 'c option -val assqOpt : 'a -> ('a * 'b) list -> 'b option +val assqOpt : 'a -> ('a * 'b) t -> 'b option -val memAssoc : ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) list -> bool +val memAssoc : ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) t -> bool -val memAssq : 'a -> ('a * 'b) list -> bool +val memAssq : 'a -> ('a * 'b) t -> bool val removeAssoc : - ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) list -> ('a * 'c) list + ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) t -> ('a * 'c) t -val removeAssq : 'a -> ('a * 'b) list -> ('a * 'b) list +val removeAssq : 'a -> ('a * 'b) t -> ('a * 'b) t -val findOpt : ('a -> bool [@bs]) -> 'a list -> 'a option +val findOpt : ('a -> bool [@bs]) -> 'a t -> 'a option -val filter : ('a -> bool [@bs]) -> 'a list -> 'a t +val filter : ('a -> bool [@bs]) -> 'a t -> 'a t -val partition : ('a -> bool [@bs]) -> 'a list -> 'a t * 'a t +val partition : ('a -> bool [@bs]) -> 'a t -> 'a t * 'a t -val split : ('a * 'b) list -> 'a t * 'b t +val unzip : ('a * 'b) t -> 'a t * 'b t -val zip : 'a list -> 'b list -> ('a * 'b) t +val zip : 'a t -> 'b t -> ('a * 'b) t diff --git a/lib/js/bs_List.js b/lib/js/bs_List.js index 5d19959626..88561d17f5 100644 --- a/lib/js/bs_List.js +++ b/lib/js/bs_List.js @@ -276,6 +276,135 @@ function copyAuxWithMapI(f, _i, _cellX, _prec) { }; } +function takeAux(_n, _cell, _prec) { + while(true) { + var prec = _prec; + var cell = _cell; + var n = _n; + if (n) { + if (cell) { + var cell$1 = /* :: */[ + cell[0], + /* [] */0 + ]; + prec[1] = cell$1; + _prec = cell$1; + _cell = cell[1]; + _n = n - 1 | 0; + continue ; + + } else { + return /* false */0; + } + } else { + return /* true */1; + } + }; +} + +function splitAtAux(_n, _cell, _prec) { + while(true) { + var prec = _prec; + var cell = _cell; + var n = _n; + if (n) { + if (cell) { + var cell$1 = /* :: */[ + cell[0], + /* [] */0 + ]; + prec[1] = cell$1; + _prec = cell$1; + _cell = cell[1]; + _n = n - 1 | 0; + continue ; + + } else { + return /* None */0; + } + } else { + return /* Some */[cell]; + } + }; +} + +function takeOpt(lst, n) { + if (n < 0) { + return /* None */0; + } else if (n) { + if (lst) { + var cell = /* :: */[ + lst[0], + /* [] */0 + ]; + var has = takeAux(n - 1 | 0, lst[1], cell); + if (has) { + return /* Some */[cell]; + } else { + return /* None */0; + } + } else { + return /* None */0; + } + } else { + return /* Some */[/* [] */0]; + } +} + +function dropOpt(lst, n) { + if (n < 0) { + return /* None */0; + } else { + var _l = lst; + var _n = n; + while(true) { + var n$1 = _n; + var l = _l; + if (n$1) { + if (l) { + _n = n$1 - 1 | 0; + _l = l[1]; + continue ; + + } else { + return /* None */0; + } + } else { + return /* Some */[l]; + } + }; + } +} + +function splitAtOpt(lst, n) { + if (n < 0) { + return /* None */0; + } else if (n) { + if (lst) { + var cell = /* :: */[ + lst[0], + /* [] */0 + ]; + var rest = splitAtAux(n - 1 | 0, lst[1], cell); + if (rest) { + return /* Some */[/* tuple */[ + cell, + rest[0] + ]]; + } else { + return /* None */0; + } + } else { + return /* None */0; + } + } else { + return /* Some */[/* tuple */[ + /* [] */0, + lst + ]]; + } +} + function append(xs, ys) { if (xs) { var cell = /* :: */[ @@ -904,7 +1033,7 @@ function partition(p, l) { } } -function split(xs) { +function unzip(xs) { if (xs) { var match = xs[0]; var cellX = /* :: */[ @@ -952,6 +1081,9 @@ exports.headOpt = headOpt; exports.tailOpt = tailOpt; exports.nthOpt = nthOpt; exports.nthAssert = nthAssert; +exports.dropOpt = dropOpt; +exports.takeOpt = takeOpt; +exports.splitAtOpt = splitAtOpt; exports.append = append; exports.map = map; exports.map2 = map2; @@ -986,6 +1118,6 @@ exports.removeAssq = removeAssq; exports.findOpt = findOpt; exports.filter = filter; exports.partition = partition; -exports.split = split; +exports.unzip = unzip; exports.zip = zip; /* No side effect */ From 6977ccafeb1c21db429137d188a545fed792b167 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sun, 24 Dec 2017 16:22:10 +0800 Subject: [PATCH 7/7] t comes first, and more tests --- jscomp/others/bs_List.ml | 130 +++++++++++++--------- jscomp/others/bs_List.mli | 54 +++++----- jscomp/test/bs_link_list_test.js | 151 +++++++++++++++++++++----- jscomp/test/bs_link_list_test.ml | 73 +++++++++---- lib/js/bs_List.js | 180 +++++++++++++++---------------- 5 files changed, 374 insertions(+), 214 deletions(-) diff --git a/jscomp/others/bs_List.ml b/jscomp/others/bs_List.ml index acf40f5515..ab56130c42 100644 --- a/jscomp/others/bs_List.ml +++ b/jscomp/others/bs_List.ml @@ -150,7 +150,7 @@ let rec copyAuxCont cellX prec = let rec copyAuxWitFilter f cellX prec = match cellX with | [] -> - unsafeMutateTail prec [] + () | h::t -> if f h [@bs] then begin @@ -186,16 +186,16 @@ let rec copyAuxWithMap2 f cellX cellY prec = unsafeMutateTail prec next ; copyAuxWithMap2 f t1 t2 next | [],_ | _,[] -> - unsafeMutateTail prec [] + () let rec copyAuxWithMapI f i cellX prec = match cellX with - | [] -> - unsafeMutateTail prec [] | h::t -> let next = mutableCell (f i h [@bs]) [] in unsafeMutateTail prec next ; copyAuxWithMapI f (i + 1) t next + | [] -> + () let rec takeAux n cell prec = if n = 0 then true @@ -272,7 +272,8 @@ let map xs f = let cell = mutableCell (f h [@bs]) [] in copyAuxWithMap f t cell; cell -let rec map2 f l1 l2 = + +let map2 l1 l2 f = match (l1, l2) with | (a1::l1, a2::l2) -> let cell = mutableCell (f a1 a2 [@bs]) [] in @@ -280,7 +281,8 @@ let rec map2 f l1 l2 = cell | [], _ | _, [] -> [] -let rec mapi f = function +let rec mapi xs f = + match xs with [] -> [] | h::t -> let cell = mutableCell (f 0 h [@bs]) [] in @@ -358,29 +360,31 @@ let rec mapRevAux f accu xs = | [] -> accu | a::l -> mapRevAux f (f a [@bs] :: accu) l -let mapRev f l = +let mapRev l f = mapRevAux f [] l -let rec iter f = function +let rec iter xs f = + match xs with [] -> () - | a::l -> f a [@bs]; iter f l + | a::l -> f a [@bs]; iter l f -let rec iteri i f = function +let rec iteri xs i f = + match xs with [] -> () - | a::l -> f i a [@bs]; iteri (i + 1) f l + | a::l -> f i a [@bs]; iteri l (i + 1) f -let iteri f l = iteri 0 f l +let iteri l f = iteri l 0 f -let rec foldLeft f accu l = +let rec foldLeft l accu f = match l with [] -> accu - | a::l -> foldLeft f (f accu a [@bs]) l + | a::l -> foldLeft l (f accu a [@bs]) f -let rec foldRight f l accu = +let rec foldRight l accu f = match l with [] -> accu - | a::l -> f a (foldRight f l accu) [@bs] + | a::l -> f a (foldRight l accu f) [@bs] let rec mapRevAux2 f accu l1 l2 = @@ -388,84 +392,104 @@ let rec mapRevAux2 f accu l1 l2 = | (a1::l1, a2::l2) -> mapRevAux2 f (f a1 a2 [@bs]:: accu) l1 l2 | (_, _) -> [] -let mapRev2 f l1 l2 = +let mapRev2 l1 l2 f = mapRevAux2 f [] l1 l2 -let rec iter2 f l1 l2 = +let rec iter2 l1 l2 f = match (l1, l2) with - | (a1::l1, a2::l2) -> f a1 a2 [@bs]; iter2 f l1 l2 + | (a1::l1, a2::l2) -> f a1 a2 [@bs]; iter2 l1 l2 f | [],_ | _, [] -> () -let rec foldLeft2 f accu l1 l2 = +let rec foldLeft2 l1 l2 accu f = match (l1, l2) with - | (a1::l1, a2::l2) -> foldLeft2 f (f accu a1 a2 [@bs]) l1 l2 + | (a1::l1, a2::l2) -> + foldLeft2 l1 l2 (f accu a1 a2 [@bs]) f | [], _ | _, [] -> accu -let rec foldRight2 f l1 l2 accu = +let rec foldRight2 l1 l2 accu f = match (l1, l2) with ([], []) -> accu - | (a1::l1, a2::l2) -> f a1 a2 (foldRight2 f l1 l2 accu) [@bs] + | (a1::l1, a2::l2) -> f a1 a2 (foldRight2 l1 l2 accu f) [@bs] | _, [] | [], _ -> accu -let rec forAll p = function +let rec forAll xs p = + match xs with [] -> true - | a::l -> p a [@bs] && forAll p l + | a::l -> p a [@bs] && forAll l p -let rec exists p = function +let rec exists xs p = + match xs with [] -> false - | a::l -> p a [@bs] || exists p l + | a::l -> p a [@bs] || exists l p -let rec forAll2 p l1 l2 = +let rec forAll2 l1 l2 p = match (l1, l2) with (_, []) | [],_ -> true - | (a1::l1, a2::l2) -> p a1 a2 [@bs] && forAll2 p l1 l2 + | (a1::l1, a2::l2) -> p a1 a2 [@bs] && forAll2 l1 l2 p -let rec exists2 p l1 l2 = +let rec exists2 l1 l2 p = match (l1, l2) with [], _ | _, [] -> false - | (a1::l1, a2::l2) -> p a1 a2 [@bs] || exists2 p l1 l2 + | (a1::l1, a2::l2) -> p a1 a2 [@bs] || exists2 l1 l2 p -let rec mem eq x = function +let rec mem xs x eq = + match xs with [] -> false - | a::l -> eq a x [@bs] || mem eq x l + | a::l -> eq a x [@bs] || mem l x eq -let rec memq x = function +let rec memq xs x = + match xs with [] -> false - | a::l -> a == x || memq x l + | a::l -> a == x || memq l x -let rec assocOpt eq x = function - [] -> None - | (a,b)::l -> if eq a x [@bs] then Some b else assocOpt eq x l +let rec assocOpt xs x eq = + match xs with + | [] -> None + | (a,b)::l -> + if eq a x [@bs] then Some b + else assocOpt l x eq -let rec assqOpt x = function +let rec assqOpt xs x = + match xs with [] -> None - | (a,b)::l -> if a == x then Some b else assqOpt x l + | (a,b)::l -> if a == x then Some b else assqOpt l x -let rec memAssoc eq x = function +let rec memAssoc xs x eq = + match xs with | [] -> false - | (a, b) :: l -> eq a x [@bs] || memAssoc eq x l + | (a, b) :: l -> eq a x [@bs] || memAssoc l x eq -let rec memAssq x = function +let rec memAssq xs x = + match xs with | [] -> false - | (a, b) :: l -> a == x || memAssq x l + | (a, b) :: l -> a == x || memAssq l x -let rec removeAssoc eq x = function +(*FIXME non-stack-safe *) +let rec removeAssoc xs x eq = + match xs with | [] -> [] | (a, b as pair) :: l -> - if eq a x [@bs] then l else pair :: removeAssoc eq x l + if eq a x [@bs] then l + else pair :: removeAssoc l x eq -let rec removeAssq x = function +let rec removeAssq xs x = + match xs with | [] -> [] - | (a, b as pair) :: l -> if a == x then l else pair :: removeAssq x l + | (a, b as pair) :: l -> + if a == x then l + else pair :: removeAssq l x -let rec findOpt p = function +let rec findOpt xs p = + match xs with | [] -> None - | x :: l -> if p x [@bs] then Some x else findOpt p l + | x :: l -> + if p x [@bs] then Some x + else findOpt l p -let rec filter p xs = +let rec filter xs p = match xs with | [] -> [] | h::t -> @@ -476,10 +500,10 @@ let rec filter p xs = cell end else - filter p t + filter t p -let partition p l = +let partition l p = match l with | [] -> [],[] | h::t -> diff --git a/jscomp/others/bs_List.mli b/jscomp/others/bs_List.mli index 9e822dbc3c..d716193bc7 100644 --- a/jscomp/others/bs_List.mli +++ b/jscomp/others/bs_List.mli @@ -42,9 +42,9 @@ val append : 'a t -> 'a t -> 'a t val map : 'a t -> ('a -> 'b [@bs]) -> 'b t -val map2 : ('a -> 'b -> 'c [@bs]) -> 'a t -> 'b t -> 'c t +val map2 : 'a t -> 'b t -> ('a -> 'b -> 'c [@bs]) -> 'c t -val mapi : (int -> 'a -> 'b [@bs]) -> 'a t -> 'b t +val mapi : 'a t -> (int -> 'a -> 'b [@bs]) -> 'b t val init : int -> (int -> 'a [@bs]) -> 'a t @@ -59,56 +59,58 @@ val rev : 'a t -> 'a t val flatten : 'a t t -> 'a t -val mapRev : ('a -> 'b [@bs]) -> 'a t -> 'b t +val mapRev : 'a t -> ('a -> 'b [@bs]) -> 'b t -val iter : ('a -> 'b [@bs]) -> 'a t -> unit +val iter : 'a t -> ('a -> 'b [@bs]) -> unit -val iteri : (int -> 'a -> 'b [@bs]) -> 'a t -> unit +val iteri : 'a t -> (int -> 'a -> 'b [@bs]) -> unit -val foldLeft : ('a -> 'b -> 'a [@bs]) -> 'a -> 'b t -> 'a +val foldLeft : 'a t -> 'b -> ('b -> 'a -> 'b [@bs]) ->'b -val foldRight : ('a -> 'b -> 'b [@bs]) -> 'a t -> 'b -> 'b +val foldRight : 'a t -> 'b -> ('a -> 'b -> 'b [@bs]) -> 'b -val mapRev2 : ('a -> 'b -> 'c [@bs]) -> 'a t -> 'b t -> 'd t +val mapRev2 : 'a t -> 'b t -> ('a -> 'b -> 'c [@bs]) -> 'd t -val iter2 : ('a -> 'b -> 'c [@bs]) -> 'a t -> 'b t -> unit +val iter2 : 'a t -> 'b t -> ('a -> 'b -> 'c [@bs]) -> unit val foldLeft2 : - ('a -> 'b -> 'c -> 'a [@bs]) -> 'a -> 'b t -> 'c t -> 'a + 'b t -> 'c t -> 'a -> ('a -> 'b -> 'c -> 'a [@bs]) -> 'a val foldRight2 : - ('a -> 'b -> 'c -> 'c [@bs]) -> 'a t -> 'b t -> 'c -> 'c + 'a t -> 'b t -> 'c -> ('a -> 'b -> 'c -> 'c [@bs]) -> 'c -val forAll : ('a -> bool [@bs]) -> 'a t -> bool +val forAll : 'a t -> ('a -> bool [@bs]) -> bool -val exists : ('a -> bool [@bs]) -> 'a t -> bool +val exists : 'a t -> ('a -> bool [@bs]) -> bool -val forAll2 : ('a -> 'b -> bool [@bs]) -> 'a t -> 'b t -> bool +val forAll2 : 'a t -> 'b t -> ('a -> 'b -> bool [@bs]) -> bool -val exists2 : ('a -> 'b -> bool [@bs]) -> 'a t -> 'b t -> bool +val exists2 : 'a t -> 'b t -> ('a -> 'b -> bool [@bs]) -> bool -val mem : ('a -> 'b -> bool [@bs]) -> 'b -> 'a t -> bool +val mem : 'a t -> 'b -> ('a -> 'b -> bool [@bs]) -> bool -val memq : 'a -> 'a t -> bool +val memq : 'a t -> 'a ->bool -val assocOpt : ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) t -> 'c option +val assocOpt : ('a * 'c) t -> 'b -> ('a -> 'b -> bool [@bs]) -> 'c option -val assqOpt : 'a -> ('a * 'b) t -> 'b option +val assqOpt : ('a * 'b) t -> 'a -> 'b option -val memAssoc : ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) t -> bool +val memAssoc : ('a * 'c) t -> 'b -> ('a -> 'b -> bool [@bs]) -> bool -val memAssq : 'a -> ('a * 'b) t -> bool +val memAssq : ('a * 'b) t -> 'a -> bool val removeAssoc : - ('a -> 'b -> bool [@bs]) -> 'b -> ('a * 'c) t -> ('a * 'c) t + ('a * 'c) t -> + 'b -> + ('a -> 'b -> bool [@bs]) -> ('a * 'c) t -val removeAssq : 'a -> ('a * 'b) t -> ('a * 'b) t +val removeAssq : ('a * 'b) t -> 'a -> ('a * 'b) t -val findOpt : ('a -> bool [@bs]) -> 'a t -> 'a option +val findOpt : 'a t -> ('a -> bool [@bs]) -> 'a option -val filter : ('a -> bool [@bs]) -> 'a t -> 'a t +val filter : 'a t -> ('a -> bool [@bs]) -> 'a t -val partition : ('a -> bool [@bs]) -> 'a t -> 'a t * 'a t +val partition : 'a t -> ('a -> bool [@bs]) -> 'a t * 'a t val unzip : ('a * 'b) t -> 'a t * 'b t diff --git a/jscomp/test/bs_link_list_test.js b/jscomp/test/bs_link_list_test.js index c9797f9787..86972780d2 100644 --- a/jscomp/test/bs_link_list_test.js +++ b/jscomp/test/bs_link_list_test.js @@ -72,7 +72,7 @@ eq("File \"bs_link_list_test.ml\", line 27, characters 5-12", Bs_List.map(u, (fu ] ]); -eq("File \"bs_link_list_test.ml\", line 30, characters 5-12", Bs_List.flatten(/* :: */[ +eq("FLATTEN", Bs_List.flatten(/* :: */[ /* :: */[ 1, /* [] */0 @@ -121,7 +121,47 @@ eq("File \"bs_link_list_test.ml\", line 30, characters 5-12", Bs_List.flatten(/* ] ]); -eq("File \"bs_link_list_test.ml\", line 37, characters 5-12", Bs_List.toArray(Bs_List.append(Bs_List.init(100, (function (i) { +eq("FLATTEN", Bs_List.flatten(/* [] */0), /* [] */0); + +eq("FLATTEN", Bs_List.flatten(/* :: */[ + /* [] */0, + /* :: */[ + /* [] */0, + /* :: */[ + /* :: */[ + 2, + /* [] */0 + ], + /* :: */[ + /* :: */[ + 1, + /* [] */0 + ], + /* :: */[ + /* :: */[ + 2, + /* [] */0 + ], + /* :: */[ + /* [] */0, + /* [] */0 + ] + ] + ] + ] + ] + ]), /* :: */[ + 2, + /* :: */[ + 1, + /* :: */[ + 2, + /* [] */0 + ] + ] + ]); + +eq("File \"bs_link_list_test.ml\", line 41, characters 5-12", Bs_List.toArray(Bs_List.append(Bs_List.init(100, (function (i) { return i; })), Bs_List.init(100, (function (i) { return i; @@ -131,6 +171,22 @@ eq("File \"bs_link_list_test.ml\", line 37, characters 5-12", Bs_List.toArray(Bs return i; })))); +eq("APPEND", Bs_List.append(/* :: */[ + 1, + /* [] */0 + ], /* [] */0), /* :: */[ + 1, + /* [] */0 + ]); + +eq("APPEND", Bs_List.append(/* [] */0, /* :: */[ + 1, + /* [] */0 + ]), /* :: */[ + 1, + /* [] */0 + ]); + eq("ZIP", Bs_List.zip(/* :: */[ 1, /* :: */[ @@ -220,7 +276,7 @@ function mod2(x) { return +(x % 2 === 0); } -eq("PARTITION", Bs_List.partition(mod2, /* :: */[ +eq("PARTITION", Bs_List.partition(/* :: */[ 1, /* :: */[ 2, @@ -238,7 +294,7 @@ eq("PARTITION", Bs_List.partition(mod2, /* :: */[ ] ] ] - ]), /* tuple */[ + ], mod2), /* tuple */[ /* :: */[ 2, /* :: */[ @@ -261,7 +317,7 @@ eq("PARTITION", Bs_List.partition(mod2, /* :: */[ ] ]); -eq("PARTITION", Bs_List.partition(mod2, /* :: */[ +eq("PARTITION", Bs_List.partition(/* :: */[ 2, /* :: */[ 2, @@ -273,7 +329,7 @@ eq("PARTITION", Bs_List.partition(mod2, /* :: */[ ] ] ] - ]), /* tuple */[ + ], mod2), /* tuple */[ /* :: */[ 2, /* :: */[ @@ -290,9 +346,7 @@ eq("PARTITION", Bs_List.partition(mod2, /* :: */[ /* [] */0 ]); -eq("PARTITION", Bs_List.partition((function (x) { - return 1 - mod2(x); - }), /* :: */[ +eq("PARTITION", Bs_List.partition(/* :: */[ 2, /* :: */[ 2, @@ -304,7 +358,9 @@ eq("PARTITION", Bs_List.partition((function (x) { ] ] ] - ]), /* tuple */[ + ], (function (x) { + return 1 - mod2(x); + })), /* tuple */[ /* [] */0, /* :: */[ 2, @@ -372,7 +428,7 @@ eq("UNZIP", Bs_List.unzip(/* :: */[ ] ]); -eq("FILTER", Bs_List.filter(mod2, /* :: */[ +eq("FILTER", Bs_List.filter(/* :: */[ 1, /* :: */[ 2, @@ -384,7 +440,7 @@ eq("FILTER", Bs_List.filter(mod2, /* :: */[ ] ] ] - ]), /* :: */[ + ], mod2), /* :: */[ 2, /* :: */[ 4, @@ -392,7 +448,7 @@ eq("FILTER", Bs_List.filter(mod2, /* :: */[ ] ]); -eq("FILTER", Bs_List.filter(mod2, /* :: */[ +eq("FILTER", Bs_List.filter(/* :: */[ 1, /* :: */[ 3, @@ -401,11 +457,11 @@ eq("FILTER", Bs_List.filter(mod2, /* :: */[ /* [] */0 ] ] - ]), /* [] */0); + ], mod2), /* [] */0); -eq("FILTER", Bs_List.filter(mod2, /* [] */0), /* [] */0); +eq("FILTER", Bs_List.filter(/* [] */0, mod2), /* [] */0); -eq("FILTER", Bs_List.filter(mod2, /* :: */[ +eq("FILTER", Bs_List.filter(/* :: */[ 2, /* :: */[ 2, @@ -420,7 +476,7 @@ eq("FILTER", Bs_List.filter(mod2, /* :: */[ ] ] ] - ]), /* :: */[ + ], mod2), /* :: */[ 2, /* :: */[ 2, @@ -484,21 +540,21 @@ var d = Bs_List.init(10, (function (x) { return (x << 1); })); -eq("MAP2", Bs_List.map2(add, length_10_id, length_10_id), d); +eq("MAP2", Bs_List.map2(length_10_id, length_10_id, add), d); -eq("MAP2", Bs_List.map2(add, /* [] */0, /* :: */[ +eq("MAP2", Bs_List.map2(/* [] */0, /* :: */[ 1, /* [] */0 - ]), /* [] */0); + ], add), /* [] */0); -eq("MAP2", Bs_List.map2(add, /* :: */[ +eq("MAP2", Bs_List.map2(/* :: */[ 1, /* [] */0 - ], /* [] */0), /* [] */0); + ], /* [] */0, add), /* [] */0); -eq("MAP2", Bs_List.map2(add, /* [] */0, /* [] */0), /* [] */0); +eq("MAP2", Bs_List.map2(/* [] */0, /* [] */0, add), /* [] */0); -eq("MAP2", Bs_List.map2(add, length_10_id, length_10_id), Bs_List.append(Bs_List.map(length_8_id, (function (x) { +eq("MAP2", Bs_List.map2(length_10_id, length_10_id, add), Bs_List.append(Bs_List.map(length_8_id, (function (x) { return (x << 1); })), /* :: */[ 16, @@ -508,6 +564,10 @@ eq("MAP2", Bs_List.map2(add, length_10_id, length_10_id), Bs_List.append(Bs_List ] ])); +eq("MAP2", Bs_List.map2(length_10_id, length_8_id, add), Bs_List.mapi(length_8_id, (function (i, x) { + return i + x | 0; + }))); + eq("TAKE", Bs_List.takeOpt(/* :: */[ 1, /* :: */[ @@ -553,6 +613,8 @@ eq("TAKE", Bs_List.takeOpt(length_10_id, 8), /* Some */[length_8_id]); eq("TAKE", Bs_List.takeOpt(length_10_id, 0), /* Some */[/* [] */0]); +eq("TAKE", Bs_List.takeOpt(length_8_id, -2), /* None */0); + eq("DROP", Bs_List.dropOpt(length_10_id, 10), /* Some */[/* [] */0]); eq("DROP", Bs_List.dropOpt(length_10_id, 8), /* Some */[/* :: */[ @@ -565,8 +627,12 @@ eq("DROP", Bs_List.dropOpt(length_10_id, 8), /* Some */[/* :: */[ eq("DROP", Bs_List.dropOpt(length_10_id, 0), /* Some */[length_10_id]); +eq("DROP", Bs_List.dropOpt(length_8_id, -1), /* None */0); + var a = Bs_List.init(5, id); +eq("SPLIT", Bs_List.splitAtOpt(/* [] */0, 1), /* None */0); + eq("SPLIT", Bs_List.splitAtOpt(a, 6), /* None */0); eq("SPLIT", Bs_List.splitAtOpt(a, 5), /* Some */[/* tuple */[ @@ -661,6 +727,42 @@ eq("SPLIT", Bs_List.splitAtOpt(a, 0), /* Some */[/* tuple */[ eq("SPLIT", Bs_List.splitAtOpt(a, -1), /* None */0); +function succx(x) { + return x + 1 | 0; +} + +eq("File \"bs_link_list_test.ml\", line 146, characters 5-12", /* tuple */[ + Bs_List.headOpt(length_10_id), + Bs_List.tailOpt(length_10_id) + ], /* tuple */[ + /* Some */[0], + Bs_List.dropOpt(length_10_id, 1) + ]); + +eq("File \"bs_link_list_test.ml\", line 147, characters 5-12", Bs_List.headOpt(/* [] */0), /* None */0); + +Bs_List.iteri(length_10_id, (function (i, x) { + return eq("File \"bs_link_list_test.ml\", line 149, characters 8-15", Bs_List.nthOpt(length_10_id, i), /* Some */[x]); + })); + +eq("File \"bs_link_list_test.ml\", line 150, characters 5-12", Bs_List.nthOpt(length_10_id, -1), /* None */0); + +eq("File \"bs_link_list_test.ml\", line 151, characters 5-12", Bs_List.nthOpt(length_10_id, 12), /* None */0); + +eq("File \"bs_link_list_test.ml\", line 152, characters 5-12", Bs_List.init(0, id), /* [] */0); + +eq("File \"bs_link_list_test.ml\", line 153, characters 5-12", Bs_List.rev(Bs_List.rev(length_10_id)), length_10_id); + +eq("File \"bs_link_list_test.ml\", line 154, characters 5-12", Bs_List.rev(Bs_List.rev(length_8_id)), length_8_id); + +eq("File \"bs_link_list_test.ml\", line 155, characters 5-12", Bs_List.rev(/* [] */0), /* [] */0); + +eq("File \"bs_link_list_test.ml\", line 156, characters 5-12", Bs_List.rev(Bs_List.mapRev(length_10_id, succx)), Bs_List.map(length_10_id, succx)); + +eq("File \"bs_link_list_test.ml\", line 159, characters 5-12", Bs_List.foldLeft(length_10_id, 0, add), 45); + +eq("File \"bs_link_list_test.ml\", line 161, characters 5-12", Bs_List.foldRight(length_10_id, 0, add), 45); + Mt.from_pair_suites("bs_link_list_test.ml", suites[0]); var N = 0; @@ -678,4 +780,5 @@ exports.id = id; exports.add = add; exports.length_10_id = length_10_id; exports.length_8_id = length_8_id; +exports.succx = succx; /* u Not a pure module */ diff --git a/jscomp/test/bs_link_list_test.ml b/jscomp/test/bs_link_list_test.ml index fc17a54d01..67fc3c7bc4 100644 --- a/jscomp/test/bs_link_list_test.ml +++ b/jscomp/test/bs_link_list_test.ml @@ -27,11 +27,15 @@ let () = eq __LOC__ (N.map u (fun [@bs] i -> i + 1)) [1;2;5;10;17] let () = - eq __LOC__ + let (=~) = eq "FLATTEN" in + + N.(flatten [[1]; [2]; [3];[]; init 4 (fun [@bs] i -> i )] - ) - [1;2;3; 0;1;2;3] + ) =~ + [1;2;3; 0;1;2;3]; + N.flatten [] =~ []; + N.flatten [[];[]; [2]; [1];[2];[]] =~ [2;1;2] let () = eq __LOC__ @@ -47,6 +51,10 @@ let () = (init 100 (fun [@bs] i -> i) ) (init 100 (fun [@bs] i -> i))) ) +let () = + let (=~) = eq "APPEND" in + N.append [1] [] =~ [1]; + N.append [] [1] =~ [1] let () = let (=~) = eq "ZIP" in @@ -60,11 +68,11 @@ let mod2 = (fun[@bs] x -> x mod 2 = 0) let () = let (=~) = eq "PARTITION" in - (N.partition mod2 [1;2;3;2;3;4]) + (N.partition [1;2;3;2;3;4] mod2 ) =~ ([2;2;4], [1;3;3]); - (N.partition mod2 [2;2;2;4]) + (N.partition [2;2;2;4] mod2) =~ ([2;2;2;4], []); - (N.partition (fun[@bs] x -> not (mod2 x [@bs] )) [2;2;2;4]) + (N.partition [2;2;2;4] (fun[@bs] x -> not (mod2 x [@bs] ))) =~ ([], [2;2;2;4]) let () = @@ -75,10 +83,10 @@ let () = let () = let (=~) = eq "FILTER" in - N.filter mod2 [1;2;3;4] =~ [2;4]; - N.filter mod2 [1;3;41] =~ []; - N.filter mod2 [] =~ []; - N.filter mod2 [2;2;2;4;6] =~ [2;2;2;4;6] + N.filter [1;2;3;4] mod2 =~ [2;4]; + N.filter [1;3;41] mod2 =~ []; + N.filter [] mod2 =~ []; + N.filter [2;2;2;4;6] mod2 =~ [2;2;2;4;6] let id : int -> int [@bs] = fun [@bs] x -> x let () = @@ -95,12 +103,14 @@ let () = let b = length_10_id in let c = length_8_id in let d = N.init 10 (fun [@bs] x -> 2 * x ) in - N.map2 add length_10_id b =~ d ; - N.map2 add [] [1] =~ []; - N.map2 add [1] [] =~ []; - N.map2 add [] [] =~ []; - N.map2 add length_10_id b =~ N.(append (map c (fun[@bs] x -> x * 2)) [16;18]) - + let map2_add x y = N.map2 x y add in + map2_add length_10_id b =~ d ; + map2_add [] [1] =~ []; + map2_add [1] [] =~ []; + map2_add [] [] =~ []; + map2_add length_10_id b =~ N.(append (map c (fun[@bs] x -> x * 2)) [16;18]); + map2_add length_10_id length_8_id =~ + N.(mapi length_8_id (fun [@bs] i x -> i + x ) ) let () = let (=~) = eq "TAKE" in N.takeOpt [1;2;3] 2 =~ Some [1;2]; @@ -108,17 +118,20 @@ let () = N.takeOpt [1;2] 3 =~ None ; N.takeOpt [1;2] 2 =~ Some [1;2]; N.takeOpt length_10_id 8 =~ Some length_8_id ; - N.takeOpt length_10_id 0 =~ Some [] + N.takeOpt length_10_id 0 =~ Some []; + N.takeOpt length_8_id (-2) =~ None let () = let (=~) = eq "DROP" in N.dropOpt length_10_id 10 =~ Some []; N.dropOpt length_10_id 8 =~ Some [8;9]; - N.dropOpt length_10_id 0 =~ Some length_10_id + N.dropOpt length_10_id 0 =~ Some length_10_id ; + N.dropOpt length_8_id (-1) =~ None let () = let (=~) = eq "SPLIT" in let a = N.init 5 id in + N.splitAtOpt [] 1 =~ None; N.splitAtOpt a 6 =~ None; N.splitAtOpt a 5 =~ Some (a,[]); N.splitAtOpt a 4 =~ Some ([0;1;2;3],[4]); @@ -126,7 +139,29 @@ let () = N.splitAtOpt a 2 =~ Some ([0;1],[2;3;4]); N.splitAtOpt a 1 =~ Some ([0],[1;2;3;4]); N.splitAtOpt a 0 =~ Some ([],a); - N.splitAtOpt a (-1) =~ None; + N.splitAtOpt a (-1) =~ None +let succx = (fun[@bs] x -> x + 1) +let () = + eq __LOC__ N.(headOpt length_10_id, tailOpt length_10_id) (Some 0, N.dropOpt length_10_id 1); + eq __LOC__ (N.headOpt []) None ; + N.iteri length_10_id (fun[@bs] i x -> + eq __LOC__ (N.nthOpt length_10_id i) (Some x)); + eq __LOC__ (N.nthOpt length_10_id (-1) ) None; + eq __LOC__ (N.nthOpt length_10_id 12 ) None; + eq __LOC__ (N.init 0 id) []; + eq __LOC__ (N.(rev (rev length_10_id))) length_10_id ; + eq __LOC__ (N.(rev (rev length_8_id))) length_8_id ; + eq __LOC__ (N.rev []) []; + eq __LOC__ + (N.rev (N.mapRev length_10_id succx)) + (N.map length_10_id succx ); + eq __LOC__ + (N.foldLeft length_10_id 0 add) 45; + eq __LOC__ + (N.foldRight length_10_id 0 add) 45; + (* eq __LOC__ + (N.mapRev2 length_10_id length_8_id add ) *) + ;; Mt.from_pair_suites __FILE__ !suites diff --git a/lib/js/bs_List.js b/lib/js/bs_List.js index 88561d17f5..a4e20a2b2a 100644 --- a/lib/js/bs_List.js +++ b/lib/js/bs_List.js @@ -169,7 +169,6 @@ function copyAuxWitFilter(f, _cellX, _prec) { } } else { - prec[1] = /* [] */0; return /* () */0; } }; @@ -243,11 +242,9 @@ function copyAuxWithMap2(f, _cellX, _cellY, _prec) { continue ; } else { - prec[1] = /* [] */0; return /* () */0; } } else { - prec[1] = /* [] */0; return /* () */0; } }; @@ -270,7 +267,6 @@ function copyAuxWithMapI(f, _i, _cellX, _prec) { continue ; } else { - prec[1] = /* [] */0; return /* () */0; } }; @@ -431,7 +427,7 @@ function map(xs, f) { } } -function map2(f, l1, l2) { +function map2(l1, l2, f) { if (l1) { if (l2) { var cell = /* :: */[ @@ -448,13 +444,13 @@ function map2(f, l1, l2) { } } -function mapi(f, param) { - if (param) { +function mapi(xs, f) { + if (xs) { var cell = /* :: */[ - f(0, param[0]), + f(0, xs[0]), /* [] */0 ]; - copyAuxWithMapI(f, 1, param[1], cell); + copyAuxWithMapI(f, 1, xs[1], cell); return cell; } else { return /* [] */0; @@ -587,7 +583,7 @@ function flatten(_xs) { }; } -function mapRev(f, l) { +function mapRev(l, f) { var f$1 = f; var _accu = /* [] */0; var _xs = l; @@ -608,12 +604,12 @@ function mapRev(f, l) { }; } -function iter(f, _param) { +function iter(_xs, f) { while(true) { - var param = _param; - if (param) { - f(param[0]); - _param = param[1]; + var xs = _xs; + if (xs) { + f(xs[0]); + _xs = xs[1]; continue ; } else { @@ -622,17 +618,17 @@ function iter(f, _param) { }; } -function iteri(f, l) { +function iteri(l, f) { + var _xs = l; var _i = 0; var f$1 = f; - var _param = l; while(true) { - var param = _param; var i = _i; - if (param) { - f$1(i, param[0]); - _param = param[1]; + var xs = _xs; + if (xs) { + f$1(i, xs[0]); _i = i + 1 | 0; + _xs = xs[1]; continue ; } else { @@ -641,13 +637,13 @@ function iteri(f, l) { }; } -function foldLeft(f, _accu, _l) { +function foldLeft(_l, _accu, f) { while(true) { - var l = _l; var accu = _accu; + var l = _l; if (l) { - _l = l[1]; _accu = f(accu, l[0]); + _l = l[1]; continue ; } else { @@ -656,15 +652,15 @@ function foldLeft(f, _accu, _l) { }; } -function foldRight(f, l, accu) { +function foldRight(l, accu, f) { if (l) { - return f(l[0], foldRight(f, l[1], accu)); + return f(l[0], foldRight(l[1], accu, f)); } else { return accu; } } -function mapRev2(f, l1, l2) { +function mapRev2(l1, l2, f) { var f$1 = f; var _accu = /* [] */0; var _l1 = l1; @@ -692,7 +688,7 @@ function mapRev2(f, l1, l2) { }; } -function iter2(f, _l1, _l2) { +function iter2(_l1, _l2, f) { while(true) { var l2 = _l2; var l1 = _l1; @@ -712,16 +708,16 @@ function iter2(f, _l1, _l2) { }; } -function foldLeft2(f, _accu, _l1, _l2) { +function foldLeft2(_l1, _l2, _accu, f) { while(true) { + var accu = _accu; var l2 = _l2; var l1 = _l1; - var accu = _accu; if (l1) { if (l2) { + _accu = f(accu, l1[0], l2[0]); _l2 = l2[1]; _l1 = l1[1]; - _accu = f(accu, l1[0], l2[0]); continue ; } else { @@ -733,20 +729,20 @@ function foldLeft2(f, _accu, _l1, _l2) { }; } -function foldRight2(f, l1, l2, accu) { +function foldRight2(l1, l2, accu, f) { if (l1 && l2) { - return f(l1[0], l2[0], foldRight2(f, l1[1], l2[1], accu)); + return f(l1[0], l2[0], foldRight2(l1[1], l2[1], accu, f)); } else { return accu; } } -function forAll(p, _param) { +function forAll(_xs, p) { while(true) { - var param = _param; - if (param) { - if (p(param[0])) { - _param = param[1]; + var xs = _xs; + if (xs) { + if (p(xs[0])) { + _xs = xs[1]; continue ; } else { @@ -758,14 +754,14 @@ function forAll(p, _param) { }; } -function exists(p, _param) { +function exists(_xs, p) { while(true) { - var param = _param; - if (param) { - if (p(param[0])) { + var xs = _xs; + if (xs) { + if (p(xs[0])) { return /* true */1; } else { - _param = param[1]; + _xs = xs[1]; continue ; } @@ -775,7 +771,7 @@ function exists(p, _param) { }; } -function forAll2(p, _l1, _l2) { +function forAll2(_l1, _l2, p) { while(true) { var l2 = _l2; var l1 = _l1; @@ -798,7 +794,7 @@ function forAll2(p, _l1, _l2) { }; } -function exists2(p, _l1, _l2) { +function exists2(_l1, _l2, p) { while(true) { var l2 = _l2; var l1 = _l1; @@ -821,14 +817,14 @@ function exists2(p, _l1, _l2) { }; } -function mem(eq, x, _param) { +function mem(_xs, x, eq) { while(true) { - var param = _param; - if (param) { - if (eq(param[0], x)) { + var xs = _xs; + if (xs) { + if (eq(xs[0], x)) { return /* true */1; } else { - _param = param[1]; + _xs = xs[1]; continue ; } @@ -838,14 +834,14 @@ function mem(eq, x, _param) { }; } -function memq(x, _param) { +function memq(_xs, x) { while(true) { - var param = _param; - if (param) { - if (param[0] === x) { + var xs = _xs; + if (xs) { + if (xs[0] === x) { return /* true */1; } else { - _param = param[1]; + _xs = xs[1]; continue ; } @@ -855,15 +851,15 @@ function memq(x, _param) { }; } -function assocOpt(eq, x, _param) { +function assocOpt(_xs, x, eq) { while(true) { - var param = _param; - if (param) { - var match = param[0]; + var xs = _xs; + if (xs) { + var match = xs[0]; if (eq(match[0], x)) { return /* Some */[match[1]]; } else { - _param = param[1]; + _xs = xs[1]; continue ; } @@ -873,15 +869,15 @@ function assocOpt(eq, x, _param) { }; } -function assqOpt(x, _param) { +function assqOpt(_xs, x) { while(true) { - var param = _param; - if (param) { - var match = param[0]; + var xs = _xs; + if (xs) { + var match = xs[0]; if (match[0] === x) { return /* Some */[match[1]]; } else { - _param = param[1]; + _xs = xs[1]; continue ; } @@ -891,14 +887,14 @@ function assqOpt(x, _param) { }; } -function memAssoc(eq, x, _param) { +function memAssoc(_xs, x, eq) { while(true) { - var param = _param; - if (param) { - if (eq(param[0][0], x)) { + var xs = _xs; + if (xs) { + if (eq(xs[0][0], x)) { return /* true */1; } else { - _param = param[1]; + _xs = xs[1]; continue ; } @@ -908,14 +904,14 @@ function memAssoc(eq, x, _param) { }; } -function memAssq(x, _param) { +function memAssq(_xs, x) { while(true) { - var param = _param; - if (param) { - if (param[0][0] === x) { + var xs = _xs; + if (xs) { + if (xs[0][0] === x) { return /* true */1; } else { - _param = param[1]; + _xs = xs[1]; continue ; } @@ -925,16 +921,16 @@ function memAssq(x, _param) { }; } -function removeAssoc(eq, x, param) { - if (param) { - var l = param[1]; - var pair = param[0]; +function removeAssoc(xs, x, eq) { + if (xs) { + var l = xs[1]; + var pair = xs[0]; if (eq(pair[0], x)) { return l; } else { return /* :: */[ pair, - removeAssoc(eq, x, l) + removeAssoc(l, x, eq) ]; } } else { @@ -942,16 +938,16 @@ function removeAssoc(eq, x, param) { } } -function removeAssq(x, param) { - if (param) { - var l = param[1]; - var pair = param[0]; +function removeAssq(xs, x) { + if (xs) { + var l = xs[1]; + var pair = xs[0]; if (pair[0] === x) { return l; } else { return /* :: */[ pair, - removeAssq(x, l) + removeAssq(l, x) ]; } } else { @@ -959,15 +955,15 @@ function removeAssq(x, param) { } } -function findOpt(p, _param) { +function findOpt(_xs, p) { while(true) { - var param = _param; - if (param) { - var x = param[0]; + var xs = _xs; + if (xs) { + var x = xs[0]; if (p(x)) { return /* Some */[x]; } else { - _param = param[1]; + _xs = xs[1]; continue ; } @@ -977,7 +973,7 @@ function findOpt(p, _param) { }; } -function filter(p, _xs) { +function filter(_xs, p) { while(true) { var xs = _xs; if (xs) { @@ -1001,7 +997,7 @@ function filter(p, _xs) { }; } -function partition(p, l) { +function partition(l, p) { if (l) { var h = l[0]; var nextX = /* :: */[