From aab19f6a502cfd45374212d4d7a1df514f30c284 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 4 Jul 2017 13:13:07 +0200 Subject: [PATCH] update headers; reindent --- src/core/CCArray.mli | 4 +- src/core/CCArray_slice.mli | 8 ++-- src/core/CCFormat.ml | 2 +- src/core/CCList.ml | 14 +++--- src/core/CCList.mli | 14 +++--- src/core/CCResult.ml | 2 +- src/core/CCString.mli | 4 +- src/data/CCBV.ml | 2 +- src/data/CCBV.mli | 6 +-- src/data/CCCache.ml | 24 +--------- src/data/CCCache.mli | 24 +--------- src/data/CCGraph.ml | 2 +- src/data/CCIntMap.ml | 96 +++++++++++++++++++------------------- src/data/CCRingBuffer.ml | 32 ++++++------- src/data/CCSimple_queue.ml | 4 +- src/data/CCZipper.ml | 2 +- 16 files changed, 98 insertions(+), 142 deletions(-) diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 72620658..8bbe8498 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -73,10 +73,10 @@ val sort_indices : ('a -> 'a -> int) -> 'a t -> int array (** [sort_indices cmp a] returns a new array [b], with the same length as [a], such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a] appears in [a]. [a] is not modified. - + In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a]. [sort_indices] yields the inverse permutation of {!sort_ranking}. - + @since 1.0 *) val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array diff --git a/src/core/CCArray_slice.mli b/src/core/CCArray_slice.mli index 4450ddae..1a5989bc 100644 --- a/src/core/CCArray_slice.mli +++ b/src/core/CCArray_slice.mli @@ -88,20 +88,20 @@ val sort_indices : ('a -> 'a -> int) -> 'a t -> int array (** [sort_indices cmp a] returns a new array [b], with the same length as [a], such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a] appears in [a]. [a] is not modified. - + In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a]. [sort_indices] yields the inverse permutation of {!sort_ranking}. - + @since 1.0 *) val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array (** [sort_ranking cmp a] returns a new array [b], with the same length as [a], such that [b.(i)] is the index at which the [i]-the element of [a] appears in [sorted cmp a]. [a] is not modified. - + In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a]. [sort_ranking] yields the inverse permutation of {!sort_indices}. - + In the absence of duplicate elements in [a], we also have [lookup_exn a.(i) (sorted a) = (sorted_ranking a).(i)] @since 1.0 *) diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 431f7850..7e0dfa50 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -77,7 +77,7 @@ let text out (s:string): unit = (*$= & ~printer:(fun s->CCFormat.sprintf "%S" s) "a\nb\nc" (sprintf_no_color "@[%a@]%!" text "a b c") "a b\nc" (sprintf_no_color "@[%a@]%!" text "a b\nc") - *) +*) let list ?(sep=return ",@ ") pp fmt l = let rec pp_list l = match l with diff --git a/src/core/CCList.ml b/src/core/CCList.ml index afad88ca..fcc7a546 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -366,7 +366,7 @@ let combine l1 l2 = if List.length l1=List.length l2 \ then CCList.combine l1 l2 = List.combine l1 l2 \ else Q.assume_fail() ) - *) +*) let combine_gen l1 l2 = let l1 = ref l1 in @@ -385,7 +385,7 @@ let combine_gen l1 l2 = let res1 = combine (take n l1) (take n l2) in \ let res2 = combine_gen l1 l2 |> of_gen in \ res1 = res2) - *) +*) let split l = let rec direct i l = match l with @@ -396,10 +396,10 @@ let split l = | [x1, y1; x2, y2; x3, y3; x4, y4] -> [x1;x2;x3;x4], [y1;y2;y3;y4] | _ when i=0 -> split_slow ([], []) l | (x1, y1) :: - (x2, y2) :: - (x3, y3) :: - (x4, y4) :: - (x5, y5) :: l' -> + (x2, y2) :: + (x3, y3) :: + (x4, y4) :: + (x5, y5) :: l' -> let rx, ry = direct (i-1) l' in x1 :: x2 :: x3 :: x4 :: x5 :: rx, y1 :: y2 :: y3 :: y4 :: y5 :: ry @@ -409,7 +409,7 @@ let split l = let acc = x1 :: fst acc, y1 :: snd acc in split_slow acc l' in - direct direct_depth_default_ l + direct direct_depth_default_ l (*$Q (Q.(list (pair int string))) (fun l -> \ diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 024a232e..c7407f3e 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -114,13 +114,13 @@ val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c val cartesian_product : 'a t t -> 'a t t (** For example: - {[ - # cartesian_product [[1;2];[3];[4;5;6]] = - [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];; - # cartesian_product [[1;2];[];[4;5;6]] = [];; - # cartesian_product [[1;2];[3];[4];[5];[6]] = - [[1;3;4;5;6];[2;3;4;5;6]];; - ]} + {[ + # cartesian_product [[1;2];[3];[4;5;6]] = + [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];; + # cartesian_product [[1;2];[];[4;5;6]] = [];; + # cartesian_product [[1;2];[3];[4];[5];[6]] = + [[1;3;4;5;6];[2;3;4;5;6]];; + ]} invariant: [cartesian_product l = map_product id l]. @since 1.2 *) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index 0d00755c..6c0385e9 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -129,7 +129,7 @@ let fold_ok f acc r = match r with (*$= 42 (fold_ok (+) 2 (Ok 40)) 40 (fold_ok (+) 40 (Error "foo")) - *) +*) let is_ok = function | Ok _ -> true diff --git a/src/core/CCString.mli b/src/core/CCString.mli index 83fde8c7..70ee10bf 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -375,7 +375,7 @@ val rtrim : t -> t Q.(printable_string) (fun s -> \ let s' = rtrim s in \ if s'="" then Q.assume_fail() else s'.[String.length s'-1] <> ' ') - *) +*) (** {2 Operations on 2 strings} *) @@ -654,7 +654,7 @@ module Sub : sig (*$= & ~printer:(String.make 1) 'b' Sub.(get (make "abc" 1 ~len:2) 0) 'c' Sub.(get (make "abc" 1 ~len:2) 1) - *) + *) (*$QR Q.(printable_string_of_size Gen.(3--10)) (fun s -> diff --git a/src/data/CCBV.ml b/src/data/CCBV.ml index 74ea2e7a..2fb734de 100644 --- a/src/data/CCBV.ml +++ b/src/data/CCBV.ml @@ -269,7 +269,7 @@ let iter bv f = let bv = create ~size:n true in \ let l = iter bv |> Sequence.zip |> Sequence.to_list in \ List.length l = n && List.for_all (fun (_,b) -> b) l) - *) +*) let iter_true bv f = iter bv (fun i b -> if b then f i else ()) diff --git a/src/data/CCBV.mli b/src/data/CCBV.mli index 247aafee..a67d28e5 100644 --- a/src/data/CCBV.mli +++ b/src/data/CCBV.mli @@ -86,9 +86,9 @@ val first : t -> int option changed type at 1.2 *) val first_exn : t -> int - (** First set bit, or - @raise Not_found if all bits are 0 - @since 1.2 *) +(** First set bit, or + @raise Not_found if all bits are 0 + @since 1.2 *) val filter : t -> (int -> bool) -> unit (** [filter bv p] only keeps the true bits of [bv] whose [index] diff --git a/src/data/CCCache.ml b/src/data/CCCache.ml index a5d70c58..fa75ff95 100644 --- a/src/data/CCCache.ml +++ b/src/data/CCCache.ml @@ -1,27 +1,5 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -*) +(* This file is free software, part of containers. See file "license" for more details. *) (** {1 Caches} *) diff --git a/src/data/CCCache.mli b/src/data/CCCache.mli index 1d49afe7..c22e469f 100644 --- a/src/data/CCCache.mli +++ b/src/data/CCCache.mli @@ -1,27 +1,5 @@ -(* -Copyright (c) 2013, Simon Cruanes -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. Redistributions in binary -form must reproduce the above copyright notice, this list of conditions and the -following disclaimer in the documentation and/or other materials provided with -the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -*) +(* This file is free software, part of containers. See file "license" for more details. *) (** {1 Caches} diff --git a/src/data/CCGraph.ml b/src/data/CCGraph.ml index e0cf7401..067f9c3d 100644 --- a/src/data/CCGraph.ml +++ b/src/data/CCGraph.ml @@ -300,7 +300,7 @@ module Traverse = struct `Exit 345614] in assert_equal expected l - *) + *) end (** {2 Cycles} *) diff --git a/src/data/CCIntMap.ml b/src/data/CCIntMap.ml index 78eaa7a7..cf2e6f82 100644 --- a/src/data/CCIntMap.ml +++ b/src/data/CCIntMap.ml @@ -238,13 +238,13 @@ let update k f t = let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2) let rec equal ~eq a b = a==b || match a, b with - | E, E -> true - | L (ka, va), L (kb, vb) -> ka = kb && eq va vb - | N (pa, sa, la, ra), N (pb, sb, lb, rb) -> - pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb - | E, _ - | N _, _ - | L _, _ -> false + | E, E -> true + | L (ka, va), L (kb, vb) -> ka = kb && eq va vb + | N (pa, sa, la, ra), N (pb, sb, lb, rb) -> + pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb + | E, _ + | N _, _ + | L _, _ -> false (*$Q Q.(list (pair int bool)) ( fun l -> \ @@ -289,23 +289,23 @@ let choose t = let rec union f t1 t2 = if t1==t2 then t1 else match t1, t2 with - | E, o | o, E -> o - | L (k, v), o - | o, L (k, v) -> - (* insert k, v into o *) - insert_ (fun ~old v -> f k old v) k v o - | N (p1, m1, l1, r1), N (p2, m2, l2, r2) -> - if p1 = p2 && m1 = m2 - then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2) - else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1 - then if Bit.is_0 p2 ~bit:m1 - then N (p1, m1, union f l1 t2, r1) - else N (p1, m1, l1, union f r1 t2) - else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2 - then if Bit.is_0 p1 ~bit:m2 - then N (p2, m2, union f t1 l2, r2) - else N (p2, m2, l2, union f t1 r2) - else join_ t1 p1 t2 p2 + | E, o | o, E -> o + | L (k, v), o + | o, L (k, v) -> + (* insert k, v into o *) + insert_ (fun ~old v -> f k old v) k v o + | N (p1, m1, l1, r1), N (p2, m2, l2, r2) -> + if p1 = p2 && m1 = m2 + then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2) + else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1 + then if Bit.is_0 p2 ~bit:m1 + then N (p1, m1, union f l1 t2, r1) + else N (p1, m1, l1, union f r1 t2) + else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2 + then if Bit.is_0 p1 ~bit:m2 + then N (p2, m2, union f t1 l2, r2) + else N (p2, m2, l2, union f t1 r2) + else join_ t1 p1 t2 p2 (*$Q & ~small:(fun (a,b) -> List.length a + List.length b) Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) -> \ @@ -344,26 +344,26 @@ let rec union f t1 t2 = let rec inter f a b = if a==b then a else match a, b with - | E, _ | _, E -> E - | L (k, v), o - | o, L (k, v) -> - begin try - let v' = find_exn k o in - L (k, f k v v') - with Not_found -> E - end - | N (p1, m1, l1, r1), N (p2, m2, l2, r2) -> - if p1 = p2 && m1 = m2 - then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2) - else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1 - then if Bit.is_0 p2 ~bit:m1 - then inter f l1 b - else inter f r1 b - else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2 - then if Bit.is_0 p1 ~bit:m2 - then inter f a l2 - else inter f a r2 - else E + | E, _ | _, E -> E + | L (k, v), o + | o, L (k, v) -> + begin try + let v' = find_exn k o in + L (k, f k v v') + with Not_found -> E + end + | N (p1, m1, l1, r1), N (p2, m2, l2, r2) -> + if p1 = p2 && m1 = m2 + then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2) + else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1 + then if Bit.is_0 p2 ~bit:m1 + then inter f l1 b + else inter f r1 b + else if Bit.lt m1 m2 && is_prefix_ ~prefix:p2 p1 ~bit:m2 + then if Bit.is_0 p1 ~bit:m2 + then inter f a l2 + else inter f a r2 + else E (*$R assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (print CCString.print)) @@ -544,7 +544,7 @@ let print pp_x out m = (* Some thorough tests from Jan Midtgaar https://github.com/jmid/qc-ptrees - *) +*) (*$inject let test_count = 2_500 @@ -684,14 +684,14 @@ let print pp_x out m = (fun (t,k,v) -> let s = interpret t in abstract (add k v s) = add_m k v (abstract s)) - *) +*) (*$QR & ~count:test_count (pair arb_tree arb_int) (fun (t,n) -> let s = interpret t in abstract (remove n s) = remove_m n (abstract s)) - *) +*) (*$QR & ~count:test_count (pair arb_tree arb_tree) @@ -699,7 +699,7 @@ let print pp_x out m = let s = interpret t in let s' = interpret t' in abstract (union merge_f s s') = union_m (abstract s) (abstract s')) - *) +*) (*$QR & ~count:test_count Q.(pair arb_tree arb_tree) diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml index 45d39c39..0d344bef 100644 --- a/src/data/CCRingBuffer.ml +++ b/src/data/CCRingBuffer.ml @@ -201,7 +201,7 @@ end let g_char = map Char.chr (Char.code 'A' -- Char.code 'z') let g_str = string_size ~gen:g_char (0--10) let a_str = {Q.string with Q.gen=g_str} - *) +*) module MakeFromArray(A:Array.S) : S with module Array = A = struct module Array = A @@ -638,9 +638,9 @@ module Make(Elt:sig *) (*$inject -module BS = CCRingBuffer.Byte + module BS = CCRingBuffer.Byte -type op = + type op = | Push_back of char | Take_front | Take_back @@ -652,7 +652,7 @@ type op = | Blit of string * int * int | Z_if_full -let str_of_op = function + let str_of_op = function | Push_back c -> Printf.sprintf "push_back(%C)" c | Take_front -> Printf.sprintf "take_front" | Take_back -> Printf.sprintf "take_back" @@ -664,15 +664,15 @@ let str_of_op = function | Blit (s,i,len) -> Printf.sprintf "blit(%S,%d,%d)" s i len | Z_if_full -> "zero_if_full" -let push_back c = Push_back c -let skip n = assert (n>=0); Skip n -let blit s i len = + let push_back c = Push_back c + let skip n = assert (n>=0); Skip n + let blit s i len = if i<0 || len<0 || i+len > String.length s then ( failwith ("wrong blit: " ^ str_of_op (Blit (s,i,len))); ); Blit (s,i,len) -let shrink_op = + let shrink_op = let open Q.Iter in function | Push_back c -> Q.Shrink.char c >|= push_back @@ -695,14 +695,14 @@ let shrink_op = in append s_i (append s_len s_s) -let rec len_op size acc = function + let rec len_op size acc = function | Push_back _ -> min size (acc + 1) | Take_front | Take_back | Junk_front | Junk_back -> max (acc-1) 0 | Skip n -> if acc >= n then acc-n else acc | Z_if_full | Peek_front | Peek_back -> acc | Blit (_,_,len) -> min size (acc + len) -let apply_op b = function + let apply_op b = function | Push_back c -> BS.push_back b c; None | Take_front -> BS.take_front b | Take_back -> BS.take_back b @@ -716,7 +716,7 @@ let apply_op b = function BS.blit_from b (Bytes.unsafe_of_string s) i len; None | Z_if_full -> if BS.is_full b then Some '0' else None -let gen_op = + let gen_op = let open Q.Gen in let g_blit = string_size ~gen:g_char (5--20) >>= fun s -> @@ -738,15 +738,15 @@ let gen_op = 1, return Z_if_full; ] -let arb_op = + let arb_op = Q.make ~shrink:shrink_op ~print:str_of_op gen_op -let arb_ops = Q.list arb_op + let arb_ops = Q.list arb_op -module L_impl = struct + module L_impl = struct type t = { size: int; mutable l: char list; @@ -796,12 +796,12 @@ module L_impl = struct | Z_if_full -> if b.size = List.length b.l then Some '0' else None let to_list b = b.l -end + end *) (* check that a lot of operations can be applied without failure, - and that the result has correct length *) + and that the result has correct length *) (*$QR & ~count:3_000 arb_ops (fun ops -> let size = 64 in diff --git a/src/data/CCSimple_queue.ml b/src/data/CCSimple_queue.ml index 7bc68efd..ed9b639c 100644 --- a/src/data/CCSimple_queue.ml +++ b/src/data/CCSimple_queue.ml @@ -53,7 +53,7 @@ let pop q = Q.(list small_int) (fun l -> \ let q = of_list l in \ equal CCInt.equal (Gen.unfold pop q |> of_gen) q) - *) +*) let junk q = try @@ -180,7 +180,7 @@ let append q1 q2 = equal CCInt.equal \ (append (of_list l1)(of_list l2)) \ (of_list (List.append l1 l2))) - *) +*) module Infix = struct let (>|=) q f = map f q diff --git a/src/data/CCZipper.ml b/src/data/CCZipper.ml index b978838b..30d227d1 100644 --- a/src/data/CCZipper.ml +++ b/src/data/CCZipper.ml @@ -17,7 +17,7 @@ let to_rev_list (l,r) = List.rev_append r l (*$inject let zip_gen = Q.(pair (small_list int)(small_list int)) - *) +*) (*$Q zip_gen (fun z -> \