CAMLprim value ocamlr_eval_sxp (value sexp_list) {
/* sexp_list is an OCaml value containing a SEXP of sexptype LANGSXP.
This is a LISP-style pairlist of SEXP values. r_eval_sxp executes
the whole pairlist, and sends back the resulting SEXP wrapped up in
an OCaml value. There's also an error handling mechanism. */
/* r_eval_sxp handles values of type LANGSXP and PROMSXP. So we have two
functions on the OCaml side associated to this stub, the first on
with type lang sexp -> raw sexp, the other one with type
prom sexp -> raw sexp. This also means that there is a dynamic type
checking being done in the scope of the R_tryEval function, and it
would be nice to shortcut it with statically typed equivalents. */
CAMLparam0();
SEXP e; // Placeholder for the result of beta-reduction.
int error = 0; // Error catcher boolean.
SEXP our_call = Sexp_val(sexp_list);
caml_enter_blocking_section();
e = R_tryEval(our_call, R_GlobalEnv, &error);
caml_leave_blocking_section();
/* Implements error handling from R to Objective Caml. */
if (error) {
value ml_error_call = Val_unit;
value ml_error_message = Val_unit;
Begin_roots2(ml_error_call, ml_error_message);
ml_error_call = Val_sexp(ocamlr_error_call);
ocamlr_error_call = NULL; //should check for a memory leak here...
//depends on GC status of prior error_call.
ml_error_message = caml_copy_string(ocamlr_error_message);
ocamlr_error_message = NULL; //should check for a memory leak here...
//it seems to me that a string is leaked here.
value error_result = caml_alloc_small(2, 0);
Store_field(error_result, 0, ml_error_call);
Store_field(error_result, 1, ml_error_message);
/* The exception callback mechanism is described on the webpage
http://www.pps.jussieu.fr/Livres/ora/DA-OCAML/book-ora118.html
We should check to see if we could avoid the string-name lookup
to avoid unnecessary delays in exception handling. */
caml_raise_with_arg(*caml_named_value("OCaml-R generic error"), error_result);
End_roots();
}
CAMLreturn(Val_sexp(e));
}
/** Returns the environment of a closure.
*
* @param sexp An R closure.
* @return The environment of the R closure.
*/
CAMLprim value ocamlr_inspect_closxp_env (value sexp) {
return(Val_sexp(CLOENV(Sexp_val(sexp))));
}
/** Returns the body of a closure.
*
* @param sexp An R closure.
* @return The body of the R closure.
*/
CAMLprim value ocamlr_inspect_closxp_body (value sexp) {
return(Val_sexp(BODY(Sexp_val(sexp))));
}
/** Returns the list of formal arguments of a closure.
*
* @param sexp An R closure.
* @return The list of formal arguments of the R closure.
*/
CAMLprim value ocamlr_inspect_closxp_formals (value sexp) {
return(Val_sexp(FORMALS(Sexp_val(sexp))));
}
/** Returns the hash table of an environment.
*
* @param sexp An R environment.
* @return The hash table of the R environment.
*/
CAMLprim value ocamlr_inspect_envsxp_hashtab (value sexp) {
return(Val_sexp(HASHTAB(Sexp_val(sexp))));
}
/** Returns the enclosing environment of an environment.
*
* @param sexp An R environment.
* @return The enclosing environmnent of the R environment.
*/
CAMLprim value ocamlr_inspect_envsxp_enclos (value sexp) {
return(Val_sexp(ENCLOS(Sexp_val(sexp))));
}
/** Returns the frame of an environment.
*
* @param sexp An R environment.
* @return The frame of the R environment.
*/
CAMLprim value ocamlr_inspect_envsxp_frame (value sexp) {
return(Val_sexp(FRAME(Sexp_val(sexp))));
}
CAMLprim value ocamlr_get_attrib (value sexp, value symbolname) {
return(Val_sexp(getAttrib(Sexp_val(sexp), Sexp_val(symbolname))));
}
/** Returns the tail pairlist of a pairlist.
*
* @param sexp An R pairlist.
* @return The tail pairlist of the R pairlist.
*/
CAMLprim value ocamlr_inspect_listsxp_cdrval (value sexp) {
return(Val_sexp(CDR(Sexp_val(sexp))));
}
/** Returns the internal sexp of a symbol.
*
* @param sexp An R value of sexptype SYMSXP.
* @return The internal value of a symbol.
*/
CAMLprim value ocamlr_inspect_symsxp_internal (value sexp) {
return(Val_sexp(INTERNAL(Sexp_val(sexp))));
}
/** Returns the value of a symbol.
*
* @param sexp An R value of sexptype SYMSXP.
* @return The value of the R symbol.
*/
CAMLprim value ocamlr_inspect_symsxp_value (value sexp) {
return(Val_sexp(SYMVALUE(Sexp_val(sexp))));
}
/** Returns the name of an R symbol.
*
* @param sexp An R value of sexptype SYMSXP.
* @return The name of the R symbol.
*/
CAMLprim value ocamlr_inspect_symsxp_pname (value sexp) {
return(Val_sexp(PRINTNAME(Sexp_val(sexp))));
}
/** Returns the offset of an R primitive function.
*
* @note: This function bypasses the provided API, and requires the
* use of the #define USE_RINTERNALS directive.
*
* @param sexp An R value which is a primitive function.
* @return Its offset in the R table of primitives.
*/
CAMLprim value ocamlr_inspect_primsxp_offset (value sexp) {
return(Val_int(Sexp_val(sexp)->u.primsxp.offset));
}
/** Returns the environment of a promise.
*
* @note This function bypasses the provided R API, and requires the
* use of the #define USE_RINTERNALS directive.
*
* @param sexp An R promise.
* @return The environment of the R promise.
*/
CAMLprim value ocamlr_inspect_promsxp_env (value sexp) {
return(Val_sexp(Sexp_val(sexp)->u.promsxp.env));
}
/** Returns the tag value of the head element of a pairlist.
*
* @param sexp An R pairlist.
* @return The tag of the head of the R pairlist.
*/
CAMLprim value ocamlr_inspect_listsxp_tagval (value sexp) {
return(Val_sexp(TAG(Sexp_val(sexp))));
}
/** Returns the attributes of an R value.
*
* @param sexp An R value.
* @return The attributes of this value, as a pairlist.
*/
CAMLprim value ocamlr_inspect_attributes (value sexp) {
return(Val_sexp(ATTRIB(Sexp_val(sexp))));
}
CAMLprim value ocamlr_s3_class (value sexp) {
return(Val_sexp(getAttrib(Sexp_val(sexp), R_ClassSymbol)));
}
