unwind-protect?

unwind-protect?

[Colin Walters]

Hello,

Is there an equivalent of Lisp's `unwind-protect' or Java's
"try...finally"?  I wanted to write a function which changed to
another directory temporarily, and I came up with:

let in_directory d f =
  let olddir = Unix.getcwd() in
  (Unix.chdir d;
   f();
   Unix.chdir olddir)

But this won't work if f throws an exception.  Any suggestions?

Re: unwind-protect?

[Pierre Weis]

> Hello,
> 
> Is there an equivalent of Lisp's `unwind-protect' or Java's
> "try...finally"?  I wanted to write a function which changed to
> another directory temporarily, and I came up with:
> 
> let in_directory d f =
>   let olddir = Unix.getcwd() in
>   (Unix.chdir d;
>    f();
>    Unix.chdir olddir)
> 
> But this won't work if f throws an exception.  Any suggestions?

There is no special construct: the basic construct is powerful enough
to handle the construction: you just have to use pattern matching to
bound the exception and raise it again, after having properly set up
the global state.

let in_directory d f =
  let olddir = Unix.getcwd () in
  try
    Unix.chdir d;
    f ();
    Unix.chdir olddir
  with x -> Unix.chdir olddir; raise x;;
val in_directory : string -> (unit -> 'a) -> unit = <fun>

Note also that this scheme can be generalized to cases where you need
to apply a function to some argument and need to get the result of
that call:

let in_directory d f arg =
  let olddir = Unix.getcwd () in
  try
    Unix.chdir d;
    let r = f arg in
    Unix.chdir olddir;
    r
  with x -> Unix.chdir olddir; raise x;;

val in_directory : string -> ('a -> 'b) -> 'a -> 'b = <fun>

Here, polymorphism, curryfication, and specialization are shining,
since you juste have to add one in_* functional application before an
actual call to any function f to obtain a specialized evaluation
context for f. For instance:

let in_tmp f arg = in_directory "/tmp" f arg;;
val in_tmp : ('a -> 'b) -> 'a -> 'b = <fun>

let open_out_tmp fname = in_tmp open_out fname;;
val open_out_tmp : string -> out_channel = <fun>

Hope this helps,

Pierre Weis

INRIA, Projet Cristal, Pierre.Weis@inria.fr, http://cristal.inria.fr/~weis/

Re: unwind-protect?

[CREGUT Pierre FTRD/DTL/LAN]

Pierre's solution repeat chdir which is often the long part of the code.
I like to use the following constructs (I am looking for smarter constructs.
I am also looking for a standard way of doing it that would go in the
standard library) :

  type 'a result = Normal of 'a | Exception of exn
  let catch f a = try Normal (f a) with e -> Exception e
  let throw = function Normal a -> a | Exception e -> raise e
  let with_fallback v f fallback = 
    match v with Normal a -> f a | Exception e -> fallback e

There are some contexts where it is as ubiquitous as the 'a option type.
For example, RPC on cin : 

  let cout, msg = sync(receive cin) in sync(send (catch f msg))

On the other side you will find :

  let channel = new_channel () in
  sync(send (channel,msg)); throw (sync (receive channel))  

In the chdir problem (or if you use any kind of lock construct) you can write :

  chdir ...;
  let r = catch (f a);
  chdir ...;
  throw r

The with_fallback function can be used to simulate the so much missing

   trylet .... in .... with ...

capturing only errors in the let part.

Pierre


                            ANNEX
                            =====

i am not convinced that with_fallback is the definitive answer for a fine 
grained control of exceptions.  To complete a previous post, I would prefer a 
new "context" construct

let complex_function .... =
  try
    let v = context c1 f x1 x2 ... in
    ....
    g (context c2 h y1 y2 ...) z1 z2 ...
    ...
  with
    E1 in c1 -> ....
  | E2 in c2 -> ....
  | E -> ....

Combined with a tool like ocamlexc, you can  
- have readable code that separates exceptional cases from the regular
  treatment.
- be sure that all your exceptions are trapped
- be convinced that your error handling code is trapping the right exception
  not another one that happened to have the same name (typical of Not_found
  exception handlers). 
(Note that the "looped approximation' of recursive datatype by ocamlexc could
limit the power of the analysis as we use an exception containing another
exception.)

Here is a crude prototype in CAMLP4 (lists are not needed, but you must
remember which context is embedded in which one. There are also issues
with tail recursion that can be broken.

********** exc.ml *************
exception Located of exn * string list
 
let extract = function Located(e,l) -> e,l | e -> e,[]
 
let present exc l = List.mem exc l      

**********excemption.ml*************
open Pcaml
open MLast

let match_case = Grammar.Entry.find expr "match_case"
let try_case = Grammar.Entry.create Pcaml.gram "try_case"

DELETE_RULE
  expr: "try"; expr; "with"; OPT "|"; LIST1 match_case SEP "|"
END

EXTEND
  expr :
   [ [ "try"; x = expr; "with"; OPT "|"; l = LIST1 try_case SEP "|" ->
        let l' = l @ [(<:patt<_>>,None,<:expr<raise _exc_>>)] in
        <:expr< try $x$ with [ _exc_ ->
            let (_e_,_loc_) = Exc.extract _exc_ in
            match _e_ with [ $list:l'$ ] ] >>
    | "context"; name =  UIDENT; e = expr ->
        <:expr<
           try $e$ with
           [  Exc.Located(e,l) -> raise (Exc.Located(e, [ $str:name$ :: l]))
           | e -> raise (Exc.Located(e,[$str:name$]))] >> ]]
  ;
  try_case :
    [[ p = patt; aso = OPT [ "as"; p = patt -> p ];
       at_location = OPT ["in"; location = UIDENT -> location];
       w_opt = OPT [ "when"; e = expr -> e ]; "->"; e = expr ->
          let p_with_as =
            match aso with
              Some as_pat -> <:patt< ($p$ as $as_pat$) >>
            | _ -> p in
          let w_with_at =
            begin match w_opt,at_location with
            | Some w,Some lc -> Some(<:expr<($w$) && (Exc.present $str:lc$ _loc_)>>)
            | None,Some lc -> Some (<:expr<Exc.present $str:lc$ _loc_>>)
            | _,None -> w_opt
            end in
          (p_with_as, w_with_at, e) ]]
  ;
END  


-- 
Pierre Cregut - pierre.cregut@rd.francetelecom.fr - +33 2 96 05 16 28
FTR&D - DTL/MSV - 2 avenue Pierre Marzin - 22307 Lannion Cedex - France

Re: unwind-protect?

[Damien Doligez]

>From: Pierre Weis <Pierre.Weis@inria.fr>

>Here, polymorphism, curryfication, and specialization are shining,
>since you juste have to add one in_* functional application before an
>actual call to any function f to obtain a specialized evaluation
>context for f. For instance:

>let in_tmp f arg = in_directory "/tmp" f arg;;

Actually, currying gets in the way in this case (as it often does).
If f takes two arguments, then "in_tmp f x y" will not work as
expected, but the type-checker will not find the error.

-- Damien

Re: unwind-protect?

[Pierre Weis]

> >From: Pierre Weis <Pierre.Weis@inria.fr>
> 
> >Here, polymorphism, curryfication, and specialization are shining,
> >since you juste have to add one in_* functional application before an
> >actual call to any function f to obtain a specialized evaluation
> >context for f. For instance:
> 
> >let in_tmp f arg = in_directory "/tmp" f arg;;
> 
> Actually, currying gets in the way in this case (as it often does).
> If f takes two arguments, then "in_tmp f x y" will not work as
> expected, but the type-checker will not find the error.
> 
> -- Damien

Right, you have to know that this in_* functions protect the last
application of a function. Hence to apply a curried function you need
parens to partially apply the function, as in_tmp (f x y) z.

Alternatively, you can define your n-ary functions as having tupled
arguments and write in_tmp f (x, y, z) (then the typechecker will find
the ``arity'' errors).

If you had functions with specific arity built-in in the langage, you
would have to define multiple versions of the protect functions, one
for each arity, which is not so appealing...

Pierre Weis

INRIA, Projet Cristal, Pierre.Weis@inria.fr, http://cristal.inria.fr/~weis/

Re: unwind-protect?

[David McClain]

>Is there an equivalent of Lisp's `unwind-protect' or Java's
>"try...finally"?

Here is the version that I use. It expects two functions of no arguments --
one for the protected portion and one for cleanup that is invoked in any
event.

let unwind_protect fn exitfn =
  let rslt =
    try
      fn()
    with
 exn ->
   ignore(exitfn());
   raise exn
  in
    ignore(exitfn());
    rslt


- D.McClain