break: remove klist in data

This commit is contained in:
Fardale 2020-07-22 21:01:04 +02:00
parent f64f27291f
commit b598796e9c
8 changed files with 113 additions and 134 deletions

View file

@ -3,8 +3,7 @@
(** {1 Functional queues (fifo)} *) (** {1 Functional queues (fifo)} *)
type 'a sequence = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
type 'a equal = 'a -> 'a -> bool type 'a equal = 'a -> 'a -> bool
type 'a printer = Format.formatter -> 'a -> unit 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 = List.fold_left snoc empty [1;2;3;4;5] in
let q = tail q in let q = tail q in
let q = List.fold_left snoc q [6;7;8] 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 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)) 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 let l = ref [] in
(* reversed seq *) (* reversed seq *)
seq (fun x -> l := x :: !l); seq (fun x -> l := x :: !l);
@ -321,38 +320,38 @@ 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 (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 let q = ref q in
seq (fun x -> q := snoc !q x); seq (fun x -> q := snoc !q x);
!q !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 -> () | Zero -> ()
| One x -> k x | One x -> k x
| Two (x,y) -> k x; k y | Two (x,y) -> k x; k y
| Three (x,y,z) -> k x; k y; k z | 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 = 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) -> | Deep (_, hd, lazy q', tail) ->
_digit_to_seq hd k; _digit_to_iter hd k;
to_seq q' (fun (x,y) -> k x; k y); to_iter q' (fun (x,y) -> k x; k y);
_digit_to_seq tail k _digit_to_iter tail k
(*$Q (*$Q
(Q.list Q.int) (fun l -> \ (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 = 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_iter_back q1 (to_iter 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) -> \
@ -360,13 +359,48 @@ let append q1 q2 =
*) *)
(*$R (*$R
let q1 = of_seq (Iter.of_list [1;2;3;4]) in let q1 = of_iter (Iter.of_list [1;2;3;4]) in
let q2 = of_seq (Iter.of_list [5;6;7;8]) in let q2 = of_iter (Iter.of_list [5;6;7;8]) in
let q = append q1 q2 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 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 let _map_digit : type l. ('a -> 'b) -> ('a, l) digit -> ('b, l) digit = fun f d -> match d with
| Zero -> Zero | Zero -> Zero
| One x -> One (f x) | One x -> One (f x)
@ -407,25 +441,25 @@ let rec fold : 'a 'b. ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
*) *)
(*$R (*$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 let n = fold (+) 0 q in
OUnit.assert_equal 10 n; 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 of_list l = List.fold_left snoc empty l
let to_list q = let to_list q =
let l = ref [] in let l = ref [] in
to_seq q (fun x -> l := x :: !l); to_iter q (fun x -> l := x :: !l);
List.rev !l List.rev !l
let of_seq seq = add_seq_front seq empty let of_iter seq = add_iter_front seq empty
(*$Q (*$Q
(Q.list Q.int) (fun l -> \ (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 = let rev q =
@ -438,50 +472,14 @@ let rev q =
of_list l |> rev |> to_list = List.rev l) of_list l |> rev |> to_list = List.rev l)
*) *)
let _nil () = `Nil let rec _equal_seq eq l1 l2 = match l1(), l2() with
let _single x cont () = `Cons (x, cont) | Seq.Nil, Seq.Nil -> true
let _double x y cont () = `Cons (x, _single y cont) | Seq.Nil, _
let _triple x y z cont () = `Cons (x, _double y z cont) | _, 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 let equal eq q1 q2 = _equal_seq eq (to_seq q1) (to_seq q2)
| 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)
(*$T (*$T
let q1 = 1 -- 10 and q2 = append (1 -- 5) (6 -- 10) in \ let q1 = 1 -- 10 and q2 = append (1 -- 5) (6 -- 10) in \

View file

@ -3,8 +3,7 @@
(** {1 Functional queues} *) (** {1 Functional queues} *)
type 'a sequence = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
type 'a equal = 'a -> 'a -> bool type 'a equal = 'a -> 'a -> bool
type 'a printer = Format.formatter -> 'a -> unit 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 of_list : 'a list -> 'a t
val to_list : 'a t -> 'a list 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 to_iter : 'a t -> 'a iter
val of_seq : 'a sequence -> 'a t (** @since NEXT_RELEASE *)
val to_klist : 'a t -> 'a klist val of_iter : 'a iter -> 'a t
val of_klist : 'a klist -> '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 val (--) : int -> int -> int t
(** [a -- b] is the integer range from [a] to [b], both included. (** [a -- b] is the integer range from [a] to [b], both included.

View file

@ -579,7 +579,6 @@ let rec merge ~f t1 t2 : _ t =
type 'a iter = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit
type 'a gen = unit -> 'a option 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 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) (compare ~cmp:Stdlib.compare m1 m2 = 0) = equal ~eq:(=) m1 m2)
*) *)
let rec add_klist m l = match l() with let rec add_seq m l = match l() with
| `Nil -> m | Seq.Nil -> m
| `Cons ((k,v), tl) -> add_klist (add k v m) tl | 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 *) (* [st]: stack of alternatives *)
let rec explore st m () = match m with let rec explore st m () = match m with
| E -> next st () | 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 () | N (_, _, l, r) -> explore (r::st) l ()
and next st () = match st with and next st () = match st with
| [] -> `Nil | [] -> Seq.Nil
| x :: st' -> explore st' x () | x :: st' -> explore st' x ()
in in
next [m] next [m]
(*$Q (*$Q
Q.(list (pair int bool)) (fun l -> \ 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] type 'a tree = unit -> [`Nil | `Node of 'a * 'a tree list]

View file

@ -84,7 +84,6 @@ val merge :
type 'a iter = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit
type 'a gen = unit -> 'a option 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 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 val to_gen : 'a t -> (int * 'a) gen
(** @since 0.13 *) (** @since 0.13 *)
val add_klist : 'a t -> (int * 'a) klist -> 'a t val add_seq : 'a t -> (int * 'a) Seq.t -> 'a t
(** @since 0.13 *) (** @since NEXT_RELEASE *)
val of_klist : (int * 'a) klist -> 'a t val of_seq : (int * 'a) Seq.t -> 'a t
(** @since 0.13 *) (** @since NEXT_RELEASE *)
val to_klist : 'a t -> (int * 'a) klist val to_seq : 'a t -> (int * 'a) Seq.t
(** @since 0.13 *) (** @since NEXT_RELEASE *)
type 'a tree = unit -> [`Nil | `Node of 'a * 'a tree list] type 'a tree = unit -> [`Nil | `Node of 'a * 'a tree list]

View file

@ -7,7 +7,6 @@
type 'a sequence = ('a -> unit) -> unit type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option 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 printer = Format.formatter -> 'a -> unit
type +'a t = unit -> [`Nil | `Node of 'a * 'a t list] 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 method mem x = S.mem x s
end end
let _nil () = `Nil let _nil () = Seq.Nil
let _cons x l = `Cons (x, l) let _cons x l = Seq.Cons (x, l)
let dfs ~pset t = let dfs ~pset t =
let rec dfs pset stack () = match stack with let rec dfs pset stack () = match stack with
| [] -> `Nil | [] -> Seq.Nil
| `Explore t :: stack' -> | `Explore t :: stack' ->
begin match t() with begin match t() with
| `Nil -> dfs pset stack' () | `Nil -> dfs pset stack' ()
@ -136,7 +135,7 @@ end
let bfs ~pset t = let bfs ~pset t =
let rec bfs pset q () = let rec bfs pset q () =
if FQ.is_empty q then `Nil if FQ.is_empty q then Seq.Nil
else else
let t, q' = FQ.pop_exn q in let t, q' = FQ.pop_exn q in
match t() with 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 find ~pset f t =
let rec _find_kl f l = match l() with let rec _find_kl f l = match l() with
| `Nil -> None | Seq.Nil -> None
| `Cons (x, l') -> | Seq.Cons (x, l') ->
match f x with match f x with
| None -> _find_kl f l' | None -> _find_kl f l'
| Some _ as res -> res | Some _ as res -> res

View file

@ -7,7 +7,6 @@
type 'a sequence = ('a -> unit) -> unit type 'a sequence = ('a -> unit) -> unit
type 'a gen = unit -> 'a option 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 printer = Format.formatter -> 'a -> unit
(** {2 Basics} *) (** {2 Basics} *)
@ -60,10 +59,10 @@ end
val set_of_cmp : cmp:('a -> 'a -> int) -> unit -> 'a pset val set_of_cmp : cmp:('a -> 'a -> int) -> unit -> 'a pset
(** Build a set structure given a total ordering. *) (** 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. *) (** 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. *) (** Breadth-first traversal of the tree. *)
val force : 'a t -> ([ `Nil | `Node of 'a * 'b list ] as 'b) val force : 'a t -> ([ `Nil | `Node of 'a * 'b list ] as 'b)

View file

@ -6,7 +6,6 @@
type 'a iter = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit
type 'a sequence = ('a -> unit) -> unit type 'a sequence = ('a -> unit) -> unit
type 'a printer = Format.formatter -> 'a -> 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 gen = unit -> 'a option
type 'a t = { type 'a t = {
@ -139,23 +138,6 @@ let to_seq q =
in in
aux1 q.hd 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 let rec gen_iter g f = match g() with
| None -> () | None -> ()
| Some x -> f x; gen_iter g f | Some x -> f x; gen_iter g f
@ -174,14 +156,14 @@ let to_gen q =
in in
aux aux
let rec klist_equal eq l1 l2 = match l1(), l2() with let rec seq_equal eq l1 l2 = match l1(), l2() with
| `Nil, `Nil -> true | Seq.Nil, Seq.Nil -> true
| `Nil, _ | Seq.Nil, _
| _, `Nil -> false | _, Seq.Nil -> false
| `Cons (x1,l1'), `Cons (x2,l2') -> | Seq.Cons (x1,l1'), Seq.Cons (x2,l2') ->
eq x1 x2 && klist_equal eq l1' 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
Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> \ Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> \

View file

@ -16,7 +16,6 @@ type 'a iter = ('a -> unit) -> unit
@since 2.8 *) @since 2.8 *)
type 'a printer = Format.formatter -> 'a -> 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 gen = unit -> 'a option
type +'a t type +'a t
@ -100,15 +99,6 @@ val of_seq : 'a Seq.t -> 'a t
(** Renamed from [of_std_seq] since NEXT_RELEASE. (** Renamed from [of_std_seq] since NEXT_RELEASE.
@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 of_gen : 'a gen -> 'a t
val add_gen : 'a t -> 'a gen -> 'a t val add_gen : 'a t -> 'a gen -> 'a t
val to_gen : 'a t -> 'a gen val to_gen : 'a t -> 'a gen