diff --git a/_oasis b/_oasis index 8930f94..cc5b742 100644 --- a/_oasis +++ b/_oasis @@ -43,6 +43,14 @@ Executable "test_io_proc" Install: false BuildDepends: io + +Executable "bench_chan" + Path: bench + MainIs: bench_chan.ml + CompiledObject: best + Install: false + BuildDepends: elements, io + SourceRepository master Type: git Location: https://github.com/rizo/flow.git diff --git a/bench/bench_chan.ml b/bench/bench_chan.ml new file mode 100644 index 0000000..309b511 --- /dev/null +++ b/bench/bench_chan.ml @@ -0,0 +1,83 @@ + +open Elements +open IO.Core +open IO.Iter + +(* 0 *) +let stream_fold f stream init = + let result = ref init in + Stream.iter (fun x -> result := f x !result) stream; + !result +let chan_stream input = + stream_fold (fun i c -> c + 1) + (Stream.from (fun i -> guard input_line input)) 0 + +(* 1 *) +let rec chan_try_out input = + let rec loop () = + yield (input_line input) >> lazy (loop ()) in + try loop () + with End_of_file -> return () + +(* 2 *) +let rec chan_try_in input = + let rec loop () = + try yield (input_line input) >> lazy (loop ()) + with End_of_file -> return () in + loop () + +(* 3 *) +let rec chan_guard input = + let rec loop () = + match guard input_line input with + | Some line -> yield line >> lazy (loop ()) + | None -> return () in + loop () + +(* 4 *) +let rec chan_guard_inline input = + let rec loop () = + let line_opt = + try Some (input_line input) + with End_of_file -> None in + match line_opt with + | Some l -> yield l >> lazy (loop ()) + | None -> return () in + loop () + +(* 5 *) +let rec chan_evil input = + let rec loop term input = + let line_with_term = + try input_line input + with End_of_file -> term in + if line_with_term == term then return () + else yield line_with_term >> lazy (loop term input) in + loop "\n" input + +let run name chan_fn file_path = + let input = open_in file_path in + print ("=> " ^ name); + print (fmt " # %d" (length (chan_fn input))) + +let run' name chan_fn file_path = + let input = open_in file_path in + print ("=> " ^ name); + print (fmt " # %d" (chan_fn input)) + +let () = + let file_path = + match Sys.argv with + | [|_; file_path|] -> file_path + | _ -> + print "usage: bench_chan "; + exit 0 in + begin + ignore (time (run' "chan_stream" chan_stream) file_path); + ignore (time (run "chan_evil" chan_evil) file_path); + ignore (time (run "chan_try_in " chan_try_in ) file_path); + ignore (time (run "chan_guard " chan_guard ) file_path); + ignore (time (run "chan_guard_inline" chan_guard_inline) file_path); + end + + diff --git a/src/IO_iter.ml b/src/IO_iter.ml index d7cf48c..7043a20 100644 --- a/src/IO_iter.ml +++ b/src/IO_iter.ml @@ -21,6 +21,9 @@ let map_forever f = let map = map_forever +let rec each f = + await >>= fun a -> f a; each f + let rec filter pred = await >>= fun a -> if pred a then yield a >> lazy (filter pred) @@ -112,18 +115,16 @@ let rec list xs = | x::xs' -> yield x >> lazy (list xs') | [] -> return () -let rec file file_path = - let c = open_in file_path in +let rec chan c = let rec loop () = - yield (input_line c) >> lazy (loop ()) in - try loop () - with End_of_file -> close_in c; return () + match guard input_line c with + | Some line -> yield line >> lazy (loop ()) + | None -> return () in + loop () -let rec chan chan = - let rec loop () = - yield (input_line chan) >> lazy (loop ()) in - try loop () - with End_of_file -> return () +let rec file file_path = + let c = open_in file_path in + chan c >> lazy (return (close_in c)) let collect src = let rec loop src acc = @@ -131,4 +132,3 @@ let collect src = | Some (a, rest) -> loop rest (a::acc) | None -> List.rev acc in loop src [] - diff --git a/src/IO_iter.mli b/src/IO_iter.mli index 1b7f2cb..7d05de8 100644 --- a/src/IO_iter.mli +++ b/src/IO_iter.mli @@ -10,6 +10,7 @@ val collect : ('a, 'b, 'c) node -> 'b list val count : (void, int, 'r) node val drop : int -> ('a, 'a, 'b) node val drop_while : ('a -> bool) -> ('a, 'a, 'b) node +val each : ('a -> unit) -> ('a, void, 'r) node val file : string -> (void, string, unit) node val filter : ('a -> bool) -> ('a, 'a, 'r) node val fold : init:'a -> f:('a -> 'b -> 'a) -> ('c, 'b, 'd) node -> 'a