summaryrefslogtreecommitdiffstats
path: root/camlp4/ocaml_src/lib/fstream.ml
diff options
context:
space:
mode:
authorDaniel de Rauglaudre <daniel.de_rauglaudre@inria.fr>2001-09-07 07:32:09 +0000
committerDaniel de Rauglaudre <daniel.de_rauglaudre@inria.fr>2001-09-07 07:32:09 +0000
commit14075dda1789ce74afb083bd8cf75edb567ea457 (patch)
tree84a6d8428df672d27dc80142e2d413f45ebf275c /camlp4/ocaml_src/lib/fstream.ml
parent4cb19c456f421a28be378fcb169fb10346990253 (diff)
-
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3706 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'camlp4/ocaml_src/lib/fstream.ml')
-rw-r--r--camlp4/ocaml_src/lib/fstream.ml79
1 files changed, 79 insertions, 0 deletions
diff --git a/camlp4/ocaml_src/lib/fstream.ml b/camlp4/ocaml_src/lib/fstream.ml
new file mode 100644
index 000000000..de5ba0572
--- /dev/null
+++ b/camlp4/ocaml_src/lib/fstream.ml
@@ -0,0 +1,79 @@
+(* camlp4r *)
+(* Id *)
+(* Copyright 2001 INRIA *)
+
+type 'a t = { count : int; data : 'a data Lazy.t }
+and 'a data = Nil | Cons of 'a * 'a t | App of 'a t * 'a t
+;;
+
+let from f =
+ let rec loop i =
+ {count = 0;
+ data =
+ lazy
+ (match f i with
+ Some x -> Cons (x, loop (i + 1))
+ | None -> Nil)}
+ in
+ loop 0
+;;
+
+let rec next s =
+ let count = s.count + 1 in
+ match Lazy.force s.data with
+ Nil -> None
+ | Cons (a, s) -> Some (a, {count = count; data = s.data})
+ | App (s1, s2) ->
+ match next s1 with
+ Some (a, s1) -> Some (a, {count = count; data = lazy (App (s1, s2))})
+ | None ->
+ match next s2 with
+ Some (a, s2) -> Some (a, {count = count; data = s2.data})
+ | None -> None
+;;
+
+let empty s =
+ match next s with
+ Some _ -> None
+ | None -> Some ((), s)
+;;
+
+let nil () = {count = 0; data = ref (Lazy.Value Nil)};;
+let cons a s = Cons (a, s);;
+let app s1 s2 = App (s1, s2);;
+let flazy f = {count = 0; data = ref (Lazy.Delayed f)};;
+
+let of_list l =
+ List.fold_right (fun x s -> flazy (fun () -> cons x s)) l (nil ())
+;;
+
+let of_string s =
+ from (fun c -> if c < String.length s then Some s.[c] else None)
+;;
+
+let of_channel ic =
+ from
+ (fun _ ->
+ try Some (input_char ic) with
+ End_of_file -> None)
+;;
+
+let iter f =
+ let rec do_rec strm =
+ match next strm with
+ Some (a, strm) -> let _ = f a in do_rec strm
+ | None -> ()
+ in
+ do_rec
+;;
+
+let count s = s.count;;
+
+let count_unfrozen s =
+ let rec loop cnt s =
+ match !(s.data) with
+ Lazy.Value (Cons (_, s)) -> loop (cnt + 1) s
+ | _ -> cnt
+ in
+ loop 0 s
+;;