mirror of
https://github.com/Z3Prover/z3
synced 2025-04-23 09:05:31 +00:00
Translate correctly between OCaml option values and NULL pointers
This patch refactors the update_api script and the z3.ml implementation to properly translate between OCaml options and NULL pointers. Some unifications and simplifications (avoidance of unnecessary value allocation) in the script that creates the native bindings.
This commit is contained in:
martin-neuhaeusser
parent
b85516c271
commit
f133f478c8
4 changed files with 451 additions and 475 deletions
674
src/api/ml/z3.ml
674
src/api/ml/z3.ml
File diff suppressed because it is too large
Load diff
|
|
@ -32,75 +32,5 @@ and optimize = ptr
|
|||
and param_descrs = ptr
|
||||
and rcf_num = ptr
|
||||
|
||||
external is_null : ptr -> bool
|
||||
= "n_is_null"
|
||||
|
||||
external mk_null : unit -> ptr
|
||||
= "n_mk_null"
|
||||
|
||||
external set_internal_error_handler : ptr -> unit
|
||||
= "n_set_internal_error_handler"
|
||||
|
||||
|
||||
external context_of_symbol : symbol -> context
|
||||
= "n_context_of_symbol"
|
||||
|
||||
external context_of_constructor : constructor -> context
|
||||
= "n_context_of_constructor"
|
||||
|
||||
external context_of_constructor_list : constructor_list -> context
|
||||
= "n_context_of_constructor_list"
|
||||
|
||||
external context_of_rcf_num : rcf_num -> context
|
||||
= "n_context_of_rcf_num"
|
||||
|
||||
|
||||
external context_of_ast : ast -> context
|
||||
= "n_context_of_ast"
|
||||
|
||||
external context_of_params : params -> context
|
||||
= "n_context_of_params"
|
||||
|
||||
external context_of_param_descrs : param_descrs -> context
|
||||
= "n_context_of_param_descrs"
|
||||
|
||||
external context_of_model : model -> context
|
||||
= "n_context_of_model"
|
||||
|
||||
external context_of_func_interp : func_interp -> context
|
||||
= "n_context_of_func_interp"
|
||||
|
||||
external context_of_func_entry : func_entry -> context
|
||||
= "n_context_of_func_entry"
|
||||
|
||||
external context_of_goal : goal -> context
|
||||
= "n_context_of_goal"
|
||||
|
||||
external context_of_tactic : tactic -> context
|
||||
= "n_context_of_tactic"
|
||||
|
||||
external context_of_probe : probe -> context
|
||||
= "n_context_of_probe"
|
||||
|
||||
external context_of_apply_result : apply_result -> context
|
||||
= "n_context_of_apply_result"
|
||||
|
||||
external context_of_solver : solver -> context
|
||||
= "n_context_of_solver"
|
||||
|
||||
external context_of_stats : stats -> context
|
||||
= "n_context_of_stats"
|
||||
|
||||
external context_of_ast_vector : ast_vector -> context
|
||||
= "n_context_of_ast_vector"
|
||||
|
||||
external context_of_ast_map : ast_map -> context
|
||||
= "n_context_of_ast_map"
|
||||
|
||||
external context_of_fixedpoint : fixedpoint -> context
|
||||
= "n_context_of_fixedpoint"
|
||||
|
||||
external context_of_optimize : optimize -> context
|
||||
= "n_context_of_optimize"
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -72,10 +72,27 @@ static struct custom_operations default_custom_ops = {
|
|||
Z3_ ## X ## _plus * p = (Z3_ ## X ## _plus *) Data_custom_val(v); \
|
||||
cp = p->cp; \
|
||||
result = caml_alloc_custom(&Z3_context_plus_custom_ops, sizeof(Z3_context_plus), 0, 1); \
|
||||
*(Z3_context_plus*)Data_custom_val(result) = cp; \
|
||||
/* We increment the usage counter of the context */ \
|
||||
*(Z3_context_plus *)Data_custom_val(result) = cp; \
|
||||
/* We increment the usage counter of the context, as we just \
|
||||
created a second custom block holding that context */ \
|
||||
cp->obj_count++; \
|
||||
CAMLreturn(result); \
|
||||
} \
|
||||
\
|
||||
CAMLprim value DLL_PUBLIC n_is_null_ ## X (value v) { \
|
||||
CAMLparam1(v); \
|
||||
Z3_ ## X ## _plus* pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \
|
||||
CAMLreturn(Val_bool(pp->p == NULL)); \
|
||||
} \
|
||||
\
|
||||
CAMLprim value DLL_PUBLIC n_mk_null_ ## X (value v) { \
|
||||
CAMLparam1(v); \
|
||||
CAMLlocal1(result); \
|
||||
Z3_context_plus cp = *(Z3_context_plus*)(Data_custom_val(v)); \
|
||||
Z3_ ## X ## _plus a = Z3_ ## X ## _plus_mk(cp, NULL); \
|
||||
result = caml_alloc_custom(&Z3_ ## X ## _plus_custom_ops, sizeof(Z3_ ## X ## _plus), 0, 1); \
|
||||
*(Z3_ ## X ## _plus*)(Data_custom_val(result)) = a; \
|
||||
CAMLreturn(result); \
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -103,7 +120,8 @@ Z3_context_plus Z3_context_plus_mk(Z3_context c) {
|
|||
Z3_context_plus r = (Z3_context_plus)malloc(sizeof(Z3_context_plus_data));
|
||||
r->ctx = c;
|
||||
/* The context created here will be wrapped into a custom block.
|
||||
Hence, we assign it a counter of one. */
|
||||
We regard custom blocks that point to a Z3_context_plus structure
|
||||
as a usage of this structure. Hence, we assign it a counter of one. */
|
||||
r->obj_count = 1;
|
||||
return r;
|
||||
}
|
||||
|
|
@ -113,17 +131,17 @@ Z3_context Z3_context_plus_raw(Z3_context_plus * cp) {
|
|||
}
|
||||
|
||||
inline void try_to_delete_context(Z3_context_plus cp) {
|
||||
if (cp->obj_count > 0)
|
||||
/* printf("try_to_delete_context: Not deleting context %p(%p) with cnt=%lu.\n", cp, cp->ctx, cp->obj_count) */ ;
|
||||
else if (cp->obj_count < 0)
|
||||
printf("try_to_delete_context: ERROR, found context %p(%p) with negative cnt=%lu.\n", cp, cp->ctx, cp->obj_count);
|
||||
else {
|
||||
printf("try_to_delete_context: Deleting context %p(%p) with cnt=%lu.\n", cp, cp->ctx, cp->obj_count);
|
||||
if (cp->obj_count == 0) {
|
||||
/* printf("try_to_delete_context: Deleting context %p(%p) with cnt=0.\n", cp, cp->ctx); */
|
||||
Z3_del_context(cp->ctx);
|
||||
cp->ctx = NULL;
|
||||
cp->obj_count = 0;
|
||||
free(cp);
|
||||
}
|
||||
/*
|
||||
else if (cp->obj_count > 0)
|
||||
printf("try_to_delete_context: Not deleting context %p(%p) with cnt=%lu.\n", cp, cp->ctx, cp->obj_count);
|
||||
else if (cp->obj_count < 0)
|
||||
printf("try_to_delete_context: ERROR, found context %p(%p) with negative cnt=%lu.\n", cp, cp->ctx, cp->obj_count);
|
||||
*/
|
||||
}
|
||||
|
||||
void Z3_context_finalize(value v) {
|
||||
|
|
@ -147,27 +165,29 @@ static struct custom_operations Z3_context_plus_custom_ops = {
|
|||
|
||||
typedef struct {
|
||||
Z3_context_plus cp;
|
||||
Z3_ast a;
|
||||
Z3_ast p;
|
||||
} Z3_ast_plus;
|
||||
|
||||
Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus cp, Z3_ast a) {
|
||||
Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus cp, Z3_ast p) {
|
||||
Z3_ast_plus r;
|
||||
r.cp = cp;
|
||||
r.a = a;
|
||||
r.p = p;
|
||||
/* printf("++\n"); */
|
||||
cp->obj_count++;
|
||||
Z3_inc_ref(cp->ctx, a);
|
||||
if (p != NULL)
|
||||
Z3_inc_ref(cp->ctx, p);
|
||||
return r;
|
||||
}
|
||||
|
||||
Z3_ast Z3_ast_plus_raw(Z3_ast_plus * ap) {
|
||||
return ap->a;
|
||||
return ap->p;
|
||||
}
|
||||
|
||||
void Z3_ast_finalize(value v) {
|
||||
/* printf("--\n"); */
|
||||
Z3_ast_plus * ap = (Z3_ast_plus*)(Data_custom_val(v));
|
||||
Z3_dec_ref(ap->cp->ctx, ap->a);
|
||||
if (ap->p != NULL)
|
||||
Z3_dec_ref(ap->cp->ctx, ap->p);
|
||||
ap->cp->obj_count--;
|
||||
try_to_delete_context(ap->cp);
|
||||
}
|
||||
|
|
@ -176,8 +196,14 @@ int Z3_ast_compare(value v1, value v2) {
|
|||
Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1);
|
||||
Z3_ast_plus * a2 = (Z3_ast_plus*)Data_custom_val(v2);
|
||||
assert(a1->cp->ctx == a2->cp->ctx);
|
||||
unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->a);
|
||||
unsigned id2 = Z3_get_ast_id(a2->cp->ctx, a2->a);
|
||||
if (a1->p == NULL && a2->p == NULL)
|
||||
return 0;
|
||||
if (a1->p == NULL)
|
||||
return -1;
|
||||
if (a2->p == NULL)
|
||||
return +1;
|
||||
unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->p);
|
||||
unsigned id2 = Z3_get_ast_id(a2->cp->ctx, a2->p);
|
||||
if (id1 == id2)
|
||||
return 0;
|
||||
else if (id1 < id2)
|
||||
|
|
@ -188,8 +214,15 @@ int Z3_ast_compare(value v1, value v2) {
|
|||
|
||||
int Z3_ast_compare_ext(value v1, value v2) {
|
||||
Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1);
|
||||
unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->a);
|
||||
unsigned id1;
|
||||
int id2 = Val_int(v2);
|
||||
if (a1->p == NULL && id2 == 0)
|
||||
return 0;
|
||||
if (a1->p == NULL)
|
||||
return -1;
|
||||
if (id2 == 0)
|
||||
return +1;
|
||||
id1 = Z3_get_ast_id(a1->cp->ctx, a1->p);
|
||||
if (id1 == id2)
|
||||
return 0;
|
||||
else if (id1 < id2)
|
||||
|
|
@ -200,7 +233,10 @@ int Z3_ast_compare_ext(value v1, value v2) {
|
|||
|
||||
intnat Z3_ast_hash(value v) {
|
||||
Z3_ast_plus * ap = (Z3_ast_plus*)Data_custom_val(v);
|
||||
return Z3_get_ast_hash(ap->cp->ctx, ap->a);
|
||||
if (ap->p == NULL)
|
||||
return 0;
|
||||
else
|
||||
return Z3_get_ast_hash(ap->cp->ctx, ap->p);
|
||||
}
|
||||
|
||||
static struct custom_operations Z3_ast_plus_custom_ops = {
|
||||
|
|
@ -215,9 +251,6 @@ static struct custom_operations Z3_ast_plus_custom_ops = {
|
|||
|
||||
MK_CTX_OF(ast)
|
||||
|
||||
|
||||
|
||||
|
||||
#define MK_PLUS_OBJ_NO_REF(X) \
|
||||
typedef struct { \
|
||||
Z3_context_plus cp; \
|
||||
|
|
@ -241,7 +274,7 @@ MK_CTX_OF(ast)
|
|||
pp->cp->obj_count--; \
|
||||
try_to_delete_context(pp->cp); \
|
||||
} \
|
||||
\
|
||||
\
|
||||
static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \
|
||||
(char*) "Z3_" #X " ops", \
|
||||
Z3_ ## X ## _finalize, \
|
||||
|
|
@ -265,7 +298,8 @@ MK_CTX_OF(ast)
|
|||
r.cp = cp; \
|
||||
r.p = p; \
|
||||
r.cp->obj_count++; \
|
||||
Z3_ ## X ## _inc_ref(cp->ctx, p); \
|
||||
if (p != NULL) \
|
||||
Z3_ ## X ## _inc_ref(cp->ctx, p); \
|
||||
return r; \
|
||||
} \
|
||||
\
|
||||
|
|
@ -275,7 +309,8 @@ MK_CTX_OF(ast)
|
|||
\
|
||||
void Z3_ ## X ## _finalize(value v) { \
|
||||
Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \
|
||||
Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \
|
||||
if (pp->p != NULL) \
|
||||
Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \
|
||||
pp->cp->obj_count--; \
|
||||
try_to_delete_context(pp->cp); \
|
||||
} \
|
||||
|
|
@ -292,8 +327,6 @@ MK_CTX_OF(ast)
|
|||
\
|
||||
MK_CTX_OF(X)
|
||||
|
||||
|
||||
|
||||
MK_PLUS_OBJ_NO_REF(symbol)
|
||||
MK_PLUS_OBJ_NO_REF(constructor)
|
||||
MK_PLUS_OBJ_NO_REF(constructor_list)
|
||||
|
|
@ -319,19 +352,6 @@ MK_PLUS_OBJ(optimize)
|
|||
extern "C" {
|
||||
#endif
|
||||
|
||||
CAMLprim DLL_PUBLIC value n_is_null(value p) {
|
||||
void * t = * (void**) Data_custom_val(p);
|
||||
return Val_bool(t == 0);
|
||||
}
|
||||
|
||||
CAMLprim DLL_PUBLIC value n_mk_null( void ) {
|
||||
CAMLparam0();
|
||||
CAMLlocal1(result);
|
||||
result = caml_alloc(1, 0);
|
||||
result = Val_int(0);
|
||||
CAMLreturn (result);
|
||||
}
|
||||
|
||||
void MLErrorHandler(Z3_context c, Z3_error_code e)
|
||||
{
|
||||
/* Internal do-nothing error handler. This is required to avoid that Z3 calls exit()
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue