mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-15 23:36:01 -05:00
break: remove klist in data
This commit is contained in:
Fardale
parent
f64f27291f
commit
b598796e9c
8 changed files with 113 additions and 134 deletions
|
|
@ -3,8 +3,7 @@
|
|||
|
||||
(** {1 Functional queues (fifo)} *)
|
||||
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
|
||||
type 'a iter = ('a -> unit) -> unit
|
||||
type 'a equal = 'a -> 'a -> bool
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
|
||||
|
|
@ -95,7 +94,7 @@ let rec snoc : type a. a t -> a -> a t
|
|||
let q = List.fold_left snoc empty [1;2;3;4;5] in
|
||||
let q = tail q in
|
||||
let q = List.fold_left snoc q [6;7;8] in
|
||||
let l = Iter.to_list (to_seq q) in
|
||||
let l = Iter.to_list (to_iter q) in
|
||||
OUnit.assert_equal ~printer:pp_ilist [2;3;4;5;6;7;8] l
|
||||
*)
|
||||
|
||||
|
|
@ -313,7 +312,7 @@ let tail q =
|
|||
l = [] || (of_list l |> tail |> to_list = List.tl l))
|
||||
*)
|
||||
|
||||
let add_seq_front seq q =
|
||||
let add_iter_front seq q =
|
||||
let l = ref [] in
|
||||
(* reversed seq *)
|
||||
seq (fun x -> l := x :: !l);
|
||||
|
|
@ -321,38 +320,38 @@ let add_seq_front seq q =
|
|||
|
||||
(*$Q
|
||||
Q.(pair (list int) (list int)) (fun (l1, l2) -> \
|
||||
add_seq_front (Iter.of_list l1) (of_list l2) |> to_list = l1 @ l2)
|
||||
add_iter_front (Iter.of_list l1) (of_list l2) |> to_list = l1 @ l2)
|
||||
*)
|
||||
|
||||
let add_seq_back q seq =
|
||||
let add_iter_back q seq =
|
||||
let q = ref q in
|
||||
seq (fun x -> q := snoc !q x);
|
||||
!q
|
||||
|
||||
let _digit_to_seq : type l. ('a, l) digit -> 'a sequence = fun d k -> match d with
|
||||
let _digit_to_iter : type l. ('a, l) digit -> 'a iter = fun d k -> match d with
|
||||
| Zero -> ()
|
||||
| One x -> k x
|
||||
| Two (x,y) -> k x; k y
|
||||
| Three (x,y,z) -> k x; k y; k z
|
||||
|
||||
let rec to_seq : 'a. 'a t -> 'a sequence
|
||||
let rec to_iter : 'a. 'a t -> 'a iter
|
||||
= fun q k -> match q with
|
||||
| Shallow d -> _digit_to_seq d k
|
||||
| Shallow d -> _digit_to_iter d k
|
||||
| Deep (_, hd, lazy q', tail) ->
|
||||
_digit_to_seq hd k;
|
||||
to_seq q' (fun (x,y) -> k x; k y);
|
||||
_digit_to_seq tail k
|
||||
_digit_to_iter hd k;
|
||||
to_iter q' (fun (x,y) -> k x; k y);
|
||||
_digit_to_iter tail k
|
||||
|
||||
(*$Q
|
||||
(Q.list Q.int) (fun l -> \
|
||||
of_list l |> to_seq |> Iter.to_list = l)
|
||||
of_list l |> to_iter |> Iter.to_list = l)
|
||||
*)
|
||||
|
||||
let append q1 q2 =
|
||||
match q1, q2 with
|
||||
| Shallow Zero, _ -> q2
|
||||
| _, Shallow Zero -> q1
|
||||
| _ -> add_seq_back q1 (to_seq q2)
|
||||
| _ -> add_iter_back q1 (to_iter q2)
|
||||
|
||||
(*$Q
|
||||
(Q.pair (Q.list Q.int)(Q.list Q.int)) (fun (l1,l2) -> \
|
||||
|
|
@ -360,13 +359,48 @@ let append q1 q2 =
|
|||
*)
|
||||
|
||||
(*$R
|
||||
let q1 = of_seq (Iter.of_list [1;2;3;4]) in
|
||||
let q2 = of_seq (Iter.of_list [5;6;7;8]) in
|
||||
let q1 = of_iter (Iter.of_list [1;2;3;4]) in
|
||||
let q2 = of_iter (Iter.of_list [5;6;7;8]) in
|
||||
let q = append q1 q2 in
|
||||
let l = Iter.to_list (to_seq q) in
|
||||
let l = Iter.to_list (to_iter q) in
|
||||
OUnit.assert_equal ~printer:pp_ilist [1;2;3;4;5;6;7;8] l
|
||||
*)
|
||||
|
||||
let add_seq_front seq q =
|
||||
(* reversed seq *)
|
||||
let l = Seq.fold_left (fun l elt -> elt::l ) [] seq in
|
||||
List.fold_left (fun q x -> cons x q) q l
|
||||
|
||||
(*$Q
|
||||
Q.(pair (list int) (list int)) (fun (l1, l2) -> \
|
||||
add_seq_front (CCList.to_seq l1) (of_list l2) |> to_list = l1 @ l2)
|
||||
*)
|
||||
|
||||
let add_seq_back q seq =
|
||||
Seq.fold_left (fun q x -> snoc q x) q seq
|
||||
|
||||
let _digit_to_seq : type l. ('a, l) digit -> 'a Seq.t = fun d () -> match d with
|
||||
| Zero -> Seq.Nil
|
||||
| One x -> Seq.Cons (x, Seq.empty)
|
||||
| Two (x,y) -> Seq.Cons (x, Seq.return y)
|
||||
| Three (x,y,z) -> Seq.Cons (x, fun () -> Seq.Cons (y, Seq.return z))
|
||||
|
||||
let rec to_seq : 'a. 'a t -> 'a Seq.t
|
||||
= fun q -> match q with
|
||||
| Shallow d -> _digit_to_seq d
|
||||
| Deep (_, hd, lazy q', tail) ->
|
||||
CCSeq.append (_digit_to_seq hd)
|
||||
(CCSeq.append
|
||||
(Seq.flat_map (fun (x,y) () -> Seq.Cons (x, Seq.return y) ) (to_seq q'))
|
||||
(_digit_to_seq tail))
|
||||
|
||||
let of_seq seq = add_seq_front seq empty
|
||||
|
||||
(*$Q
|
||||
(Q.list Q.int) (fun l -> \
|
||||
of_list l |> to_seq |> List.of_seq = l)
|
||||
*)
|
||||
|
||||
let _map_digit : type l. ('a -> 'b) -> ('a, l) digit -> ('b, l) digit = fun f d -> match d with
|
||||
| Zero -> Zero
|
||||
| One x -> One (f x)
|
||||
|
|
@ -407,25 +441,25 @@ let rec fold : 'a 'b. ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
|
|||
*)
|
||||
|
||||
(*$R
|
||||
let q = of_seq (Iter.of_list [1;2;3;4]) in
|
||||
let q = of_iter (Iter.of_list [1;2;3;4]) in
|
||||
let n = fold (+) 0 q in
|
||||
OUnit.assert_equal 10 n;
|
||||
*)
|
||||
|
||||
let iter f q = to_seq q f
|
||||
let iter f q = to_iter q f
|
||||
|
||||
let of_list l = List.fold_left snoc empty l
|
||||
|
||||
let to_list q =
|
||||
let l = ref [] in
|
||||
to_seq q (fun x -> l := x :: !l);
|
||||
to_iter q (fun x -> l := x :: !l);
|
||||
List.rev !l
|
||||
|
||||
let of_seq seq = add_seq_front seq empty
|
||||
let of_iter seq = add_iter_front seq empty
|
||||
|
||||
(*$Q
|
||||
(Q.list Q.int) (fun l -> \
|
||||
Iter.of_list l |> of_seq |> to_list = l)
|
||||
Iter.of_list l |> of_iter |> to_list = l)
|
||||
*)
|
||||
|
||||
let rev q =
|
||||
|
|
@ -438,50 +472,14 @@ let rev q =
|
|||
of_list l |> rev |> to_list = List.rev l)
|
||||
*)
|
||||
|
||||
let _nil () = `Nil
|
||||
let _single x cont () = `Cons (x, cont)
|
||||
let _double x y cont () = `Cons (x, _single y cont)
|
||||
let _triple x y z cont () = `Cons (x, _double y z cont)
|
||||
let rec _equal_seq eq l1 l2 = match l1(), l2() with
|
||||
| Seq.Nil, Seq.Nil -> true
|
||||
| Seq.Nil, _
|
||||
| _, Seq.Nil -> false
|
||||
| Seq.Cons(x1,l1'), Seq.Cons(x2,l2') ->
|
||||
eq x1 x2 && _equal_seq eq l1' l2'
|
||||
|
||||
let _digit_to_klist : type l. ('a, l) digit -> 'a klist -> 'a klist = fun d cont -> match d with
|
||||
| Zero -> _nil
|
||||
| One x -> _single x cont
|
||||
| Two (x,y) -> _double x y cont
|
||||
| Three (x,y,z) -> _triple x y z cont
|
||||
|
||||
let rec _flat_klist : 'a. ('a * 'a) klist -> 'a klist -> 'a klist
|
||||
= fun l cont () -> match l () with
|
||||
| `Nil -> cont ()
|
||||
| `Cons ((x,y),l') -> _double x y (_flat_klist l' cont) ()
|
||||
|
||||
let to_klist q =
|
||||
let rec aux : 'a. 'a t -> 'a klist -> 'a klist
|
||||
= fun q cont () -> match q with
|
||||
| Shallow d -> _digit_to_klist d cont ()
|
||||
| Deep (_, hd, lazy q', tl) ->
|
||||
_digit_to_klist hd
|
||||
(_flat_klist
|
||||
(aux q' _nil)
|
||||
(_digit_to_klist tl cont))
|
||||
()
|
||||
in
|
||||
aux q _nil
|
||||
|
||||
let of_klist l =
|
||||
let rec seq l k = match l() with
|
||||
| `Nil -> ()
|
||||
| `Cons(x,l') -> k x; seq l' k
|
||||
in
|
||||
add_seq_front (seq l) empty
|
||||
|
||||
let rec _equal_klist eq l1 l2 = match l1(), l2() with
|
||||
| `Nil, `Nil -> true
|
||||
| `Nil, _
|
||||
| _, `Nil -> false
|
||||
| `Cons(x1,l1'), `Cons(x2,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_seq eq (to_seq q1) (to_seq q2)
|
||||
|
||||
(*$T
|
||||
let q1 = 1 -- 10 and q2 = append (1 -- 5) (6 -- 10) in \
|
||||
|
|
|
|||
|
|
@ -3,8 +3,7 @@
|
|||
|
||||
(** {1 Functional queues} *)
|
||||
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
|
||||
type 'a iter = ('a -> unit) -> unit
|
||||
type 'a equal = 'a -> 'a -> bool
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
|
||||
|
|
@ -117,15 +116,29 @@ val equal : 'a equal -> 'a t equal
|
|||
val of_list : 'a list -> 'a t
|
||||
val to_list : 'a t -> 'a list
|
||||
|
||||
val add_seq_front : 'a sequence -> 'a t -> 'a t
|
||||
val add_iter_front : 'a iter -> 'a t -> 'a t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val add_seq_back : 'a t -> 'a sequence -> 'a t
|
||||
val add_iter_back : 'a t -> 'a iter -> 'a t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val to_seq : 'a t -> 'a sequence
|
||||
val of_seq : 'a sequence -> 'a t
|
||||
val to_iter : 'a t -> 'a iter
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val to_klist : 'a t -> 'a klist
|
||||
val of_klist : 'a klist -> 'a t
|
||||
val of_iter : 'a iter -> 'a t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val add_seq_front : 'a Seq.t -> 'a t -> 'a t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val add_seq_back : 'a t -> 'a Seq.t -> 'a t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val to_seq : 'a t -> 'a Seq.t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val of_seq : 'a Seq.t -> 'a t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val (--) : int -> int -> int t
|
||||
(** [a -- b] is the integer range from [a] to [b], both included.
|
||||
|
|
|
|||
|
|
@ -579,7 +579,6 @@ let rec merge ~f t1 t2 : _ t =
|
|||
|
||||
type 'a iter = ('a -> unit) -> unit
|
||||
type 'a gen = unit -> 'a option
|
||||
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
|
||||
|
||||
let add_list t l = List.fold_left (fun t (k,v) -> add k v t) t l
|
||||
|
||||
|
|
@ -685,27 +684,27 @@ let compare ~cmp a b =
|
|||
(compare ~cmp:Stdlib.compare m1 m2 = 0) = equal ~eq:(=) m1 m2)
|
||||
*)
|
||||
|
||||
let rec add_klist m l = match l() with
|
||||
| `Nil -> m
|
||||
| `Cons ((k,v), tl) -> add_klist (add k v m) tl
|
||||
let rec add_seq m l = match l() with
|
||||
| Seq.Nil -> m
|
||||
| Seq.Cons ((k,v), tl) -> add_seq (add k v m) tl
|
||||
|
||||
let of_klist l = add_klist empty l
|
||||
let of_seq l = add_seq empty l
|
||||
|
||||
let to_klist m =
|
||||
let to_seq m =
|
||||
(* [st]: stack of alternatives *)
|
||||
let rec explore st m () = match m with
|
||||
| E -> next st ()
|
||||
| L (k,v) -> `Cons ((k, v), next st)
|
||||
| L (k,v) -> Seq.Cons ((k, v), next st)
|
||||
| N (_, _, l, r) -> explore (r::st) l ()
|
||||
and next st () = match st with
|
||||
| [] -> `Nil
|
||||
| [] -> Seq.Nil
|
||||
| x :: st' -> explore st' x ()
|
||||
in
|
||||
next [m]
|
||||
|
||||
(*$Q
|
||||
Q.(list (pair int bool)) (fun l -> \
|
||||
let m = of_list l in equal ~eq:(=) m (m |> to_klist |> of_klist))
|
||||
let m = of_list l in equal ~eq:(=) m (m |> to_seq |> of_seq))
|
||||
*)
|
||||
|
||||
type 'a tree = unit -> [`Nil | `Node of 'a * 'a tree list]
|
||||
|
|
|
|||
|
|
@ -84,7 +84,6 @@ val merge :
|
|||
|
||||
type 'a iter = ('a -> unit) -> unit
|
||||
type 'a gen = unit -> 'a option
|
||||
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
|
||||
|
||||
val add_list : 'a t -> (int * 'a) list -> 'a t
|
||||
|
||||
|
|
@ -111,14 +110,14 @@ val of_gen : (int * 'a) gen -> 'a t
|
|||
val to_gen : 'a t -> (int * 'a) gen
|
||||
(** @since 0.13 *)
|
||||
|
||||
val add_klist : 'a t -> (int * 'a) klist -> 'a t
|
||||
(** @since 0.13 *)
|
||||
val add_seq : 'a t -> (int * 'a) Seq.t -> 'a t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val of_klist : (int * 'a) klist -> 'a t
|
||||
(** @since 0.13 *)
|
||||
val of_seq : (int * 'a) Seq.t -> 'a t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
val to_klist : 'a t -> (int * 'a) klist
|
||||
(** @since 0.13 *)
|
||||
val to_seq : 'a t -> (int * 'a) Seq.t
|
||||
(** @since NEXT_RELEASE *)
|
||||
|
||||
type 'a tree = unit -> [`Nil | `Node of 'a * 'a tree list]
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a gen = unit -> 'a option
|
||||
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
|
||||
type +'a t = unit -> [`Nil | `Node of 'a * 'a t list]
|
||||
|
|
@ -79,12 +78,12 @@ let set_of_cmp (type elt) ~cmp () =
|
|||
method mem x = S.mem x s
|
||||
end
|
||||
|
||||
let _nil () = `Nil
|
||||
let _cons x l = `Cons (x, l)
|
||||
let _nil () = Seq.Nil
|
||||
let _cons x l = Seq.Cons (x, l)
|
||||
|
||||
let dfs ~pset t =
|
||||
let rec dfs pset stack () = match stack with
|
||||
| [] -> `Nil
|
||||
| [] -> Seq.Nil
|
||||
| `Explore t :: stack' ->
|
||||
begin match t() with
|
||||
| `Nil -> dfs pset stack' ()
|
||||
|
|
@ -136,7 +135,7 @@ end
|
|||
|
||||
let bfs ~pset t =
|
||||
let rec bfs pset q () =
|
||||
if FQ.is_empty q then `Nil
|
||||
if FQ.is_empty q then Seq.Nil
|
||||
else
|
||||
let t, q' = FQ.pop_exn q in
|
||||
match t() with
|
||||
|
|
@ -156,8 +155,8 @@ let rec force t : ([`Nil | `Node of 'a * 'b list] as 'b) = match t() with
|
|||
|
||||
let find ~pset f t =
|
||||
let rec _find_kl f l = match l() with
|
||||
| `Nil -> None
|
||||
| `Cons (x, l') ->
|
||||
| Seq.Nil -> None
|
||||
| Seq.Cons (x, l') ->
|
||||
match f x with
|
||||
| None -> _find_kl f l'
|
||||
| Some _ as res -> res
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a gen = unit -> 'a option
|
||||
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
|
||||
(** {2 Basics} *)
|
||||
|
|
@ -60,10 +59,10 @@ end
|
|||
val set_of_cmp : cmp:('a -> 'a -> int) -> unit -> 'a pset
|
||||
(** Build a set structure given a total ordering. *)
|
||||
|
||||
val dfs : pset:'a pset -> 'a t -> [ `Enter of 'a | `Exit of 'a ] klist
|
||||
val dfs : pset:'a pset -> 'a t -> [ `Enter of 'a | `Exit of 'a ] Seq.t
|
||||
(** Depth-first traversal of the tree. *)
|
||||
|
||||
val bfs : pset:'a pset -> 'a t -> 'a klist
|
||||
val bfs : pset:'a pset -> 'a t -> 'a Seq.t
|
||||
(** Breadth-first traversal of the tree. *)
|
||||
|
||||
val force : 'a t -> ([ `Nil | `Node of 'a * 'b list ] as 'b)
|
||||
|
|
|
|||
|
|
@ -6,7 +6,6 @@
|
|||
type 'a iter = ('a -> unit) -> unit
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
|
||||
type 'a gen = unit -> 'a option
|
||||
|
||||
type 'a t = {
|
||||
|
|
@ -139,23 +138,6 @@ let to_seq q =
|
|||
in
|
||||
aux1 q.hd
|
||||
|
||||
let rec klist_iter_ k f = match k() with
|
||||
| `Nil -> ()
|
||||
| `Cons (x,tl) -> f x; klist_iter_ tl f
|
||||
|
||||
let add_klist q l = add_iter q (klist_iter_ l)
|
||||
let of_klist l = add_klist empty l
|
||||
|
||||
let to_klist q =
|
||||
let rec aux1 l () = match l with
|
||||
| [] -> aux2 (List.rev q.tl) ()
|
||||
| x :: tl -> `Cons (x, aux1 tl)
|
||||
and aux2 l () = match l with
|
||||
| [] -> `Nil
|
||||
| x :: tl -> `Cons (x, aux2 tl)
|
||||
in
|
||||
aux1 q.hd
|
||||
|
||||
let rec gen_iter g f = match g() with
|
||||
| None -> ()
|
||||
| Some x -> f x; gen_iter g f
|
||||
|
|
@ -174,14 +156,14 @@ let to_gen q =
|
|||
in
|
||||
aux
|
||||
|
||||
let rec klist_equal eq l1 l2 = match l1(), l2() with
|
||||
| `Nil, `Nil -> true
|
||||
| `Nil, _
|
||||
| _, `Nil -> false
|
||||
| `Cons (x1,l1'), `Cons (x2,l2') ->
|
||||
eq x1 x2 && klist_equal eq l1' l2'
|
||||
let rec seq_equal eq l1 l2 = match l1(), l2() with
|
||||
| Seq.Nil, Seq.Nil -> true
|
||||
| Seq.Nil, _
|
||||
| _, Seq.Nil -> false
|
||||
| Seq.Cons (x1,l1'), Seq.Cons (x2,l2') ->
|
||||
eq x1 x2 && seq_equal eq l1' l2'
|
||||
|
||||
let equal eq q1 q2 = klist_equal eq (to_klist q1) (to_klist q2)
|
||||
let equal eq q1 q2 = seq_equal eq (to_seq q1) (to_seq q2)
|
||||
|
||||
(*$Q
|
||||
Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> \
|
||||
|
|
|
|||
|
|
@ -16,7 +16,6 @@ type 'a iter = ('a -> unit) -> unit
|
|||
@since 2.8 *)
|
||||
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
|
||||
type 'a gen = unit -> 'a option
|
||||
|
||||
type +'a t
|
||||
|
|
@ -100,15 +99,6 @@ val of_seq : 'a Seq.t -> 'a t
|
|||
(** Renamed from [of_std_seq] since NEXT_RELEASE.
|
||||
@since NEXT_RELEASE *)
|
||||
|
||||
val to_klist : 'a t -> 'a klist
|
||||
[@@ocaml.deprecated "use to_seq"]
|
||||
|
||||
val add_klist : 'a t -> 'a klist -> 'a t
|
||||
[@@ocaml.deprecated "use add_seq"]
|
||||
|
||||
val of_klist : 'a klist -> 'a t
|
||||
[@@ocaml.deprecated "use of_seq"]
|
||||
|
||||
val of_gen : 'a gen -> 'a t
|
||||
val add_gen : 'a t -> 'a gen -> 'a t
|
||||
val to_gen : 'a t -> 'a gen
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue