Re: [Caml-list] C++ Throws

["David McClain" <dmcclain1@mindspring.com>]

[-- Attachment #1: Type: text/plain, Size: 3433 bytes --]

The main reason I was looking for a higher level generic mechanism for
catching C++ throws is the desparate lack of functional closures in C++. If
there were such a thing, then it would easy to wrap all the lower level
calls in a safe try-catch block which has the closure passed to it...

Alas, I sat down and invented a poor-man's functional closure system for
C++, along the lines of CAMLparam1, etc....

The world is welcome to this... (attached) It is intended for use in OCaml
C++ interface stubs, hence the use of value parameters in the closure
classes.

An example of its use is here:
// -----------------------------------------------------------
extern "C"
void foreign_array_blit_ml_to_f(value varr1, value voff1,
value varr2, value voff2, value vnel)
{
    VClosure5(clos,
        varr1,voff1,varr2,voff2,vnel,
        {
            long off1 = Long_val(VClArg(voff1));
            long nel = Long_val(VClArg(vnel));
            foreign_array fsrc(FOREIGN_DOUBLE, 1, &nel,
            (void*)((double*)VClArg(varr1) + off1),
            foreign_array::STATIC);
            long off2 = Long_val(VClArg(voff2));
            foreign_array *pdst = pdata(VClArg(varr2));
            array_blit(&fsrc, 0, pdst, off2, nel);
        },
        &varr1);
    safe_call(clos);
}
// -----------------------------------------------------------

- DM

----- Original Message ----- 
From: "Brian Hurt" <bhurt@spnz.org>
To: "David McClain" <David.McClain@Avisere.com>
Cc: <caml-list@inria.fr>
Sent: Friday, August 27, 2004 16:24
Subject: Re: [Caml-list] C++ Throws


> On Fri, 27 Aug 2004, David McClain wrote:
>
> > I now see that OCaml is not converting anything, per se... Apparently
> > when the throw handler detects an unhandled condition it decides to
> > call abort(), against which there is no defense.
>
> I don't know what precisely is going on here, but Ocaml interfaces to C,
> which doesn't know anything about exceptions.  You might try something
> like (sorry, I'm no C++ guru):
>
> extern "C" value foo(value c);
>
> value foo(value C) {
>     /* normal Ocaml wrapper code for C */
>     try {
>         /* exception throwing code for C++. */
>     }
>     with (Exception e) {
>         /* Translate the C++ exception to an Ocaml exception */
>     }
> }
>
> The big difference between a C++ function and C function is the name
> mangling.  I doubt Ocaml could find a C++ function for linking after it
> was name mangled.  So the extern "C" tells C++ to not namemangle the
> function name.
>
> There is no way I know of to determine what exceptions a function call
> might throw.
>
> > So there appears to be something relatively complex going on across the
> > foreign function interface with OCaml and C. This override is what
> > frustrates the attempts to create a generic C++ exception handler.
>
> I think you also have a C/C++ interface problem (and yes, Virginia, they
> do exist).
>
> -- 
> "Usenet is like a herd of performing elephants with diarrhea -- massive,
> difficult to redirect, awe-inspiring, entertaining, and a source of
> mind-boggling amounts of excrement when you least expect it."
>                                 - Gene Spafford
> Brian
>
> -------------------
> To unsubscribe, mail caml-list-request@inria.fr Archives:
http://caml.inria.fr
> Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ:
http://caml.inria.fr/FAQ/
> Beginner's list: http://groups.yahoo.com/group/ocaml_beginners
>

[-- Attachment #2: TClosure.h --]
[-- Type: application/octet-stream, Size: 2598 bytes --]

// TClosure.h -- Simulation of Functional Closures in C++
// DM/MCFA  08/04
//
#ifndef __TCLOSURE_H__
#define __TCLOSURE_H__

extern "C" {
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/alloc.h>
#include <caml/fail.h>
#include <caml/custom.h>
#include <caml/intext.h>
};

class TClosure
{
public:
  TClosure() {};
  virtual ~TClosure() {};
  
  virtual void operator()() = 0;
};

#ifdef __TClosure_Instantiate__
void safe_call(TClosure &closure)
{
  try {
    closure();
  } catch(const char* msg) {
    failwith((char*)msg);
  }
}
#else
extern void safe_call(TClosure &closure);
#endif

// ------------------------------------------------
// Internal macros
//
#define __VClosureHead()				\
  struct closure: public TClosure			\
  {							\
    value *m_pparm;					\
    value  m_result;					\
    closure(value *pparm)				\
      :m_pparm(pparm)					\
      {}						\

#define __VClosureArgs1(arg)			\
  enum {arg};

#define __VClosureArgs2(arg1,arg2)		\
  enum {arg1,arg2};

#define __VClosureArgs3(arg1,arg2,arg3)		\
  enum {arg1,arg2,arg3};

#define __VClosureArgs4(arg1,arg2,arg3,arg4)	\
  enum {arg1,arg2,arg3,arg4};

#define __VClosureArgs5(arg1,arg2,arg3,arg4,arg5)	\
  enum {arg1,arg2,arg3,arg4,arg5};

#define __VClosureTail(name,body,env)			\
  void operator()()					\
  { body }						\
  } name(env);

// ------------------------------------------------------
// API Level Macros

#define VClosure(name,body,env)	     \
  __VClosureHead()		     \
    __VClosureTail(name,body,env)

#define VClosure1(name,arg,body,env) \
  __VClosureHead()		     \
    __VClosureArgs1(arg)		     \
       __VClosureTail(name,body,env)

#define VClosure2(name,arg1,arg2,body,env)	\
  __VClosureHead()				\
    __VClosureArgs2(arg1,arg2)			\
       __VClosureTail(name,body,env)

#define VClosure3(name,arg1,arg2,arg3,body,env)	\
  __VClosureHead()				\
    __VClosureArgs3(arg1,arg2,arg3)		\
       __VClosureTail(name,body,env)

#define VClosure4(name,arg1,arg2,arg3,arg4,body,env)	\
  __VClosureHead()					\
    __VClosureArgs4(arg1,arg2,arg3,arg4)			\
       __VClosureTail(name,body,env)

#define VClosure5(name,arg1,arg2,arg3,arg4,arg5,body,env)	\
  __VClosureHead()						\
    __VClosureArgs5(arg1,arg2,arg3,arg4,arg5)			\
       __VClosureTail(name,body,env)

#define VClArg(name)             m_pparm[name]
#define VClReturn(val)           m_result = val;
#define VClResult(closure_name)  closure_name.m_result

#endif // __TCLOSURE_H__

// -- end of TClosure.h -- //