simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-28 03:44:51 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

formattign, headers

Browse source
This commit is contained in:
Simon Cruanes 2016-04-22 22:08:40 +02:00
parent b17f55b1d1
commit 0485bc5cd9
4 changed files with 150 additions and 238 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

172
src/data/CCFQueue.ml
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without (* This file is free software, part of containers. See file "license" for more details. *)
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.
*)
(** {1 Functional queues (fifo)} *) (** {1 Functional queues (fifo)} *)
@ -73,39 +51,39 @@ let _empty = Lazy.from_val empty
let rec cons : 'a. 'a -> 'a t -> 'a t let rec cons : 'a. 'a -> 'a t -> 'a t
= fun x q -> match q with = fun x q -> match q with
| Shallow Zero -> _single x | Shallow Zero -> _single x
| Shallow (One y) -> Shallow (Two (x,y)) | Shallow (One y) -> Shallow (Two (x,y))
| Shallow (Two (y,z)) -> Shallow (Three (x,y,z)) | Shallow (Two (y,z)) -> Shallow (Three (x,y,z))
| Shallow (Three (y,z,z')) -> | Shallow (Three (y,z,z')) ->
_deep 4 (Two (x,y)) _empty (Two (z,z')) _deep 4 (Two (x,y)) _empty (Two (z,z'))
| Deep (_, Zero, _middle, _tl) -> assert false | Deep (_, Zero, _middle, _tl) -> assert false
| Deep (n,One y, middle, tl) -> _deep (n+1) (Two (x,y)) middle tl | Deep (n,One y, middle, tl) -> _deep (n+1) (Two (x,y)) middle tl
| Deep (n,Two (y,z), middle, tl) -> _deep (n+1)(Three (x,y,z)) middle tl | Deep (n,Two (y,z), middle, tl) -> _deep (n+1)(Three (x,y,z)) middle tl
| Deep (n,Three (y,z,z'), lazy q', tail) -> | Deep (n,Three (y,z,z'), lazy q', tail) ->
_deep (n+1) (Two (x,y)) (lazy (cons (z,z') q')) tail _deep (n+1) (Two (x,y)) (lazy (cons (z,z') q')) tail
(*$Q (*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
cons x (of_list l) |> to_list = x::l) cons x (of_list l) |> to_list = x::l)
*) *)
let rec snoc : 'a. 'a t -> 'a -> 'a t let rec snoc : 'a. 'a t -> 'a -> 'a t
= fun q x -> match q with = fun q x -> match q with
| Shallow Zero -> _single x | Shallow Zero -> _single x
| Shallow (One y) -> Shallow (Two (y,x)) | Shallow (One y) -> Shallow (Two (y,x))
| Shallow (Two (y,z)) -> Shallow (Three (y,z,x)) | Shallow (Two (y,z)) -> Shallow (Three (y,z,x))
| Shallow (Three (y,z,z')) -> | Shallow (Three (y,z,z')) ->
_deep 4 (Two (y,z)) _empty (Two (z',x)) _deep 4 (Two (y,z)) _empty (Two (z',x))
| Deep (_,_hd, _middle, Zero) -> assert false | Deep (_,_hd, _middle, Zero) -> assert false
| Deep (n,hd, middle, One y) -> _deep (n+1) hd middle (Two(y,x)) | Deep (n,hd, middle, One y) -> _deep (n+1) hd middle (Two(y,x))
| Deep (n,hd, middle, Two (y,z)) -> _deep (n+1) hd middle (Three(y,z,x)) | Deep (n,hd, middle, Two (y,z)) -> _deep (n+1) hd middle (Three(y,z,x))
| Deep (n,hd, lazy q', Three (y,z,z')) -> | Deep (n,hd, lazy q', Three (y,z,z')) ->
_deep (n+1) hd (lazy (snoc q' (y,z))) (Two(z',x)) _deep (n+1) hd (lazy (snoc q' (y,z))) (Two(z',x))
(*$Q (*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
snoc (of_list l) x |> to_list = l @ [x]) snoc (of_list l) x |> to_list = l @ [x])
*) *)
(*$R (*$R
let q = List.fold_left snoc empty [1;2;3;4;5] in let q = List.fold_left snoc empty [1;2;3;4;5] in
@ -117,27 +95,27 @@ let rec snoc : 'a. 'a t -> 'a -> 'a t
let rec take_front_exn : 'a. 'a t -> ('a *'a t) let rec take_front_exn : 'a. 'a t -> ('a *'a t)
= fun q -> match q with = fun q -> match q with
| Shallow Zero -> raise Empty | Shallow Zero -> raise Empty
| Shallow (One x) -> x, empty | Shallow (One x) -> x, empty
| Shallow (Two (x,y)) -> x, Shallow (One y) | Shallow (Two (x,y)) -> x, Shallow (One y)
| Shallow (Three (x,y,z)) -> x, Shallow (Two (y,z)) | Shallow (Three (x,y,z)) -> x, Shallow (Two (y,z))
| Deep (_,Zero, _, _) -> assert false | Deep (_,Zero, _, _) -> assert false
| Deep (n,One x, lazy q', tail) -> | Deep (n,One x, lazy q', tail) ->
if is_empty q' if is_empty q'
then x, Shallow tail then x, Shallow tail
else else
let (y,z), q' = take_front_exn q' in let (y,z), q' = take_front_exn q' in
x, _deep (n-1)(Two (y,z)) (Lazy.from_val q') tail x, _deep (n-1)(Two (y,z)) (Lazy.from_val q') tail
| Deep (n,Two (x,y), middle, tail) -> | Deep (n,Two (x,y), middle, tail) ->
x, _deep (n-1) (One y) middle tail x, _deep (n-1) (One y) middle tail
| Deep (n,Three (x,y,z), middle, tail) -> | Deep (n,Three (x,y,z), middle, tail) ->
x, _deep (n-1) (Two(y,z)) middle tail x, _deep (n-1) (Two(y,z)) middle tail
(*$Q (*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
let x', q = cons x (of_list l) |> take_front_exn in \ let x', q = cons x (of_list l) |> take_front_exn in \
x'=x && to_list q = l) x'=x && to_list q = l)
*) *)
(*$R (*$R
let q = of_list [1;2;3;4] in let q = of_list [1;2;3;4] in
@ -180,25 +158,25 @@ let take_front_while p q =
let rec take_back_exn : 'a. 'a t -> 'a t * 'a let rec take_back_exn : 'a. 'a t -> 'a t * 'a
= fun q -> match q with = fun q -> match q with
| Shallow Zero -> invalid_arg "FQueue.take_back_exn" | Shallow Zero -> invalid_arg "FQueue.take_back_exn"
| Shallow (One x) -> empty, x | Shallow (One x) -> empty, x
| Shallow (Two (x,y)) -> _single x, y | Shallow (Two (x,y)) -> _single x, y
| Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z | Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z
| Deep (_, _hd, _middle, Zero) -> assert false | Deep (_, _hd, _middle, Zero) -> assert false
| Deep (n, hd, lazy q', One x) -> | Deep (n, hd, lazy q', One x) ->
if is_empty q' if is_empty q'
then Shallow hd, x then Shallow hd, x
else else
let q'', (y,z) = take_back_exn q' in let q'', (y,z) = take_back_exn q' in
_deep (n-1) hd (Lazy.from_val q'') (Two (y,z)), x _deep (n-1) hd (Lazy.from_val q'') (Two (y,z)), x
| Deep (n, hd, middle, Two(x,y)) -> _deep (n-1) hd middle (One x), y | Deep (n, hd, middle, Two(x,y)) -> _deep (n-1) hd middle (One x), y
| Deep (n, hd, middle, Three(x,y,z)) -> _deep (n-1) hd middle (Two (x,y)), z | Deep (n, hd, middle, Three(x,y,z)) -> _deep (n-1) hd middle (Two (x,y)), z
(*$Q (*$Q
(Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \
let q,x' = snoc (of_list l) x |> take_back_exn in \ let q,x' = snoc (of_list l) x |> take_back_exn in \
x'=x && to_list q = l) x'=x && to_list q = l)
*) *)
let take_back q = let take_back q =
try Some (take_back_exn q) try Some (take_back_exn q)
@ -242,8 +220,8 @@ let _size_digit = function
let size : 'a. 'a t -> int let size : 'a. 'a t -> int
= function = function
| Shallow d -> _size_digit d | Shallow d -> _size_digit d
| Deep (n, _, _, _) -> n | Deep (n, _, _, _) -> n
(*$Q (*$Q
(Q.list Q.int) (fun l -> \ (Q.list Q.int) (fun l -> \
@ -262,15 +240,15 @@ let _nth_digit i d = match i, d with
let rec nth_exn : 'a. int -> 'a t -> 'a let rec nth_exn : 'a. int -> 'a t -> 'a
= fun i q -> match i, q with = fun i q -> match i, q with
| _, Shallow Zero -> raise Not_found | _, Shallow Zero -> raise Not_found
| 0, Shallow (One x) -> x | 0, Shallow (One x) -> x
| 0, Shallow (Two (x,_)) -> x | 0, Shallow (Two (x,_)) -> x
| 1, Shallow (Two (_,x)) -> x | 1, Shallow (Two (_,x)) -> x
| 0, Shallow (Three (x,_,_)) -> x | 0, Shallow (Three (x,_,_)) -> x
| 1, Shallow (Three (_,x,_)) -> x | 1, Shallow (Three (_,x,_)) -> x
| 2, Shallow (Three (_,_,x)) -> x | 2, Shallow (Three (_,_,x)) -> x
| _, Shallow _ -> raise Not_found | _, Shallow _ -> raise Not_found
| _, Deep (_, l, q, r) -> | _, Deep (_, l, q, r) ->
if i<_size_digit l if i<_size_digit l
then _nth_digit i l then _nth_digit i l
else else
@ -326,7 +304,7 @@ let add_seq_front seq q =
(*$Q (*$Q
Q.(pair (list int) (list int)) (fun (l1, l2) -> \ Q.(pair (list int) (list int)) (fun (l1, l2) -> \
add_seq_front (Sequence.of_list l1) (of_list l2) |> to_list = l1 @ l2) add_seq_front (Sequence.of_list l1) (of_list l2) |> to_list = l1 @ l2)
*) *)
let add_seq_back q seq = let add_seq_back q seq =
let q = ref q in let q = ref q in
@ -341,8 +319,8 @@ let _digit_to_seq d k = match d with
let rec to_seq : 'a. 'a t -> 'a sequence let rec to_seq : 'a. 'a t -> 'a sequence
= fun q k -> match q with = fun q k -> match q with
| Shallow d -> _digit_to_seq d k | Shallow d -> _digit_to_seq d k
| Deep (_, hd, lazy q', tail) -> | Deep (_, hd, lazy q', tail) ->
_digit_to_seq hd k; _digit_to_seq hd k;
to_seq q' (fun (x,y) -> k x; k y); to_seq q' (fun (x,y) -> k x; k y);
_digit_to_seq tail k _digit_to_seq tail k
@ -354,9 +332,9 @@ let rec to_seq : 'a. 'a t -> 'a sequence
let append q1 q2 = let append q1 q2 =
match q1, q2 with match q1, q2 with
| Shallow Zero, _ -> q2 | Shallow Zero, _ -> q2
| _, Shallow Zero -> q1 | _, Shallow Zero -> q1
| _ -> add_seq_back q1 (to_seq q2) | _ -> add_seq_back q1 (to_seq q2)
(*$Q (*$Q
(Q.pair (Q.list Q.int)(Q.list Q.int)) (fun (l1,l2) -> \ (Q.pair (Q.list Q.int)(Q.list Q.int)) (fun (l1,l2) -> \
@ -379,8 +357,8 @@ let _map_digit f d = match d with
let rec map : 'a 'b. ('a -> 'b) -> 'a t -> 'b t let rec map : 'a 'b. ('a -> 'b) -> 'a t -> 'b t
= fun f q -> match q with = fun f q -> match q with
| Shallow d -> Shallow (_map_digit f d) | Shallow d -> Shallow (_map_digit f d)
| Deep (size, hd, lazy q', tl) -> | Deep (size, hd, lazy q', tl) ->
let q'' = map (fun (x,y) -> f x, f y) q' in let q'' = map (fun (x,y) -> f x, f y) q' in
_deep size (_map_digit f hd) (Lazy.from_val q'') (_map_digit f tl) _deep size (_map_digit f hd) (Lazy.from_val q'') (_map_digit f tl)
@ -399,8 +377,8 @@ let _fold_digit f acc d = match d with
let rec fold : 'a 'b. ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b let rec fold : 'a 'b. ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
= fun f acc q -> match q with = fun f acc q -> match q with
| Shallow d -> _fold_digit f acc d | Shallow d -> _fold_digit f acc d
| Deep (_, hd, lazy q', tl) -> | Deep (_, hd, lazy q', tl) ->
let acc = _fold_digit f acc hd in let acc = _fold_digit f acc hd in
let acc = fold (fun acc (x,y) -> f (f acc x) y) acc q' in let acc = fold (fun acc (x,y) -> f (f acc x) y) acc q' in
_fold_digit f acc tl _fold_digit f acc tl
@ -455,18 +433,18 @@ let _digit_to_klist d cont = match d with
let rec _flat_klist : 'a. ('a * 'a) klist -> 'a klist -> 'a klist let rec _flat_klist : 'a. ('a * 'a) klist -> 'a klist -> 'a klist
= fun l cont () -> match l () with = fun l cont () -> match l () with
| `Nil -> cont () | `Nil -> cont ()
| `Cons ((x,y),l') -> _double x y (_flat_klist l' cont) () | `Cons ((x,y),l') -> _double x y (_flat_klist l' cont) ()
let to_klist q = let to_klist q =
let rec aux : 'a. 'a t -> 'a klist -> 'a klist let rec aux : 'a. 'a t -> 'a klist -> 'a klist
= fun q cont () -> match q with = fun q cont () -> match q with
| Shallow d -> _digit_to_klist d cont () | Shallow d -> _digit_to_klist d cont ()
| Deep (_, hd, lazy q', tl) -> | Deep (_, hd, lazy q', tl) ->
_digit_to_klist hd _digit_to_klist hd
(_flat_klist (_flat_klist
(aux q' _nil) (aux q' _nil)
(_digit_to_klist tl cont)) (_digit_to_klist tl cont))
() ()
in in
aux q _nil aux q _nil
@ -483,7 +461,7 @@ let rec _equal_klist eq l1 l2 = match l1(), l2() with
| `Nil, _ | `Nil, _
| _, `Nil -> false | _, `Nil -> false
| `Cons(x1,l1'), `Cons(x2,l2') -> | `Cons(x1,l1'), `Cons(x2,l2') ->
eq x1 x2 && _equal_klist eq l1' l2' eq x1 x2 && _equal_klist eq l1' l2'
let equal eq q1 q2 = _equal_klist eq (to_klist q1) (to_klist q2) let equal eq q1 q2 = _equal_klist eq (to_klist q1) (to_klist q2)
@ -512,7 +490,7 @@ let print pp_x out d =
Format.fprintf out "@[<hov2>queue {"; Format.fprintf out "@[<hov2>queue {";
iter iter
(fun x -> (fun x ->
if !first then first:= false else Format.fprintf out ";@ "; if !first then first:= false else Format.fprintf out ";@ ";
pp_x out x pp_x out x
) d; ) d;
Format.fprintf out "}@]" Format.fprintf out "}@]"

32
src/data/CCFQueue.mli
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without (* This file is free software, part of containers. See file "license" for more details. *)
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.
*)
(** {1 Functional queues} *) (** {1 Functional queues} *)
@ -33,7 +11,7 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Basics} *) (** {2 Basics} *)
type +'a t type +'a t
(** Queue containing elements of type 'a *) (** Queue containing elements of type 'a *)
val empty : 'a t val empty : 'a t
@ -107,9 +85,9 @@ val init : 'a t -> 'a t
(** {2 Global Operations} *) (** {2 Global Operations} *)
val append : 'a t -> 'a t -> 'a t val append : 'a t -> 'a t -> 'a t
(** Append two queues. Elements from the second one come (** Append two queues. Elements from the second one come
after elements of the first one. after elements of the first one.
Linear in the size of the second queue. *) Linear in the size of the second queue. *)
val rev : 'a t -> 'a t val rev : 'a t -> 'a t
(** Reverse the queue, O(n) complexity (** Reverse the queue, O(n) complexity

160
src/iter/CCKList.ml
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without (* This file is free software, part of containers. See file "license" for more details. *)
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.
*)
(** {1 Continuation List} *) (** {1 Continuation List} *)
@ -72,15 +50,15 @@ let rec equal eq l1 l2 = match l1(), l2() with
| `Nil, _ | `Nil, _
| _, `Nil -> false | _, `Nil -> false
| `Cons (x1,l1'), `Cons (x2,l2') -> | `Cons (x1,l1'), `Cons (x2,l2') ->
eq x1 x2 && equal eq l1' l2' eq x1 x2 && equal eq l1' l2'
let rec compare cmp l1 l2 = match l1(), l2() with let rec compare cmp l1 l2 = match l1(), l2() with
| `Nil, `Nil -> 0 | `Nil, `Nil -> 0
| `Nil, _ -> -1 | `Nil, _ -> -1
| _, `Nil -> 1 | _, `Nil -> 1
| `Cons (x1,l1'), `Cons (x2,l2') -> | `Cons (x1,l1'), `Cons (x2,l2') ->
let c = cmp x1 x2 in let c = cmp x1 x2 in
if c = 0 then compare cmp l1' l2' else c if c = 0 then compare cmp l1' l2' else c
let rec fold f acc res = match res () with let rec fold f acc res = match res () with
| `Nil -> acc | `Nil -> acc
@ -94,8 +72,8 @@ let iteri f l =
let rec aux f l i = match l() with let rec aux f l i = match l() with
| `Nil -> () | `Nil -> ()
| `Cons (x, l') -> | `Cons (x, l') ->
f i x; f i x;
aux f l' (i+1) aux f l' (i+1)
in in
aux f l 0 aux f l 0
@ -110,7 +88,7 @@ let rec take n (l:'a t) () =
let rec take_while p l () = match l () with let rec take_while p l () = match l () with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (x,l') -> | `Cons (x,l') ->
if p x then `Cons (x, take_while p l') else `Nil if p x then `Cons (x, take_while p l') else `Nil
(*$T (*$T
of_list [1;2;3;4] |> take_while (fun x->x < 4) |> to_list = [1;2;3] of_list [1;2;3;4] |> take_while (fun x->x < 4) |> to_list = [1;2;3]
@ -144,7 +122,7 @@ let mapi f l =
let rec aux f l i () = match l() with let rec aux f l i () = match l() with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (x, tl) -> | `Cons (x, tl) ->
`Cons (f i x, aux f tl (i+1)) `Cons (f i x, aux f tl (i+1))
in in
aux f l 0 aux f l 0
@ -155,10 +133,10 @@ let mapi f l =
let rec fmap f (l:'a t) () = match l() with let rec fmap f (l:'a t) () = match l() with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (x, l') -> | `Cons (x, l') ->
begin match f x with begin match f x with
| None -> fmap f l' () | None -> fmap f l' ()
| Some y -> `Cons (y, fmap f l') | Some y -> `Cons (y, fmap f l')
end end
(*$T (*$T
fmap (fun x -> if x mod 2=0 then Some (x*3) else None) (1--10) |> to_list \ fmap (fun x -> if x mod 2=0 then Some (x*3) else None) (1--10) |> to_list \
@ -168,9 +146,9 @@ let rec fmap f (l:'a t) () = match l() with
let rec filter p l () = match l () with let rec filter p l () = match l () with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (x, l') -> | `Cons (x, l') ->
if p x if p x
then `Cons (x, filter p l') then `Cons (x, filter p l')
else filter p l' () else filter p l' ()
let rec append l1 l2 () = match l1 () with let rec append l1 l2 () = match l1 () with
| `Nil -> l2 () | `Nil -> l2 ()
@ -195,25 +173,25 @@ let rec unfold f acc () = match f acc with
let rec flat_map f l () = match l () with let rec flat_map f l () = match l () with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (x, l') -> | `Cons (x, l') ->
_flat_map_app f (f x) l' () _flat_map_app f (f x) l' ()
and _flat_map_app f l l' () = match l () with and _flat_map_app f l l' () = match l () with
| `Nil -> flat_map f l' () | `Nil -> flat_map f l' ()
| `Cons (x, tl) -> | `Cons (x, tl) ->
`Cons (x, _flat_map_app f tl l') `Cons (x, _flat_map_app f tl l')
let product_with f l1 l2 = let product_with f l1 l2 =
let rec _next_left h1 tl1 h2 tl2 () = let rec _next_left h1 tl1 h2 tl2 () =
match tl1() with match tl1() with
| `Nil -> _next_right ~die:true h1 tl1 h2 tl2 () | `Nil -> _next_right ~die:true h1 tl1 h2 tl2 ()
| `Cons (x, tl1') -> | `Cons (x, tl1') ->
_map_list_left x h2 _map_list_left x h2
(_next_right ~die:false (x::h1) tl1' h2 tl2) (_next_right ~die:false (x::h1) tl1' h2 tl2)
() ()
and _next_right ~die h1 tl1 h2 tl2 () = and _next_right ~die h1 tl1 h2 tl2 () =
match tl2() with match tl2() with
| `Nil when die -> `Nil | `Nil when die -> `Nil
| `Nil -> _next_left h1 tl1 h2 tl2 () | `Nil -> _next_left h1 tl1 h2 tl2 ()
| `Cons (y, tl2') -> | `Cons (y, tl2') ->
_map_list_right h1 y _map_list_right h1 y
(_next_left h1 tl1 (y::h2) tl2') (_next_left h1 tl1 (y::h2) tl2')
() ()
@ -232,7 +210,7 @@ let product l1 l2 =
let rec group eq l () = match l() with let rec group eq l () = match l() with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (x, l') -> | `Cons (x, l') ->
`Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l')) `Cons (cons x (take_while (eq x) l'), group eq (drop_while (eq x) l'))
(*$T (*$T
of_list [1;1;1;2;2;3;3;1] |> group (=) |> map to_list |> to_list = \ of_list [1;1;1;2;2;3;3;1] |> group (=) |> map to_list |> to_list = \
@ -242,21 +220,21 @@ let rec group eq l () = match l() with
let rec _uniq eq prev l () = match prev, l() with let rec _uniq eq prev l () = match prev, l() with
| _, `Nil -> `Nil | _, `Nil -> `Nil
| None, `Cons (x, l') -> | None, `Cons (x, l') ->
`Cons (x, _uniq eq (Some x) l') `Cons (x, _uniq eq (Some x) l')
| Some y, `Cons (x, l') -> | Some y, `Cons (x, l') ->
if eq x y if eq x y
then _uniq eq prev l' () then _uniq eq prev l' ()
else `Cons (x, _uniq eq (Some x) l') else `Cons (x, _uniq eq (Some x) l')
let uniq eq l = _uniq eq None l let uniq eq l = _uniq eq None l
let rec filter_map f l () = match l() with let rec filter_map f l () = match l() with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (x, l') -> | `Cons (x, l') ->
begin match f x with begin match f x with
| None -> filter_map f l' () | None -> filter_map f l' ()
| Some y -> `Cons (y, filter_map f l') | Some y -> `Cons (y, filter_map f l')
end end
let flatten l = flat_map (fun x->x) l let flatten l = flat_map (fun x->x) l
@ -279,39 +257,39 @@ let rec fold2 f acc l1 l2 = match l1(), l2() with
| `Nil, _ | `Nil, _
| _, `Nil -> acc | _, `Nil -> acc
| `Cons(x1,l1'), `Cons(x2,l2') -> | `Cons(x1,l1'), `Cons(x2,l2') ->
fold2 f (f acc x1 x2) l1' l2' fold2 f (f acc x1 x2) l1' l2'
let rec map2 f l1 l2 () = match l1(), l2() with let rec map2 f l1 l2 () = match l1(), l2() with
| `Nil, _ | `Nil, _
| _, `Nil -> `Nil | _, `Nil -> `Nil
| `Cons(x1,l1'), `Cons(x2,l2') -> | `Cons(x1,l1'), `Cons(x2,l2') ->
`Cons (f x1 x2, map2 f l1' l2') `Cons (f x1 x2, map2 f l1' l2')
let rec iter2 f l1 l2 = match l1(), l2() with let rec iter2 f l1 l2 = match l1(), l2() with
| `Nil, _ | `Nil, _
| _, `Nil -> () | _, `Nil -> ()
| `Cons(x1,l1'), `Cons(x2,l2') -> | `Cons(x1,l1'), `Cons(x2,l2') ->
f x1 x2; iter2 f l1' l2' f x1 x2; iter2 f l1' l2'
let rec for_all2 f l1 l2 = match l1(), l2() with let rec for_all2 f l1 l2 = match l1(), l2() with
| `Nil, _ | `Nil, _
| _, `Nil -> true | _, `Nil -> true
| `Cons(x1,l1'), `Cons(x2,l2') -> | `Cons(x1,l1'), `Cons(x2,l2') ->
f x1 x2 && for_all2 f l1' l2' f x1 x2 && for_all2 f l1' l2'
let rec exists2 f l1 l2 = match l1(), l2() with let rec exists2 f l1 l2 = match l1(), l2() with
| `Nil, _ | `Nil, _
| _, `Nil -> false | _, `Nil -> false
| `Cons(x1,l1'), `Cons(x2,l2') -> | `Cons(x1,l1'), `Cons(x2,l2') ->
f x1 x2 || exists2 f l1' l2' f x1 x2 || exists2 f l1' l2'
let rec merge cmp l1 l2 () = match l1(), l2() with let rec merge cmp l1 l2 () = match l1(), l2() with
| `Nil, tl2 -> tl2 | `Nil, tl2 -> tl2
| tl1, `Nil -> tl1 | tl1, `Nil -> tl1
| `Cons(x1,l1'), `Cons(x2,l2') -> | `Cons(x1,l1'), `Cons(x2,l2') ->
if cmp x1 x2 < 0 if cmp x1 x2 < 0
then `Cons (x1, merge cmp l1' l2) then `Cons (x1, merge cmp l1' l2)
else `Cons (x2, merge cmp l1 l2') else `Cons (x2, merge cmp l1 l2')
let rec zip a b () = match a(), b() with let rec zip a b () = match a(), b() with
| `Nil, _ | `Nil, _
@ -373,14 +351,14 @@ let of_array a =
let to_array l = let to_array l =
match l() with match l() with
| `Nil -> [| |] | `Nil -> [| |]
| `Cons (x, _) -> | `Cons (x, _) ->
let n = length l in let n = length l in
let a = Array.make n x in (* need first elem to create [a] *) let a = Array.make n x in (* need first elem to create [a] *)
iteri iteri
(fun i x -> a.(i) <- x) (fun i x -> a.(i) <- x)
l; l;
a a
(*$Q (*$Q
Q.(array int) (fun a -> of_array a |> to_array = a) Q.(array int) (fun a -> of_array a |> to_array = a)
@ -399,8 +377,8 @@ let to_gen l =
let l = ref l in let l = ref l in
fun () -> fun () ->
match !l () with match !l () with
| `Nil -> None | `Nil -> None
| `Cons (x,l') -> | `Cons (x,l') ->
l := l'; l := l';
Some x Some x
@ -412,16 +390,16 @@ let of_gen g =
let rec consume r () = match !r with let rec consume r () = match !r with
| Of_gen_saved cons -> cons | Of_gen_saved cons -> cons
| Of_gen_thunk g -> | Of_gen_thunk g ->
begin match g() with begin match g() with
| None -> | None ->
r := Of_gen_saved `Nil; r := Of_gen_saved `Nil;
`Nil `Nil
| Some x -> | Some x ->
let tl = consume (ref (Of_gen_thunk g)) in let tl = consume (ref (Of_gen_thunk g)) in
let l = `Cons (x, tl) in let l = `Cons (x, tl) in
r := Of_gen_saved l; r := Of_gen_saved l;
l l
end end
in in
consume (ref (Of_gen_thunk g)) consume (ref (Of_gen_thunk g))
@ -450,12 +428,12 @@ let rec memoize f =
fun () -> match !r with fun () -> match !r with
| MemoSave l -> l | MemoSave l -> l
| MemoThunk -> | MemoThunk ->
let l = match f() with let l = match f() with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (x, tail) -> `Cons (x, memoize tail) | `Cons (x, tail) -> `Cons (x, memoize tail)
in in
r := MemoSave l; r := MemoSave l;
l l
(*$R (*$R
let printer = Q.Print.(list int) in let printer = Q.Print.(list int) in
@ -480,13 +458,13 @@ let rec interleave a b () = match a() with
let rec fair_flat_map f a () = match a() with let rec fair_flat_map f a () = match a() with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (x, tail) -> | `Cons (x, tail) ->
let y = f x in let y = f x in
interleave y (fair_flat_map f tail) () interleave y (fair_flat_map f tail) ()
let rec fair_app f a () = match f() with let rec fair_app f a () = match f() with
| `Nil -> `Nil | `Nil -> `Nil
| `Cons (f1, fs) -> | `Cons (f1, fs) ->
interleave (map f1 a) (fair_app fs a) () interleave (map f1 a) (fair_app fs a) ()
let (>>-) a f = fair_flat_map f a let (>>-) a f = fair_flat_map f a
let (<.>) f a = fair_app f a let (<.>) f a = fair_app f a
@ -511,8 +489,8 @@ module Traverse(M : MONAD) = struct
let rec aux acc l = match l () with let rec aux acc l = match l () with
| `Nil -> return (of_list (List.rev acc)) | `Nil -> return (of_list (List.rev acc))
| `Cons (x,l') -> | `Cons (x,l') ->
f x >>= fun x' -> f x >>= fun x' ->
aux (x' :: acc) l' aux (x' :: acc) l'
in in
aux [] l aux [] l
@ -521,7 +499,7 @@ module Traverse(M : MONAD) = struct
let rec fold_m f acc l = match l() with let rec fold_m f acc l = match l() with
| `Nil -> return acc | `Nil -> return acc
| `Cons (x,l') -> | `Cons (x,l') ->
f acc x >>= fun acc' -> fold_m f acc' l' f acc x >>= fun acc' -> fold_m f acc' l'
end end
(** {2 IO} *) (** {2 IO} *)
@ -539,10 +517,10 @@ let print ?(sep=",") pp_item fmt l =
let rec pp fmt l = match l() with let rec pp fmt l = match l() with
| `Nil -> () | `Nil -> ()
| `Cons (x,l') -> | `Cons (x,l') ->
Format.pp_print_string fmt sep; Format.pp_print_string fmt sep;
Format.pp_print_cut fmt (); Format.pp_print_cut fmt ();
pp_item fmt x; pp_item fmt x;
pp fmt l' pp fmt l'
in in
match l() with match l() with
| `Nil -> () | `Nil -> ()

24
src/iter/CCKList.mli
View file

@ -1,27 +1,5 @@
(*
Copyright (c) 2013, Simon Cruanes
All rights reserved.
Redistribution and use in source and binary forms, with or without (* This file is free software, part of containers. See file "license" for more details. *)
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.
*)
(** {1 Continuation List} *) (** {1 Continuation List} *)