merge from master

This commit is contained in:
Simon Cruanes 2014-10-19 20:54:48 +02:00
commit a373739eff
2 changed files with 37 additions and 18 deletions

View file

@ -319,33 +319,37 @@ let min ?(lt=fun x y -> x < y) seq =
| Some y -> if lt x y then ret := Some x); | Some y -> if lt x y then ret := Some x);
!ret !ret
exception ExitSequence exception ExitHead
let head seq = let head seq =
let r = ref None in let r = ref None in
try try
seq (fun x -> r := Some x; raise ExitSequence); None seq (fun x -> r := Some x; raise ExitHead); None
with ExitSequence -> !r with ExitHead -> !r
let head_exn seq = let head_exn seq =
match head seq with match head seq with
| None -> invalid_arg "Sequence.head_exn" | None -> invalid_arg "Sequence.head_exn"
| Some x -> x | Some x -> x
exception ExitTake
let take n seq k = let take n seq k =
let count = ref 0 in let count = ref 0 in
try try
seq (fun x -> seq (fun x ->
if !count = n then raise ExitSequence; if !count = n then raise ExitTake;
incr count; incr count;
k x; k x;
) )
with ExitSequence -> () with ExitTake -> ()
exception ExitTakeWhile
let take_while p seq k = let take_while p seq k =
try try
seq (fun x -> if p x then k x else raise ExitSequence) seq (fun x -> if p x then k x else raise ExitTakeWhile)
with ExitSequence -> () with ExitTakeWhile -> ()
let drop n seq k = let drop n seq k =
let count = ref 0 in let count = ref 0 in
@ -362,29 +366,35 @@ let rev seq =
let l = MList.of_seq seq in let l = MList.of_seq seq in
fun k -> MList.iter_rev k l fun k -> MList.iter_rev k l
exception ExitForall
let for_all p seq = let for_all p seq =
try try
seq (fun x -> if not (p x) then raise ExitSequence); seq (fun x -> if not (p x) then raise ExitForall);
true true
with ExitSequence -> false with ExitForall -> false
exception ExitExists
(** Exists there some element satisfying the predicate? *) (** Exists there some element satisfying the predicate? *)
let exists p seq = let exists p seq =
try try
seq (fun x -> if p x then raise ExitSequence); seq (fun x -> if p x then raise ExitExists);
false false
with ExitSequence -> true with ExitExists -> true
let mem ?(eq=(=)) x seq = exists (eq x) seq let mem ?(eq=(=)) x seq = exists (eq x) seq
exception ExitFind
let find f seq = let find f seq =
let r = ref None in let r = ref None in
begin try begin try
seq (fun x -> match f x with seq (fun x -> match f x with
| None -> () | None -> ()
| Some _ as res -> r := res | Some _ as res -> r := res; raise ExitFind
); );
with ExitSequence -> () with ExitFind -> ()
end; end;
!r !r
@ -393,17 +403,19 @@ let length seq =
seq (fun _ -> incr r); seq (fun _ -> incr r);
!r !r
exception ExitIsEmpty
let is_empty seq = let is_empty seq =
try seq (fun _ -> raise ExitSequence); true try seq (fun _ -> raise ExitIsEmpty); true
with ExitSequence -> false with ExitIsEmpty -> false
(** {2 Transform a sequence} *) (** {2 Transform a sequence} *)
let empty2 k = () let empty2 k = ()
let is_empty2 seq2 = let is_empty2 seq2 =
try ignore (seq2 (fun _ _ -> raise ExitSequence)); true try ignore (seq2 (fun _ _ -> raise ExitIsEmpty)); true
with ExitSequence -> false with ExitIsEmpty -> false
let length2 seq2 = let length2 seq2 =
let r = ref 0 in let r = ref 0 in

View file

@ -6,7 +6,8 @@ open Sequence.Infix
let pp_ilist l = let pp_ilist l =
let b = Buffer.create 15 in let b = Buffer.create 15 in
Format.bprintf b "@[<h>%a@]" (S.pp_seq Format.pp_print_int) (S.of_list l); let fmt = Format.formatter_of_buffer b in
Format.fprintf fmt "@[<h>%a@]" (S.pp_seq Format.pp_print_int) (S.of_list l);
Buffer.contents b Buffer.contents b
let test_empty () = let test_empty () =
@ -197,6 +198,11 @@ let test_take () =
OUnit.assert_equal ~printer:pp_ilist [1;2;3;4;5] l; OUnit.assert_equal ~printer:pp_ilist [1;2;3;4;5] l;
() ()
let test_regression1 () =
let s = S.(take 10 (repeat 1)) in
OUnit.assert_bool "not empty" (not (S.is_empty s));
()
let suite = let suite =
"test_sequence" >::: "test_sequence" >:::
[ "test_empty" >:: test_empty; [ "test_empty" >:: test_empty;
@ -225,4 +231,5 @@ let suite =
"test_hashtbl" >:: test_hashtbl; "test_hashtbl" >:: test_hashtbl;
"test_int_range" >:: test_int_range; "test_int_range" >:: test_int_range;
"test_take" >:: test_take; "test_take" >:: test_take;
"test_regression1" >:: test_regression1
] ]