Commits

Dmitry Grebeniuk  committed 9ad16ee

+ Pure_IO

  • Participants
  • Parent commits 03d6bbc

Comments (0)

Files changed (7)

 	Reading integers with functions
 	I.read_[u]int{,32,64}[_nz]
 
+	Pure_IO for pure computations
+
 0.3
 	installing via findlib
 
 VERSION=0.4
 
 TESTBIN=tests_lwt.byte
+#TESTBIN=tests_pure.byte
 
 all :
 	ocamlbuild \
 	   iteratees.cma iteratees.cmxa tests_lwt.byte tests_lwt.native \
 	   tests_direct.byte tests_direct.native \
+	   tests_pure.byte tests_pure.native \
 	   get_sig.byte
 	-_build/get_sig.byte > _build/it_type.ml
 	# (cd _build && ocamlc -c -pp camlp4r it_type.ml)
 <it_Lwt_IO.ml> | <tests_lwt.{byte,native}> : pkg_lwt, pkg_lwt.unix
 
 <get_sig.*> : pkg_unix
+
+<tests_*.*> : debug

File iteratees.mllib

 It_Types
 Dbg
 It_Ops
+Pure_IO
+(* Pure "function name" is raised when the IO-function is called *)
+
+exception Pure of string
+;
+
+    type m +'a = [= `Ok of 'a | `Error of exn ];
+    value return x = `Ok x;
+    value bind f m =
+      match m with
+      [ `Ok a -> f a
+      | (`Error _) as me -> me
+      ]
+    ;
+    value bind_rev m f =
+      match m with
+      [ `Ok a -> f a
+      | (`Error _) as me -> me
+      ]
+    ;
+
+    value error e = `Error e;
+
+    value pu n = error (Pure n);
+
+
+    value catch f handler =
+      try
+        match f () with
+        [ (`Ok _) as a -> a
+        | `Error e ->
+            try
+              handler e
+            with
+            [ ee -> `Error ee ]
+        ]
+      with
+      [ e -> handler e ]
+    ;
+
+    type output_channel = unit;
+    value stdout = ();
+    value write () (_ : string) = pu "write";
+
+    type input_channel = unit;
+    value open_in (_ : string) = pu "open_in";
+    value close_in () = pu "close_in";
+    value read_into () (_:string) (_:int) (_:int) = pu "read_into";
+
+    value runIO x = x;

File tests_common.ml

 value () = P.printf "after functor app\n%!";
 open I;
 
+value mprintf fmt =
+  Printf.ksprintf
+    (fun s ->
+       IO.catch
+         (fun () -> mprintf "%s" s)
+         (fun
+          [ Pure_IO.Pure "write" ->
+              ( Printf.printf "%s%!" s ; IO.return () )
+         | e -> IO.error e
+         ]
+         )
+    )
+    fmt
+;
+
 
 (* Primitive Tests *)
 
 
 value (dump_utf8_chars : iteratee U.uchar unit) =
  let pr s = mprintf "dump_utf8_chars: %s\n" s in
+(*
+ let pr s = IO.catch
+   (fun () -> mprintf "dump_utf8_chars: %s\n" s)
+   (fun _ ->
+      ( Printf.printf "direct output: dump_utf8_chars: %s\n%!" s
+      ; IO.return ()
+      )
+   )
+ in
+*)
  ie_cont inner
  where rec inner s =
   match s with

File tests_pure.ml

+open Tests_common;
+
+module T = Tests_functor(Pure_IO);