/* Conversions to and from C structs */
CS_INT conprop_of_value(value field)
{
CAMLparam1(field);
if (field == hash_variant("Username")) CAMLreturn(CS_USERNAME);
else if (field == hash_variant("Password")) CAMLreturn(CS_PASSWORD);
else /* if (field == hash_variant("Appname"))*/ CAMLreturn(CS_APPNAME);
}
value resinfo_type_of_value(value resinfo)
{
CAMLparam1(resinfo);
if ( resinfo == hash_variant("Row_count") )
CAMLreturn(CS_ROW_COUNT);
else if ( resinfo == hash_variant("Cmd_number") )
CAMLreturn(CS_CMD_NUMBER);
else /* if ( resinfo == hash_variant("Numdata") ) */
CAMLreturn(CS_NUMDATA);
}
value value_of_indicator(CS_INT indicator)
{
CAMLparam0 ();
switch(indicator)
{
case CS_NULLDATA:
CAMLreturn(hash_variant("NullData"));
case CS_GOODDATA:
default:
CAMLreturn(hash_variant("GoodData"));
}
}
value ocaml_triangle_init(value vunit)
{
/* noalloc */
meth_point = hash_variant("point");
meth_point_attribute = hash_variant("point_attribute");
meth_point_marker = hash_variant("point_marker");
meth_triangle = hash_variant("triangle");
meth_triangle_attribute = hash_variant("triangle_attribute");
mesh_segment = hash_variant("segment");
meth_segment_marker = hash_variant("segment_marker");
meth_hole = hash_variant("hole");
meth_region = hash_variant("region");
return Val_unit;
}
CS_INT cmdtype_of_value(value cmdtype)
{
CAMLparam1(cmdtype);
if ( cmdtype == hash_variant("Lang") )
CAMLreturn(CS_LANG_CMD);
else /* if ( cmdtype == hash_variant("Rpc")) */
CAMLreturn(CS_RPC_CMD);
}
static int mlvariant_to_c(variant *vtable, value variant)
{
int size = vtable[0].val;
int i;
for(i=1; i <= size; i++)
if(variant == hash_variant(vtable[i].name)) {
LOG("DEBUG: Found variant %s\n", vtable[i].name);
return vtable[i].val;
}
failwith("This variant cannot be converted from ML");
}
value value_of_status_bitmask(CS_INT status)
{
CAMLparam0 ();
CAMLlocal1(result);
result = Val_emptylist;
if ( status & CS_CANBENULL )
result = cons(hash_variant("CanBeNull"), result);
if ( status & CS_NODATA )
result = cons(hash_variant("NoData"), result);
if ( status & CS_IDENTITY )
result = cons(hash_variant("Identity"), result);
if ( status & CS_RETURN )
result = cons(hash_variant("Return"), result);
CAMLreturn(result);
}
value value_of_restype(CS_INT restype)
{
CAMLparam0 ();
if ( restype == CS_ROW_RESULT )
CAMLreturn( hash_variant("Row") );
if ( restype == CS_PARAM_RESULT )
CAMLreturn( hash_variant("Param") );
if ( restype == CS_STATUS_RESULT )
CAMLreturn( hash_variant("Status") );
if ( restype == CS_CMD_DONE )
CAMLreturn( hash_variant("Cmd_done") );
if ( restype != CS_CMD_SUCCEED )
raise_constant(*caml_named_value("cs_cmd_fail"));
CAMLreturn(hash_variant("Cmd_succeed"));
}
CS_INT status_of_value(value status)
{
CAMLparam1(status);
CS_INT result = 0;
CAMLlocal1(stat);
if ( status == Val_emptylist ) CAMLreturn(0);
else {
stat = car(status);
if ( stat == hash_variant("CanBeNull") )
result = CS_CANBENULL;
else if ( stat == hash_variant("NoData") )
result = CS_NODATA;
else if ( stat == hash_variant("Identity") )
result = CS_IDENTITY;
else if ( stat == hash_variant("Return") )
result = CS_RETURN;
/* Not tail recursive, but the list should be brief */
CAMLreturn(result | status_of_value(cdr(status)));
}
}
/*
// I intentionally skipped CAMLlocalN because intuition says that they are
// not needed because it is done in caller function
*/
value Val_QVariant(value _dest, const QVariant& var) {
CAMLparam1(_dest);
CAMLlocal1(_var);
if (!var.isValid()) {
_dest = hash_variant("empty");
} else {
const int ut = var.userType();
switch (ut) {
case QMetaType::Bool:
_dest = caml_alloc(2, 0);
Store_field(_dest, 0, hash_variant("bool"));
Store_field(_dest, 1, Val_bool(var.toBool()));
break;
case QMetaType::QString:
_dest = caml_alloc(2, 0);
Store_field(_dest, 0, hash_variant("string"));
Store_field(_dest, 1, caml_copy_string(var.value<QString>().toLocal8Bit().data()));
break;
case QMetaType::Int:
_dest = caml_alloc(2, 0);
Store_field(_dest, 0, hash_variant("int"));
Store_field(_dest, 1, Val_int(var.value<int>()));
break;
case QMetaType::Float:
case QMetaType::Double:
_dest = caml_alloc(2, 0);
Store_field(_dest, 0, hash_variant("float"));
Store_field(_dest, 1, caml_copy_double(var.toFloat()));
break;
case QMetaType::User:
case QMetaType::QObjectStar:
{
QObject *vvv = var.value<QObject*>();
_var = caml_alloc_small(1,Abstract_tag);
(*((QObject **) &Field(_var, 0))) = vvv;
_dest = caml_alloc(2,0);
Store_field(_dest, 0, hash_variant("qobject"));
Store_field(_dest, 1, _var);
}
break;
default:
QString msg("Type is not supported:");
msg += QString("userType() == %1").arg(ut);
Q_ASSERT_X(false, __func__, msg.toLocal8Bit().data() );
}
}
CAMLreturn(_dest);
}
value enum_to_caml_Qt_WindowFlags(Qt::WindowFlags e) {
switch (e) {
case Qt::CustomizeWindowHint: return hash_variant("CustomizeWindowHint");
case Qt::WindowTitleHint: return hash_variant("WindowTitleHint");
case Qt::FramelessWindowHint: return hash_variant("FramelessWindowHint");
case Qt::WindowType_Mask: return hash_variant("WindowType_Mask");
case Qt::SubWindow: return hash_variant("SubWindow");
case Qt::Desktop: return hash_variant("Desktop");
case Qt::SplashScreen: return hash_variant("SplashScreen");
case Qt::ToolTip: return hash_variant("ToolTip");
case Qt::Tool: return hash_variant("Tool");
case Qt::Popup: return hash_variant("Popup");
case Qt::Drawer: return hash_variant("Drawer");
case Qt::Sheet: return hash_variant("Sheet");
case Qt::Dialog: return hash_variant("Dialog");
case Qt::Window: return hash_variant("Window");
case Qt::Widget: return hash_variant("Widget");
}
printf("if u see this line, the thereis a bug in enum generation");
return Qt::CustomizeWindowHint;
}
CAMLprim value mltds_buffer_contents( value buffer )
{
CAMLparam1(buffer);
CAMLlocal2(result, str);
struct binding_buffer* buf = buffer_ptr(buffer);
if ( buf->indicator == CS_NULLDATA )
{
CAMLreturn(hash_variant("Null"));
}
/* There are many more cases here than necessary, mostly because
I wrote it before I learned about the ct-lib being able to do all
the conversions for me */
switch(buf->fmt.datatype)
{
case CS_BIT_TYPE:
result = alloc(2, 0);
Store_field(result, 0, hash_variant("Bit"));
Store_field(result, 1, Val_bool((int) BUFFER_CONTENTS(buf, CS_BIT)));
CAMLreturn(result);
case CS_TINYINT_TYPE:
result = alloc(2, 0);
Store_field(result, 0, hash_variant("Tinyint"));
Store_field(result, 1, Val_int((int) BUFFER_CONTENTS(buf, CS_TINYINT)));
CAMLreturn(result);
case CS_SMALLINT_TYPE:
result = alloc(2, 0);
Store_field(result, 0, hash_variant("Smallint"));
Store_field(result, 1, Val_int((int) BUFFER_CONTENTS(buf, CS_SMALLINT)));
CAMLreturn(result);
case CS_INT_TYPE:
result = alloc(2, 0);
Store_field(result, 0, hash_variant("Int"));
Store_field(result, 1, copy_int32((int) BUFFER_CONTENTS(buf, CS_INT)));
CAMLreturn(result);
case CS_FLOAT_TYPE:
case CS_REAL_TYPE:
result = alloc(2, 0);
Store_field(result, 0, hash_variant("Float"));
Store_field(result, 1, copy_double((double) BUFFER_CONTENTS(buf, CS_FLOAT)));
CAMLreturn(result);
case CS_TEXT_TYPE:
case CS_CHAR_TYPE:
case CS_VARCHAR_TYPE:
switch (buf->real_type)
{
case CS_BIGINT_TYPE:
case CS_MONEY_TYPE:
case CS_MONEY4_TYPE:
case CS_NUMERIC_TYPE:
case CS_DECIMAL_TYPE:
case CS_FLOAT_TYPE:
case CS_REAL_TYPE:
str = caml_alloc_initialized_string(buf->copied, buf->data);
result = alloc(2, 0);
Store_field(result, 0, hash_variant("Decimal"));
Store_field(result, 1, str);
CAMLreturn(result);
case CS_TEXT_TYPE:
case CS_CHAR_TYPE:
case CS_VARCHAR_TYPE:
default:
str = caml_alloc_initialized_string(buf->copied, buf->data);
result = alloc(2, 0);
Store_field(result, 0, hash_variant("String"));
Store_field(result, 1, str);
CAMLreturn(result);
}
break;
case CS_IMAGE_TYPE:
case CS_BINARY_TYPE:
case CS_VARBINARY_TYPE:
case CS_DATETIME_TYPE:
case CS_DATETIME4_TYPE:
case CS_MONEY_TYPE:
case CS_MONEY4_TYPE:
case CS_NUMERIC_TYPE:
case CS_DECIMAL_TYPE:
default:
str = caml_alloc_initialized_string(buf->copied, buf->data);
result = alloc(2, 0);
Store_field(result, 0, hash_variant("Binary"));
Store_field(result, 1, str);
CAMLreturn(result);
}
}
value value_of_datatype(int datatype)
{
CAMLparam0 ();
switch(datatype)
{
case CS_CHAR_TYPE: CAMLreturn(hash_variant("Char"));
case CS_INT_TYPE: CAMLreturn(hash_variant("Int"));
case CS_SMALLINT_TYPE: CAMLreturn(hash_variant("SmallInt"));
case CS_TINYINT_TYPE: CAMLreturn(hash_variant("TinyInt"));
case CS_MONEY_TYPE: CAMLreturn(hash_variant("Money"));
case CS_DATETIME_TYPE: CAMLreturn(hash_variant("DateTime"));
case CS_NUMERIC_TYPE: CAMLreturn(hash_variant("Numeric"));
case CS_DECIMAL_TYPE: CAMLreturn(hash_variant("Decimal"));
case CS_DATETIME4_TYPE: CAMLreturn(hash_variant("DateTime4"));
case CS_MONEY4_TYPE: CAMLreturn(hash_variant("Money4"));
case CS_IMAGE_TYPE: CAMLreturn(hash_variant("Image"));
case CS_BINARY_TYPE: CAMLreturn(hash_variant("Binary"));
case CS_BIT_TYPE: CAMLreturn(hash_variant("Bit"));
case CS_REAL_TYPE: CAMLreturn(hash_variant("Real"));
case CS_FLOAT_TYPE: CAMLreturn(hash_variant("Float"));
case CS_TEXT_TYPE: CAMLreturn(hash_variant("Text"));
case CS_VARCHAR_TYPE: CAMLreturn(hash_variant("VarChar"));
case CS_VARBINARY_TYPE: CAMLreturn(hash_variant("VarBinary"));
case CS_LONGCHAR_TYPE: CAMLreturn(hash_variant("LongChar"));
case CS_LONGBINARY_TYPE: CAMLreturn(hash_variant("LongBinary"));
case CS_LONG_TYPE: CAMLreturn(hash_variant("Long"));
case CS_ILLEGAL_TYPE: CAMLreturn(hash_variant("Illegal"));
case CS_SENSITIVITY_TYPE: CAMLreturn(hash_variant("Sensitivity"));
case CS_BOUNDARY_TYPE: CAMLreturn(hash_variant("Boundary"));
case CS_VOID_TYPE: CAMLreturn(hash_variant("Void"));
case CS_USHORT_TYPE: CAMLreturn(hash_variant("UShort"));
#ifdef CS_UNIQUE_TYPE
/* Not supported in (at least some versions of) sybase */
case CS_UNIQUE_TYPE: CAMLreturn(hash_variant("Unique"));
#endif
}
CAMLreturn(hash_variant("Illegal"));
}
