Anonymous avatar Anonymous committed c3bb812

* API changed: catch/catchk now get 'unit -> iteratee _ _' and catch OCaml exceptions too

Comments (0)

Files changed (2)

 (* Throw an irrecoverable error *)
 
 value rec throw_err e : iteratee 'el 'a =
-  IE_cont (Some e) (fun s -> IO.return (throw_err e, s))
+  IE_cont (Some e) (throw_err_cont e)
+and throw_err_cont e =
+  fun s -> IO.return (throw_err e, s)
 ;
 
 
 
 
 value
-  (catchk : iteratee 'el 'a ->
+  (catchk : (unit -> iteratee 'el 'a) ->
             ( err_msg ->
               (stream 'el -> IO.m (iteratee 'el 'a  *  stream 'el)) ->
               iteratee 'el 'a
             ) ->
             iteratee 'el 'a
-  ) it handler =
+  ) itf handler =
   let rec catchk it =
     match it with
     [ IE_done _ -> it
-    | IE_cont (Some e) k -> handler e k
-    | IE_cont None k -> ie_cont & step k
+    | IE_cont (Some e) k ->
+        try
+          handler e k
+        with
+        [ e -> throw_err e ]
+    | IE_cont None k -> ie_cont (step k)
     ]
   and step k s =
-    k s >>% fun (it, s) -> IO.return (catchk it, s)
+    (IO.catch
+       (fun () -> k s >>% fun r -> IO.return (`Ok r))
+       (fun e -> IO.return (`Error e))
+    ) >>% fun
+    [ `Ok (it, s') -> IO.return (catchk it, s')
+    | `Error e -> IO.return (catchk (throw_err e), s)
+    ]
   in
     let () = dbg "catchk: entered\n%!" in
-    catchk it
+    let it =
+      try
+        itf ()
+      with
+      [ e -> throw_err e ]
+    in
+      catchk it
 ;
 
 
 value
-  (catch : iteratee 'el 'a ->
+  (catch : (unit -> iteratee 'el 'a) ->
            ( err_msg ->
              iteratee 'el 'a
            ) ->
            iteratee 'el 'a
-  ) it handler =
-  catchk it (fun err_msg _cont -> handler err_msg)
+  ) itf handler =
+  catchk itf (fun err_msg _cont -> handler err_msg)
 ;
 
 
 
 value test_limit ~feed_cont n =
  let () = P.printf "test_limit: n=%i, feed_cont=%b\n%!" n feed_cont in
- let ctch ~b it =
+ let ctch ~b itf =
    if not b
    then
-     it
+     itf ()
    else
      catchk
-      it
+      itf
       (fun err_msg _cont ->
          let () = P.printf "limited: caught %s%!" &
            match err_msg with
   let res = runA &
     (enum_pure_nchunk limit_chars 3)
     ( ctch ~b:True
-        ( (limit n limited_iteratee) >>= fun it ->
+        ( fun () ->
+          (limit n limited_iteratee) >>= fun it ->
           ( match it with
             [ IE_done i -> return & Some i
             | IE_cont None cont ->
 (*
 
     ( ctch ~b:True
-        ( (joinI & limit n limited_iteratee) >>= fun i ->
+        ( fun () ->
+          (joinI & limit n limited_iteratee) >>= fun i ->
           break_chars (fun _ -> False) >>= fun str ->
           return (i, str)
         )
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.