value caml_vc_funType3(value vc, value a1, value a2, value a3, value tr)
{
CAMLparam5(vc,a1,a2,a3,tr);
CAMLreturn(alloc_Type(vc_funType3(VC_val(vc),Type_val(a1),
Type_val(a2),Type_val(a3),
Type_val(tr))));
}
CAMLprim value ocamlyices_type_tuple2(value v_tau1, value v_tau2) {
CAMLparam2(v_tau1, v_tau2);
type_t res;
res = yices_tuple_type2(Type_val(v_tau1), Type_val(v_tau2));
if (res == NULL_TYPE) {
_oy_error();
}
CAMLreturn(Val_type(res));
}
CAMLprim value ocamlyices_type_function1(value v_dom1, value v_range) {
CAMLparam2(v_dom1, v_range);
type_t res;
res = yices_function_type1(Type_val(v_dom1), Type_val(v_range));
if (res == NULL_TYPE) {
_oy_error();
}
CAMLreturn(Val_type(res));
}
CAMLprim value ocamlyices_type_is_subtype(value v_t1, value v_t2) {
CAMLparam2(v_t1, v_t2);
int32_t res;
res = yices_test_subtype(Type_val(v_t1), Type_val(v_t2));
if (res == 0) {
_oy_check_error();
}
CAMLreturn(Val_bool(res != 0));
}
value caml_vc_recordTypeN(value vc, value fields, value types, value num)
{
char **fs;
Type *ts;
int i;
CAMLparam4(vc,fields,types,num);
CAMLlocal1(result);
fs = (char **)malloc(Int_val(num) * sizeof(char *));
if( !fs )
caml_failwith("malloc returned NULL in vc_recordTypeN wrapper");
ts = (Type *)malloc(Int_val(num) * sizeof(Type));
if( !ts ) {
free( fs );
caml_failwith("malloc returned NULL in vc_recordTypeN wrapper");
}
for( i = 0; i < Int_val(num); i++ ) {
fs[i] = String_val(Field(fields,i));
ts[i] = Type_val(Field(types,i));
}
result = alloc_Type(vc_recordTypeN(VC_val(vc),fs,ts,Int_val(num)));
free(ts);
free(fs);
CAMLreturn(result);
}
static inline value _oy_bool_of_type (int32_t (*f) (type_t), value v_t) {
CAMLparam1(v_t);
int32_t res = f(Type_val(v_t));
if (res == 0) {
_oy_check_error();
}
CAMLreturn(Val_bool(res));
}
// Convertsa Type to a string
value caml_typeString(value t)
{
CAMLparam1(t);
CAMLlocal1(r);
r = caml_copy_string(typeString(Type_val(t)));
CAMLreturn(r);
}
static inline type_t *_oy_types_from_values(value v_arr, uint32_t n) {
uint32_t i;
type_t *arr = (type_t *)malloc(sizeof(type_t[n]));
if (arr) {
for (i = 0; i < n; i++) {
arr[i] = Type_val(Field(v_arr, i));
}
}
return arr;
}
CAMLprim value ocamlyices_type_clear_name (value v_typ) {
// Hyp: type values are non-block
int32_t res;
res = yices_clear_type_name(Type_val(v_typ));
if (res != 0) {
_oy_error();
}
return Val_unit;
}
CAMLprim value ocamlyices_type_get_name (value v_typ) {
// Hyp: type values are non-block
const char *res;
res = yices_get_type_name(Type_val(v_typ));
if (res == NULL) {
_oy_error();
}
return caml_copy_string(res);
}
CAMLprim value ocamlyices_type_tuple1(value v_tau1) {
CAMLparam1(v_tau1);
type_t res;
res = yices_tuple_type1(Type_val(v_tau1));
if (res == NULL_TYPE) {
_oy_error();
}
CAMLreturn(Val_type(res));
}
CAMLprim value ocamlyices_type_set_name (value v_t, value v_name) {
// Hyp: type values are non-block
CAMLparam1(v_name);
int32_t res;
res = yices_set_type_name(Type_val(v_t), String_val(v_name));
if (res != 0) {
_oy_error();
}
CAMLreturn(Val_unit);
}
CAMLprim value ocamlyices_type_print(value v_width_opt, value v_height_opt,
value v_offset_opt, value v_cb, value v_t) {
CAMLparam4(v_width_opt, v_height_opt, v_offset_opt, v_cb);
type_t t = Type_val(v_t);
uint32_t width = (uint32_t)Long_option_val(v_width_opt, UINT32_MAX);
uint32_t height = (uint32_t)Long_option_val(v_height_opt, 1);
uint32_t offset = (uint32_t)Long_option_val(v_offset_opt, 0);
struct pp_type_arg arg = { t, width, height, offset };
int res = _oy_callback_print(v_cb, &_oy_type_pp, &arg);
if (res != 0) {
_oy_error();
}
CAMLreturn(Val_unit);
}
value caml_vc_funTypeN(value vc, value args, value r, value num)
{
Type *ts;
int i;
CAMLparam4(vc,args,r,num);
CAMLlocal1(result);
ts = (Type *)malloc(Int_val(num) * sizeof(Type));
if( !ts )
caml_failwith("malloc returned NULL in vc_funTypeN wrapper");
for( i = 0; i < Int_val(num); i++ ) {
ts[i] = Type_val(Field(args,i));
}
result = alloc_Type(vc_funTypeN(VC_val(vc), ts, Type_val(r),
Int_val(num)));
free( ts );
CAMLreturn(result);
}
CAMLprim value ocamlyices_type_bitsize (value v_typ) {
// Hyp: type values are non-block
uint32_t bitsize = yices_bvtype_size(Type_val(v_typ));
if (bitsize == 0) {
_oy_error();
}
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wtype-limits"
if (YICES_MAX_BVSIZE > Max_long /* should not happen */ &&
bitsize > Max_long /* only possible on <= 64-bit system */) {
#pragma GCC diagnostic pop
_oy_binding_overflow_error();
}
return Val_long((intnat)bitsize);
}
CAMLprim value ocamlyices_type_function (value v_dom, value v_range) {
CAMLparam2(v_dom, v_range);
type_t res, *dom;
uint32_t n;
n = check_Wosize_val(v_dom);
dom = _oy_types_from_values(v_dom, n);
if (dom == NULL) {
_oy_allocation_error();
}
res = yices_function_type(n, dom, Type_val(v_range));
free(dom);
if (res == NULL_TYPE) {
_oy_error();
}
CAMLreturn(Val_type(res));
}
value caml_vc_tupleTypeN(value vc, value types, value numTypes)
{
Type *ts;
int i;
CAMLparam3(vc,types,numTypes);
CAMLlocal1(result);
ts = (Type *)malloc(Int_val(numTypes) * sizeof(Type));
if( !ts )
caml_failwith("malloc returned NULL in vc_tupleTypeN wrapper");
for( i = 0; i < Int_val(numTypes); i++ ) {
ts[i] = Type_val(Field(types,i));
}
result = alloc_Type(vc_tupleTypeN(VC_val(vc), ts, Int_val(numTypes)));
free( ts );
CAMLreturn(result);
}
value caml_vc_recordType2(value vc, value f0, value t0, value f1, value t1)
{
CAMLparam5(vc,f0,t0,f1,t1);
CAMLreturn(alloc_Type(vc_recordType2(VC_val(vc),String_val(f0),Type_val(t0),
String_val(f1),Type_val(t1))));
}
// Create an array type
value caml_vc_arrayType(value vc, value it, value dt)
{
CAMLparam3(vc,it,dt);
CAMLreturn(alloc_Type(vc_arrayType(VC_val(vc),Type_val(it),Type_val(dt))));
}
static value alloc_Type(Type t)
{
value v = alloc_custom(&Type_ops, sizeof(Type), 0, 1);
Type_val(v) = t;
return v;
}
// Create function types
value caml_vc_funType1(value vc, value a1, value tr)
{
CAMLparam3(vc,a1,tr);
CAMLreturn(alloc_Type(vc_funType1(VC_val(vc),Type_val(a1),Type_val(tr))));
}
value caml_vc_funType2(value vc, value a1, value a2, value tr)
{
CAMLparam4(vc,a1,a2,tr);
CAMLreturn(alloc_Type(vc_funType2(VC_val(vc),Type_val(a1),
Type_val(a2),Type_val(tr))));
}
value caml_vc_deleteType(value type)
{
CAMLparam1(type);
vc_deleteType(Type_val(type));
CAMLreturn(Val_unit);
}
value caml_toExpr(value t)
{
CAMLparam1(t);
CAMLreturn(alloc_Expr(toExpr(Type_val(t))));
}
// Tuple Types
value caml_vc_tupleType2(value vc, value t0, value t1)
{
CAMLparam3(vc,t0,t1);
CAMLreturn(alloc_Type(vc_tupleType2(VC_val(vc),Type_val(t0),Type_val(t1))));
}
// Record Types
value caml_vc_recordType1(value vc, value field, value t)
{
CAMLparam3(vc, field, t);
CAMLreturn(alloc_Type(vc_recordType1(VC_val(vc),String_val(field),
Type_val(t))));
}
value caml_vc_tupleType3(value vc, value t0, value t1, value t2)
{
CAMLparam4(vc,t0,t1,t2);
CAMLreturn(alloc_Type(vc_tupleType3(VC_val(vc),Type_val(t0),
Type_val(t1),Type_val(t2))));
}
// Get the expression and type associated with a name
value caml_vc_lookupVar(value vc, value name, value t)
{
CAMLparam3(vc,name,t);
CAMLreturn(alloc_Expr(vc_lookupVar(VC_val(vc),String_val(name),Type_val(t))));
}
