diff --git a/examples/ml/ml_example.ml b/examples/ml/ml_example.ml
index 5b1c05069..bab0ba2fc 100644
--- a/examples/ml/ml_example.ml
+++ b/examples/ml/ml_example.ml
@@ -190,9 +190,10 @@ let basic_tests ( ctx : context ) =
(* Error handling test. *)
try (
let i = Integer.mk_numeral_s ctx "1/2" in
- raise (TestFailedException (numeral_to_string i)) (* unreachable *)
+ Printf.printf "%s\n" (Expr.to_string i) ;
+ raise (TestFailedException "check")
)
- with Z3native.Exception(_) -> (
+ with Z3.Error(_) -> (
Printf.printf "Exception caught, OK.\n"
)
@@ -342,7 +343,7 @@ let _ =
);
Printf.printf "Exiting.\n" ;
exit 0
- ) with Z3native.Exception(msg) -> (
+ ) with Error(msg) -> (
Printf.printf "Z3 EXCEPTION: %s\n" msg ;
exit 1
)
diff --git a/scripts/mk_make.py b/scripts/mk_make.py
index 813cd3a66..8cd9f3a7d 100644
--- a/scripts/mk_make.py
+++ b/scripts/mk_make.py
@@ -19,5 +19,3 @@ mk_bindings(API_files)
mk_vs_proj('z3', ['shell'])
mk_vs_proj_dll('libz3', ['api_dll'])
mk_makefile()
-
-
diff --git a/scripts/mk_util.py b/scripts/mk_util.py
index 38bf2a854..a73a0e59c 100644
--- a/scripts/mk_util.py
+++ b/scripts/mk_util.py
@@ -69,6 +69,7 @@ IS_LINUX=False
IS_OSX=False
IS_FREEBSD=False
IS_OPENBSD=False
+IS_CYGWIN=False
VERBOSE=True
DEBUG_MODE=False
SHOW_CPPS = True
@@ -139,6 +140,9 @@ def is_openbsd():
def is_osx():
return IS_OSX
+def is_cygwin():
+ return IS_CYGWIN
+
def norm_path(p):
# We use '/' on mk_project for convenience
return os.path.join(*(p.split('/')))
@@ -591,6 +595,8 @@ elif os.name == 'posix':
IS_FREEBSD=True
elif os.uname()[0] == 'OpenBSD':
IS_OPENBSD=True
+ elif os.uname()[0][:6] == 'CYGWIN':
+ IS_CYGWIN=True
def display_help(exit_code):
print("mk_make.py: Z3 Makefile generator\n")
@@ -1691,6 +1697,8 @@ class JavaDLLComponent(Component):
t = t.replace('PLATFORM', 'freebsd')
elif IS_OPENBSD:
t = t.replace('PLATFORM', 'openbsd')
+ elif IS_CYGWIN:
+ t = t.replace('PLATFORM', 'cygwin')
else:
t = t.replace('PLATFORM', 'win32')
out.write(t)
@@ -1808,6 +1816,16 @@ class MLComponent(Component):
def mk_makefile(self, out):
if is_ml_enabled():
+ CP_CMD = 'cp'
+ if IS_WINDOWS:
+ CP_CMD='copy'
+
+ OCAML_FLAGS = ''
+ if DEBUG_MODE:
+ OCAML_FLAGS += '-g'
+ OCAMLCF = OCAMLC + ' ' + OCAML_FLAGS
+ OCAMLOPTF = OCAMLOPT + ' ' + OCAML_FLAGS
+
src_dir = self.to_src_dir
mk_dir(os.path.join(BUILD_DIR, self.sub_dir))
api_src = get_component(API_COMPONENT).to_src_dir
@@ -1824,51 +1842,52 @@ class MLComponent(Component):
os.path.join(BUILD_DIR, self.sub_dir, 'META'),
substitutions)
- mlis = ''
- for m in self.modules:
- mlis = os.path.join(src_dir, m) + '.mli ' + mlis
-
stubsc = os.path.join(src_dir, self.stubs + '.c')
stubso = os.path.join(self.sub_dir, self.stubs) + '$(OBJ_EXT)'
z3dllso = get_component(Z3_DLL_COMPONENT).dll_name + '$(SO_EXT)'
out.write('%s: %s %s\n' % (stubso, stubsc, z3dllso))
out.write('\t%s -ccopt "$(CXXFLAGS_OCAML) -I %s -I %s -I %s $(CXX_OUT_FLAG)%s" -c %s\n' %
- (OCAMLC, OCAML_LIB, api_src, src_dir, stubso, stubsc))
-
- cmis = ''
- for m in self.modules:
- ff = os.path.join(src_dir, m + '.mli')
- ft = os.path.join(self.sub_dir, m + '.cmi')
- out.write('%s: %s\n' % (ft, cmis))
- out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLC, self.sub_dir, ft, ff))
- cmis = cmis + ' ' + ft
+ (OCAMLCF, OCAML_LIB, api_src, src_dir, stubso, stubsc))
cmos = ''
for m in self.modules:
- ff = os.path.join(src_dir, m + '.ml')
- ft = os.path.join(self.sub_dir, m + '.cmo')
- fd = os.path.join(self.sub_dir, m + '.cmi')
- out.write('%s: %s %s\n' % (ft, ff, fd))
- out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLC, self.sub_dir, ft, ff))
- cmos = cmos + ' ' + ft
+ ml = os.path.join(src_dir, m + '.ml')
+ cmo = os.path.join(self.sub_dir, m + '.cmo')
+ existing_mli = os.path.join(src_dir, m + '.mli')
+ mli = os.path.join(self.sub_dir, m + '.mli')
+ cmi = os.path.join(self.sub_dir, m + '.cmi')
+ out.write('%s: %s %s\n' % (cmo, ml, cmos))
+ if (os.path.exists(existing_mli[3:])):
+ out.write('\t%s %s %s\n' % (CP_CMD, existing_mli, mli))
+ else:
+ out.write('\t%s -i -I %s -c %s > %s\n' % (OCAMLCF, self.sub_dir, ml, mli))
+ out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLCF, self.sub_dir, cmi, mli))
+ out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLCF, self.sub_dir, cmo, ml))
+ cmos = cmos + cmo + ' '
cmxs = ''
for m in self.modules:
ff = os.path.join(src_dir, m + '.ml')
ft = os.path.join(self.sub_dir, m + '.cmx')
- fd = os.path.join(self.sub_dir, m + '.cmi')
- out.write('%s: %s %s\n' % (ft, ff, fd))
- out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLOPT, self.sub_dir, ft, ff))
+ out.write('%s: %s %s\n' % (ft, ff, cmos))
+ out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLOPTF, self.sub_dir, ft, ff))
cmxs = cmxs + ' ' + ft
+ OCAMLMKLIB = 'ocamlmklib'
+ LIBZ3 = '-L. -lz3'
+ if is_cygwin():
+ # Some ocamlmklib's don't like -g; observed on cygwin, but may be others as well.
+ LIBZ3 = 'libz3.dll'
+ elif DEBUG_MODE:
+ OCAMLMKLIB += ' -g'
z3mls = os.path.join(self.sub_dir, 'z3ml')
out.write('%s.cma: %s %s %s\n' % (z3mls, cmos, stubso, z3dllso))
- out.write('\tocamlmklib -o %s -I %s %s %s -L. -lz3\n' % (z3mls, self.sub_dir, stubso, cmos))
+ out.write('\t%s -o %s -I %s %s %s %s\n' % (OCAMLMKLIB, z3mls, self.sub_dir, stubso, cmos, LIBZ3))
out.write('%s.cmxa: %s %s %s\n' % (z3mls, cmxs, stubso, z3dllso))
- out.write('\tocamlmklib -o %s -I %s %s %s -L. -lz3\n' % (z3mls, self.sub_dir, stubso, cmxs))
+ out.write('\t%s -o %s -I %s %s %s %s\n' % (OCAMLMKLIB, z3mls, self.sub_dir, stubso, cmxs, LIBZ3))
out.write('%s.cmxs: %s.cmxa\n' % (z3mls, z3mls))
- out.write('\t%s -shared -o %s.cmxs -I %s %s.cmxa\n' % (OCAMLOPT, z3mls, self.sub_dir, z3mls))
+ out.write('\t%s -shared -o %s.cmxs -I %s %s.cmxa\n' % (OCAMLOPTF, z3mls, self.sub_dir, z3mls))
out.write('\n')
out.write('ml: %s.cma %s.cmxa %s.cmxs\n' % (z3mls, z3mls, z3mls))
@@ -1911,7 +1930,11 @@ class MLComponent(Component):
metafile=os.path.join(self.sub_dir, 'META')))
for m in self.modules:
- out.write(' ' + os.path.join(self.to_src_dir, m) + '.mli')
+ mli = os.path.join(self.src_dir, m) + '.mli'
+ if os.path.exists(mli):
+ out.write(' ' + os.path.join(self.to_src_dir, m) + '.mli')
+ else:
+ out.write(' ' + os.path.join(self.sub_dir, m) + '.mli')
out.write(' ' + os.path.join(self.sub_dir, m) + '.cmi')
out.write(' ' + os.path.join(self.sub_dir, m) + '.cmx')
out.write(' %s' % ((os.path.join(self.sub_dir, 'libz3ml$(LIB_EXT)'))))
@@ -2863,78 +2886,78 @@ def mk_z3consts_ml(api_files):
efile.close()
if VERBOSE:
print ('Generated "%s/z3enums.ml"' % ('%s' % gendir))
- efile = open('%s.mli' % os.path.join(gendir, "z3enums"), 'w')
- efile.write('(* Automatically generated file *)\n\n')
- efile.write('(** The enumeration types of Z3. *)\n\n')
- for api_file in api_files:
- api_file_c = ml.find_file(api_file, ml.name)
- api_file = os.path.join(api_file_c.src_dir, api_file)
+ # efile = open('%s.mli' % os.path.join(gendir, "z3enums"), 'w')
+ # efile.write('(* Automatically generated file *)\n\n')
+ # efile.write('(** The enumeration types of Z3. *)\n\n')
+ # for api_file in api_files:
+ # api_file_c = ml.find_file(api_file, ml.name)
+ # api_file = os.path.join(api_file_c.src_dir, api_file)
- api = open(api_file, 'r')
+ # api = open(api_file, 'r')
- SEARCHING = 0
- FOUND_ENUM = 1
- IN_ENUM = 2
+ # SEARCHING = 0
+ # FOUND_ENUM = 1
+ # IN_ENUM = 2
- mode = SEARCHING
- decls = {}
- idx = 0
+ # mode = SEARCHING
+ # decls = {}
+ # idx = 0
- linenum = 1
- for line in api:
- m1 = blank_pat.match(line)
- m2 = comment_pat.match(line)
- if m1 or m2:
- # skip blank lines and comments
- linenum = linenum + 1
- elif mode == SEARCHING:
- m = typedef_pat.match(line)
- if m:
- mode = FOUND_ENUM
- m = typedef2_pat.match(line)
- if m:
- mode = IN_ENUM
- decls = {}
- idx = 0
- elif mode == FOUND_ENUM:
- m = openbrace_pat.match(line)
- if m:
- mode = IN_ENUM
- decls = {}
- idx = 0
- else:
- assert False, "Invalid %s, line: %s" % (api_file, linenum)
- else:
- assert mode == IN_ENUM
- words = re.split('[^\-a-zA-Z0-9_]+', line)
- m = closebrace_pat.match(line)
- if m:
- name = words[1]
- if name not in DeprecatedEnums:
- efile.write('(** %s *)\n' % name[3:])
- efile.write('type %s =\n' % name[3:]) # strip Z3_
- for k, i in decls.items():
- efile.write(' | %s \n' % k[3:]) # strip Z3_
- efile.write('\n')
- efile.write('(** Convert %s to int*)\n' % name[3:])
- efile.write('val int_of_%s : %s -> int\n' % (name[3:], name[3:])) # strip Z3_
- efile.write('(** Convert int to %s*)\n' % name[3:])
- efile.write('val %s_of_int : int -> %s\n' % (name[3:],name[3:])) # strip Z3_
- efile.write('\n')
- mode = SEARCHING
- else:
- if words[2] != '':
- if len(words[2]) > 1 and words[2][1] == 'x':
- idx = int(words[2], 16)
- else:
- idx = int(words[2])
- decls[words[1]] = idx
- idx = idx + 1
- linenum = linenum + 1
- api.close()
- efile.close()
- if VERBOSE:
- print ('Generated "%s/z3enums.mli"' % ('%s' % gendir))
+ # linenum = 1
+ # for line in api:
+ # m1 = blank_pat.match(line)
+ # m2 = comment_pat.match(line)
+ # if m1 or m2:
+ # # skip blank lines and comments
+ # linenum = linenum + 1
+ # elif mode == SEARCHING:
+ # m = typedef_pat.match(line)
+ # if m:
+ # mode = FOUND_ENUM
+ # m = typedef2_pat.match(line)
+ # if m:
+ # mode = IN_ENUM
+ # decls = {}
+ # idx = 0
+ # elif mode == FOUND_ENUM:
+ # m = openbrace_pat.match(line)
+ # if m:
+ # mode = IN_ENUM
+ # decls = {}
+ # idx = 0
+ # else:
+ # assert False, "Invalid %s, line: %s" % (api_file, linenum)
+ # else:
+ # assert mode == IN_ENUM
+ # words = re.split('[^\-a-zA-Z0-9_]+', line)
+ # m = closebrace_pat.match(line)
+ # if m:
+ # name = words[1]
+ # if name not in DeprecatedEnums:
+ # efile.write('(** %s *)\n' % name[3:])
+ # efile.write('type %s =\n' % name[3:]) # strip Z3_
+ # for k, i in decls.items():
+ # efile.write(' | %s \n' % k[3:]) # strip Z3_
+ # efile.write('\n')
+ # efile.write('(** Convert %s to int*)\n' % name[3:])
+ # efile.write('val int_of_%s : %s -> int\n' % (name[3:], name[3:])) # strip Z3_
+ # efile.write('(** Convert int to %s*)\n' % name[3:])
+ # efile.write('val %s_of_int : int -> %s\n' % (name[3:],name[3:])) # strip Z3_
+ # efile.write('\n')
+ # mode = SEARCHING
+ # else:
+ # if words[2] != '':
+ # if len(words[2]) > 1 and words[2][1] == 'x':
+ # idx = int(words[2], 16)
+ # else:
+ # idx = int(words[2])
+ # decls[words[1]] = idx
+ # idx = idx + 1
+ # linenum = linenum + 1
+ # api.close()
+ # efile.close()
+ # if VERBOSE:
+ # print ('Generated "%s/z3enums.mli"' % ('%s' % gendir))
def mk_gui_str(id):
return '4D2F40D8-E5F9-473B-B548-%012d' % id
diff --git a/scripts/update_api.py b/scripts/update_api.py
index 7603817eb..a06f1fbb1 100755
--- a/scripts/update_api.py
+++ b/scripts/update_api.py
@@ -78,7 +78,7 @@ Type2Dotnet = { VOID : 'void', VOID_PTR : 'IntPtr', INT : 'int', UINT : 'uint',
# Mapping to Java types
Type2Java = { VOID : 'void', VOID_PTR : 'long', INT : 'int', UINT : 'int', INT64 : 'long', UINT64 : 'long', DOUBLE : 'double',
- FLOAT : 'float', STRING : 'String', STRING_PTR : 'StringPtr',
+ FLOAT : 'float', STRING : 'String', STRING_PTR : 'StringPtr',
BOOL : 'boolean', SYMBOL : 'long', PRINT_MODE : 'int', ERROR_CODE : 'int'}
Type2JavaW = { VOID : 'void', VOID_PTR : 'jlong', INT : 'jint', UINT : 'jint', INT64 : 'jlong', UINT64 : 'jlong', DOUBLE : 'jdouble',
@@ -87,7 +87,7 @@ Type2JavaW = { VOID : 'void', VOID_PTR : 'jlong', INT : 'jint', UINT : 'jint', I
# Mapping to ML types
Type2ML = { VOID : 'unit', VOID_PTR : 'VOIDP', INT : 'int', UINT : 'int', INT64 : 'int', UINT64 : 'int', DOUBLE : 'float',
- FLOAT : 'float', STRING : 'string', STRING_PTR : 'char**',
+ FLOAT : 'float', STRING : 'string', STRING_PTR : 'char**',
BOOL : 'bool', SYMBOL : 'z3_symbol', PRINT_MODE : 'int', ERROR_CODE : 'int' }
next_type_id = FIRST_OBJ_ID
@@ -95,7 +95,7 @@ next_type_id = FIRST_OBJ_ID
def def_Type(var, c_type, py_type):
global next_type_id
exec('%s = %s' % (var, next_type_id), globals())
- Type2Str[next_type_id] = c_type
+ Type2Str[next_type_id] = c_type
Type2PyStr[next_type_id] = py_type
next_type_id = next_type_id + 1
@@ -141,7 +141,11 @@ def type2javaw(ty):
def type2ml(ty):
global Type2ML
- return Type2ML[ty]
+ q = Type2ML[ty]
+ if q[0:3] == 'z3_':
+ return q[3:]
+ else:
+ return q;
def _in(ty):
return (IN, ty)
@@ -261,9 +265,9 @@ def param2ml(p):
else:
return "ptr"
elif k == IN_ARRAY or k == INOUT_ARRAY or k == OUT_ARRAY:
- return "%s array" % type2ml(param_type(p))
+ return "%s list" % type2ml(param_type(p))
elif k == OUT_MANAGED_ARRAY:
- return "%s array" % type2ml(param_type(p))
+ return "%s list" % type2ml(param_type(p))
else:
return type2ml(param_type(p))
@@ -385,7 +389,7 @@ def mk_dotnet(dotnet):
dotnet.write(' }\n')
-NULLWrapped = [ 'Z3_mk_context', 'Z3_mk_context_rc' ]
+NULLWrapped = [ 'Z3_mk_context', 'Z3_mk_context_rc', 'Z3_mk_interpolation_context' ]
Unwrapped = [ 'Z3_del_context', 'Z3_get_error_code' ]
def mk_dotnet_wrappers(dotnet):
@@ -633,18 +637,18 @@ def mk_java(java_dir, package_name):
elif k == IN_ARRAY or k == INOUT_ARRAY:
if param_type(param) == INT or param_type(param) == UINT:
java_wrapper.write(' %s * _a%s = (%s*) jenv->GetIntArrayElements(a%s, NULL);\n' % (type2str(param_type(param)), i, type2str(param_type(param)), i))
- else:
+ else:
java_wrapper.write(' GETLONGAELEMS(%s, a%s, _a%s);\n' % (type2str(param_type(param)), i, i))
elif k == OUT_ARRAY:
- java_wrapper.write(' %s * _a%s = (%s *) malloc(((unsigned)a%s) * sizeof(%s));\n' % (type2str(param_type(param)),
- i,
- type2str(param_type(param)),
- param_array_capacity_pos(param),
+ java_wrapper.write(' %s * _a%s = (%s *) malloc(((unsigned)a%s) * sizeof(%s));\n' % (type2str(param_type(param)),
+ i,
+ type2str(param_type(param)),
+ param_array_capacity_pos(param),
type2str(param_type(param))))
if param_type(param) == INT or param_type(param) == UINT:
java_wrapper.write(' jenv->GetIntArrayRegion(a%s, 0, (jsize)a%s, (jint*)_a%s);\n' % (i, param_array_capacity_pos(param), i))
else:
- java_wrapper.write(' GETLONGAREGION(%s, a%s, 0, a%s, _a%s);\n' % (type2str(param_type(param)), i, param_array_capacity_pos(param), i))
+ java_wrapper.write(' GETLONGAREGION(%s, a%s, 0, a%s, _a%s);\n' % (type2str(param_type(param)), i, param_array_capacity_pos(param), i))
elif k == IN and param_type(param) == STRING:
java_wrapper.write(' Z3_string _a%s = (Z3_string) jenv->GetStringUTFChars(a%s, NULL);\n' % (i, i))
elif k == OUT_MANAGED_ARRAY:
@@ -675,7 +679,7 @@ def mk_java(java_dir, package_name):
java_wrapper.write('(%s)a%i' % (param2str(param), i))
i = i + 1
java_wrapper.write(');\n')
- # cleanup
+ # cleanup
i = 0
for param in params:
k = param_kind(param)
@@ -711,7 +715,7 @@ def mk_java(java_dir, package_name):
if result == STRING:
java_wrapper.write(' return jenv->NewStringUTF(result);\n')
elif result != VOID:
- java_wrapper.write(' return (%s) result;\n' % type2javaw(result))
+ java_wrapper.write(' return (%s) result;\n' % type2javaw(result))
java_wrapper.write('}\n')
java_wrapper.write('#ifdef __cplusplus\n')
java_wrapper.write('}\n')
@@ -941,7 +945,7 @@ def def_API(name, result, params):
error ("unsupported parameter for %s, %s" % (ty, name, p))
elif kind == OUT_ARRAY:
sz = param_array_capacity_pos(p)
- sz_p = params[sz]
+ sz_p = params[sz]
sz_p_k = param_kind(sz_p)
tstr = type2str(ty)
if sz_p_k == OUT or sz_p_k == INOUT:
@@ -1039,11 +1043,115 @@ def arrayparams(params):
op.append(param)
return op
+def ml_plus_type(ts):
+ if ts == 'Z3_context':
+ return 'Z3_context_plus'
+ elif ts == 'Z3_ast' or ts == 'Z3_sort' or ts == 'Z3_func_decl' or ts == 'Z3_app' or ts == 'Z3_pattern':
+ return 'Z3_ast_plus'
+ elif ts == 'Z3_symbol':
+ return 'Z3_symbol_plus'
+ elif ts == 'Z3_constructor':
+ return 'Z3_constructor_plus'
+ elif ts == 'Z3_constructor_list':
+ return 'Z3_constructor_list_plus'
+ elif ts == 'Z3_rcf_num':
+ return 'Z3_rcf_num_plus'
+ elif ts == 'Z3_params':
+ return 'Z3_params_plus'
+ elif ts == 'Z3_param_descrs':
+ return 'Z3_param_descrs_plus'
+ elif ts == 'Z3_model':
+ return 'Z3_model_plus'
+ elif ts == 'Z3_func_interp':
+ return 'Z3_func_interp_plus'
+ elif ts == 'Z3_func_entry':
+ return 'Z3_func_entry_plus'
+ elif ts == 'Z3_goal':
+ return 'Z3_goal_plus'
+ elif ts == 'Z3_tactic':
+ return 'Z3_tactic_plus'
+ elif ts == 'Z3_probe':
+ return 'Z3_probe_plus'
+ elif ts == 'Z3_apply_result':
+ return 'Z3_apply_result_plus'
+ elif ts == 'Z3_solver':
+ return 'Z3_solver_plus'
+ elif ts == 'Z3_stats':
+ return 'Z3_stats_plus'
+ elif ts == 'Z3_ast_vector':
+ return 'Z3_ast_vector_plus'
+ elif ts == 'Z3_ast_map':
+ return 'Z3_ast_map_plus'
+ elif ts == 'Z3_fixedpoint':
+ return 'Z3_fixedpoint_plus'
+ elif ts == 'Z3_optimize':
+ return 'Z3_optimize_plus'
+ else:
+ return ts
+
+def ml_minus_type(ts):
+ if ts == 'Z3_ast' or ts == 'Z3_sort' or ts == 'Z3_func_decl' or ts == 'Z3_app' or ts == 'Z3_pattern':
+ return 'Z3_ast'
+ if ts == 'Z3_ast_plus' or ts == 'Z3_sort_plus' or ts == 'Z3_func_decl_plus' or ts == 'Z3_app_plus' or ts == 'Z3_pattern_plus':
+ return 'Z3_ast'
+ elif ts == 'Z3_constructor_plus':
+ return 'Z3_constructor'
+ elif ts == 'Z3_constructor_list_plus':
+ return 'Z3_constructor_list'
+ elif ts == 'Z3_rcf_num_plus':
+ return 'Z3_rcf_num'
+ elif ts == 'Z3_params_plus':
+ return 'Z3_params'
+ elif ts == 'Z3_param_descrs_plus':
+ return 'Z3_param_descrs'
+ elif ts == 'Z3_model_plus':
+ return 'Z3_model'
+ elif ts == 'Z3_func_interp_plus':
+ return 'Z3_func_interp'
+ elif ts == 'Z3_func_entry_plus':
+ return 'Z3_func_entry'
+ elif ts == 'Z3_goal_plus':
+ return 'Z3_goal'
+ elif ts == 'Z3_tactic_plus':
+ return 'Z3_tactic'
+ elif ts == 'Z3_probe_plus':
+ return 'Z3_probe'
+ elif ts == 'Z3_apply_result_plus':
+ return 'Z3_apply_result'
+ elif ts == 'Z3_solver_plus':
+ return 'Z3_solver'
+ elif ts == 'Z3_stats_plus':
+ return 'Z3_stats'
+ elif ts == 'Z3_ast_vector_plus':
+ return 'Z3_ast_vector'
+ elif ts == 'Z3_ast_map_plus':
+ return 'Z3_ast_map'
+ elif ts == 'Z3_fixedpoint_plus':
+ return 'Z3_fixedpoint'
+ elif ts == 'Z3_optimize_plus':
+ return 'Z3_optimize'
+ else:
+ return ts
+
+def ml_plus_type_raw(ts):
+ if ml_has_plus_type(ts):
+ return ml_plus_type(ts) + '_raw';
+ else:
+ return ts
+
+def ml_plus_ops_type(ts):
+ if ml_has_plus_type(ts):
+ return ml_plus_type(ts) + '_custom_ops'
+ else:
+ return 'default_custom_ops'
+
+def ml_has_plus_type(ts):
+ return ts != ml_plus_type(ts)
def ml_unwrap(t, ts, s):
if t == STRING:
return '(' + ts + ') String_val(' + s + ')'
- elif t == BOOL:
+ elif t == BOOL or (type2str(t) == 'Z3_bool'):
return '(' + ts + ') Bool_val(' + s + ')'
elif t == INT or t == PRINT_MODE or t == ERROR_CODE:
return '(' + ts + ') Int_val(' + s + ')'
@@ -1055,232 +1163,105 @@ def ml_unwrap(t, ts, s):
return '(' + ts + ') Unsigned_long_val(' + s + ')'
elif t == DOUBLE:
return '(' + ts + ') Double_val(' + s + ')'
+ elif ml_has_plus_type(ts):
+ pts = ml_plus_type(ts)
+ return '(' + ts + ') ' + ml_plus_type_raw(ts) + '((' + pts + '*) Data_custom_val(' + s + '))'
else:
- return '* (' + ts + '*) Data_custom_val(' + s + ')'
+ return '* ((' + ts + '*) Data_custom_val(' + s + '))'
def ml_set_wrap(t, d, n):
if t == VOID:
return d + ' = Val_unit;'
- elif t == BOOL:
+ elif t == BOOL or (type2str(t) == 'Z3_bool'):
return d + ' = Val_bool(' + n + ');'
elif t == INT or t == UINT or t == PRINT_MODE or t == ERROR_CODE:
return d + ' = Val_int(' + n + ');'
elif t == INT64 or t == UINT64:
return d + ' = Val_long(' + n + ');'
elif t == DOUBLE:
- return 'Store_double_val(' + d + ', ' + n + ');'
+ return d + '= caml_copy_double(' + n + ');'
elif t == STRING:
return d + ' = caml_copy_string((const char*) ' + n + ');'
else:
- ts = type2str(t)
- return d + ' = caml_alloc_custom(&default_custom_ops, sizeof(' + ts + '), 0, 1); memcpy( Data_custom_val(' + d + '), &' + n + ', sizeof(' + ts + '));'
+ pts = ml_plus_type(type2str(t))
+ return '*(' + pts + '*)Data_custom_val(' + d + ') = ' + n + ';'
+
+def ml_alloc_and_store(t, lhs, rhs):
+ if t == VOID or t == BOOL or t == INT or t == UINT or t == PRINT_MODE or t == ERROR_CODE or t == INT64 or t == UINT64 or t == DOUBLE or t == STRING or (type2str(t) == 'Z3_bool'):
+ return ml_set_wrap(t, lhs, rhs)
+ else:
+ pts = ml_plus_type(type2str(t))
+ pops = ml_plus_ops_type(type2str(t))
+ alloc_str = '%s = caml_alloc_custom(&%s, sizeof(%s), 0, 1); ' % (lhs, pops, pts)
+ return alloc_str + ml_set_wrap(t, lhs, rhs)
def mk_ml(ml_dir):
global Type2Str
ml_nativef = os.path.join(ml_dir, 'z3native.ml')
- ml_nativefi = os.path.join(ml_dir, 'z3native.mli')
- ml_wrapperf = os.path.join(ml_dir, 'z3native_stubs.c')
ml_native = open(ml_nativef, 'w')
- ml_i = open(ml_nativefi, 'w')
ml_native.write('(* Automatically generated file *)\n\n')
- ml_native.write('(** The native (raw) interface to the dynamic Z3 library. *)\n\n')
- ml_i.write('(* Automatically generated file *)\n\n')
- ml_i.write('(** The native (raw) interface to the dynamic Z3 library. *)\n\n')
- ml_i.write('(**/**)\n\n')
- ml_native.write('open Z3enums\n\n')
- ml_native.write('(**/**)\n')
- ml_native.write('type ptr\n')
- ml_i.write('type ptr\n')
- ml_native.write('and z3_symbol = ptr\n')
- ml_i.write('and z3_symbol = ptr\n')
- for k, v in Type2Str.items():
- if is_obj(k):
- ml_native.write('and %s = ptr\n' % v.lower())
- ml_i.write('and %s = ptr\n' % v.lower())
- ml_native.write('\n')
- ml_i.write('\n')
- ml_native.write('external is_null : ptr -> bool\n = "n_is_null"\n\n')
- ml_native.write('external mk_null : unit -> ptr\n = "n_mk_null"\n\n')
- ml_native.write('external set_internal_error_handler : ptr -> unit\n = "n_set_internal_error_handler"\n\n')
- ml_native.write('exception Exception of string\n\n')
- ml_i.write('val is_null : ptr -> bool\n')
- ml_i.write('val mk_null : unit -> ptr\n')
- ml_i.write('val set_internal_error_handler : ptr -> unit\n\n')
- ml_i.write('exception Exception of string\n\n')
- # ML declarations
- ml_native.write('module ML2C = struct\n\n')
+ ml_pref = open(os.path.join(ml_dir, 'z3native.ml.pre'), 'r')
+ for s in ml_pref:
+ ml_native.write(s);
+ ml_pref.close()
+
+ ml_native.write('\n')
for name, result, params in _dotnet_decls:
- ml_native.write(' external n_%s : ' % ml_method_name(name))
- ml_i.write('val %s : ' % ml_method_name(name))
+ ml_native.write('external %s : ' % ml_method_name(name))
ip = inparams(params)
op = outparams(params)
if len(ip) == 0:
ml_native.write(' unit -> ')
- ml_i.write(' unit -> ')
for p in ip:
ml_native.write('%s -> ' % param2ml(p))
- ml_i.write('%s -> ' % param2ml(p))
if len(op) > 0:
ml_native.write('(')
- ml_i.write('(')
first = True
if result != VOID or len(op) == 0:
ml_native.write('%s' % type2ml(result))
- ml_i.write('%s' % type2ml(result))
first = False
for p in op:
if first:
first = False
else:
ml_native.write(' * ')
- ml_i.write(' * ')
ml_native.write('%s' % param2ml(p))
- ml_i.write('%s' % param2ml(p))
if len(op) > 0:
ml_native.write(')')
- ml_i.write(')')
- ml_native.write('\n')
- ml_i.write('\n')
if len(ip) > 5:
- ml_native.write(' = "n_%s_bytecode"\n' % ml_method_name(name))
- ml_native.write(' "n_%s"\n' % ml_method_name(name))
+ ml_native.write(' = "n_%s_bytecode" "n_%s"\n' % (ml_method_name(name), ml_method_name(name)))
else:
- ml_native.write(' = "n_%s"\n' % ml_method_name(name))
+ ml_native.write(' = "n_%s"\n' % ml_method_name(name))
ml_native.write('\n')
- ml_native.write(' end\n\n')
- ml_i.write('\n(**/**)\n')
- # Exception wrappers
- for name, result, params in _dotnet_decls:
- ip = inparams(params)
- op = outparams(params)
- ml_native.write(' let %s ' % ml_method_name(name))
+ # null pointer helpers
+ for type_id in Type2Str:
+ type_name = Type2Str[type_id]
+ if ml_has_plus_type(type_name) and not type_name in ['Z3_context', 'Z3_sort', 'Z3_func_decl', 'Z3_app', 'Z3_pattern']:
+ ml_name = type2ml(type_id)
+ ml_native.write('external context_of_%s : %s -> context = "n_context_of_%s"\n' % (ml_name, ml_name, ml_name))
+ ml_native.write('external is_null_%s : %s -> bool = "n_is_null_%s"\n' % (ml_name, ml_name, ml_name))
+ ml_native.write('external mk_null_%s : context -> %s = "n_mk_null_%s"\n\n' % (ml_name, ml_name, ml_name))
- first = True
- i = 0
- for p in params:
- if is_in_param(p):
- if first:
- first = False
- else:
- ml_native.write(' ')
- ml_native.write('a%d' % i)
- i = i + 1
- if len(ip) == 0:
- ml_native.write('()')
- ml_native.write(' = \n')
- ml_native.write(' ')
- if result == VOID and len(op) == 0:
- ml_native.write('let _ = ')
- else:
- ml_native.write('let res = ')
- ml_native.write('(ML2C.n_%s' % (ml_method_name(name)))
- if len(ip) == 0:
- ml_native.write(' ()')
- first = True
- i = 0
- for p in params:
- if is_in_param(p):
- ml_native.write(' a%d' % i)
- i = i + 1
- ml_native.write(') in\n')
- if name not in Unwrapped and len(params) > 0 and param_type(params[0]) == CONTEXT:
- ml_native.write(' let err = (error_code_of_int (ML2C.n_get_error_code a0)) in \n')
- ml_native.write(' if err <> OK then\n')
- ml_native.write(' raise (Exception (ML2C.n_get_error_msg a0 (int_of_error_code err)))\n')
- ml_native.write(' else\n')
- if result == VOID and len(op) == 0:
- ml_native.write(' ()\n')
- else:
- ml_native.write(' res\n')
- ml_native.write('\n')
ml_native.write('(**/**)\n')
+ ml_native.close()
- # C interface
+ if mk_util.is_verbose():
+ print ('Generated "%s"' % ml_nativef)
+
+ mk_z3native_stubs_c(ml_dir)
+
+def mk_z3native_stubs_c(ml_dir): # C interface
+ ml_wrapperf = os.path.join(ml_dir, 'z3native_stubs.c')
ml_wrapper = open(ml_wrapperf, 'w')
ml_wrapper.write('// Automatically generated file\n\n')
- ml_wrapper.write('#include <stddef.h>\n')
- ml_wrapper.write('#include <string.h>\n\n')
- ml_wrapper.write('#ifdef __cplusplus\n')
- ml_wrapper.write('extern "C" {\n')
- ml_wrapper.write('#endif\n')
- ml_wrapper.write('#include <caml/mlvalues.h>\n')
- ml_wrapper.write('#include <caml/memory.h>\n')
- ml_wrapper.write('#include <caml/alloc.h>\n')
- ml_wrapper.write('#include <caml/fail.h>\n')
- ml_wrapper.write('#include <caml/callback.h>\n')
- ml_wrapper.write('#ifdef Custom_tag\n')
- ml_wrapper.write('#include <caml/custom.h>\n')
- ml_wrapper.write('#include <caml/bigarray.h>\n')
- ml_wrapper.write('#endif\n')
- ml_wrapper.write('#ifdef __cplusplus\n')
- ml_wrapper.write('}\n')
- ml_wrapper.write('#endif\n\n')
- ml_wrapper.write('#include <z3.h>\n')
- ml_wrapper.write('#include <z3native_stubs.h>\n\n')
- ml_wrapper.write('#define CAMLlocal6(X1,X2,X3,X4,X5,X6) \\\n')
- ml_wrapper.write(' CAMLlocal5(X1,X2,X3,X4,X5); \\\n')
- ml_wrapper.write(' CAMLlocal1(X6) \n')
- ml_wrapper.write('#define CAMLlocal7(X1,X2,X3,X4,X5,X6,X7) \\\n')
- ml_wrapper.write(' CAMLlocal5(X1,X2,X3,X4,X5); \\\n')
- ml_wrapper.write(' CAMLlocal2(X6,X7) \n')
- ml_wrapper.write('#define CAMLlocal8(X1,X2,X3,X4,X5,X6,X7,X8) \\\n')
- ml_wrapper.write(' CAMLlocal5(X1,X2,X3,X4,X5); \\\n')
- ml_wrapper.write(' CAMLlocal3(X6,X7,X8) \n')
- ml_wrapper.write('\n')
- ml_wrapper.write('#define CAMLparam7(X1,X2,X3,X4,X5,X6,X7) \\\n')
- ml_wrapper.write(' CAMLparam5(X1,X2,X3,X4,X5); \\\n')
- ml_wrapper.write(' CAMLxparam2(X6,X7) \n')
- ml_wrapper.write('#define CAMLparam8(X1,X2,X3,X4,X5,X6,X7,X8) \\\n')
- ml_wrapper.write(' CAMLparam5(X1,X2,X3,X4,X5); \\\n')
- ml_wrapper.write(' CAMLxparam3(X6,X7,X8) \n')
- ml_wrapper.write('#define CAMLparam9(X1,X2,X3,X4,X5,X6,X7,X8,X9) \\\n')
- ml_wrapper.write(' CAMLparam5(X1,X2,X3,X4,X5); \\\n')
- ml_wrapper.write(' CAMLxparam4(X6,X7,X8,X9) \n')
- ml_wrapper.write('#define CAMLparam12(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12) \\\n')
- ml_wrapper.write(' CAMLparam5(X1,X2,X3,X4,X5); \\\n')
- ml_wrapper.write(' CAMLxparam5(X6,X7,X8,X9,X10); \\\n')
- ml_wrapper.write(' CAMLxparam2(X11,X12) \n')
- ml_wrapper.write('#define CAMLparam13(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13) \\\n')
- ml_wrapper.write(' CAMLparam5(X1,X2,X3,X4,X5); \\\n')
- ml_wrapper.write(' CAMLxparam5(X6,X7,X8,X9,X10); \\\n')
- ml_wrapper.write(' CAMLxparam3(X11,X12,X13) \n')
- ml_wrapper.write('\n\n')
- ml_wrapper.write('static struct custom_operations default_custom_ops = {\n')
- ml_wrapper.write(' (char*) "default handling",\n')
- ml_wrapper.write(' custom_finalize_default,\n')
- ml_wrapper.write(' custom_compare_default,\n')
- ml_wrapper.write(' custom_hash_default,\n')
- ml_wrapper.write(' custom_serialize_default,\n')
- ml_wrapper.write(' custom_deserialize_default\n')
- ml_wrapper.write('};\n\n')
- ml_wrapper.write('#ifdef __cplusplus\n')
- ml_wrapper.write('extern "C" {\n')
- ml_wrapper.write('#endif\n\n')
- ml_wrapper.write('CAMLprim DLL_PUBLIC value n_is_null(value p) {\n')
- ml_wrapper.write(' void * t = * (void**) Data_custom_val(p);\n')
- ml_wrapper.write(' return Val_bool(t == 0);\n')
- ml_wrapper.write('}\n\n')
- ml_wrapper.write('CAMLprim DLL_PUBLIC value n_mk_null( void ) {\n')
- ml_wrapper.write(' CAMLparam0();\n')
- ml_wrapper.write(' CAMLlocal1(result);\n')
- ml_wrapper.write(' void * z3_result = 0;\n')
- ml_wrapper.write(' result = caml_alloc_custom(&default_custom_ops, sizeof(void*), 0, 1);\n')
- ml_wrapper.write(' memcpy( Data_custom_val(result), &z3_result, sizeof(void*));\n')
- ml_wrapper.write(' CAMLreturn (result);\n')
- ml_wrapper.write('}\n\n')
- ml_wrapper.write('void MLErrorHandler(Z3_context c, Z3_error_code e)\n')
- ml_wrapper.write('{\n')
- ml_wrapper.write(' // Internal do-nothing error handler. This is required to avoid that Z3 calls exit()\n')
- ml_wrapper.write(' // upon errors, but the actual error handling is done by throwing exceptions in the\n')
- ml_wrapper.write(' // wrappers below.\n')
- ml_wrapper.write('}\n\n')
- ml_wrapper.write('void DLL_PUBLIC n_set_internal_error_handler(value a0)\n')
- ml_wrapper.write('{\n')
- ml_wrapper.write(' Z3_context _a0 = * (Z3_context*) Data_custom_val(a0);\n')
- ml_wrapper.write(' Z3_set_error_handler(_a0, MLErrorHandler);\n')
- ml_wrapper.write('}\n\n')
+
+ ml_pref = open(os.path.join(ml_dir, 'z3native_stubs.c.pre'), 'r')
+ for s in ml_pref:
+ ml_wrapper.write(s);
+ ml_pref.close()
+
for name, result, params in _dotnet_decls:
ip = inparams(params)
op = outparams(params)
@@ -1288,16 +1269,16 @@ def mk_ml(ml_dir):
ret_size = len(op)
if result != VOID:
ret_size = ret_size + 1
-
+
# Setup frame
- ml_wrapper.write('CAMLprim DLL_PUBLIC value n_%s(' % ml_method_name(name))
+ ml_wrapper.write('CAMLprim DLL_PUBLIC value n_%s(' % ml_method_name(name))
first = True
i = 0
for p in params:
if is_in_param(p):
if first:
first = False
- else:
+ else:
ml_wrapper.write(', ')
ml_wrapper.write('value a%d' % i)
i = i + 1
@@ -1319,61 +1300,86 @@ def mk_ml(ml_dir):
ml_wrapper.write(' CAMLlocal1(result);\n')
else:
c = 0
+ needs_tmp_value = False
for p in params:
if is_out_param(p) or is_array_param(p):
c = c + 1
- ml_wrapper.write(' CAMLlocal%s(result, res_val' % (c+2))
+ needs_tmp_value = needs_tmp_value or param_kind(p) == OUT_ARRAY or param_kind(p) == INOUT_ARRAY
+ if needs_tmp_value:
+ c = c + 1
+ if len(ap) > 0:
+ c = c + 1
+ ml_wrapper.write(' CAMLlocal%s(result, z3rv_val' % (c+2))
for p in params:
if is_out_param(p) or is_array_param(p):
ml_wrapper.write(', _a%s_val' % i)
i = i + 1
+ if needs_tmp_value:
+ ml_wrapper.write(', tmp_val')
+ if len(ap) != 0:
+ ml_wrapper.write(', _iter');
+
ml_wrapper.write(');\n')
- if len(ap) != 0:
+ if len(ap) > 0:
ml_wrapper.write(' unsigned _i;\n')
# declare locals, preprocess arrays, strings, in/out arguments
+ have_context = False
i = 0
for param in params:
- k = param_kind(param)
- if k == OUT_ARRAY:
- ml_wrapper.write(' %s * _a%s = (%s*) malloc(sizeof(%s) * (_a%s));\n' % (
+ if param_type(param) == CONTEXT and i == 0:
+ ml_wrapper.write(' Z3_context_plus ctx_p = *(Z3_context_plus*) Data_custom_val(a' + str(i) + ');\n')
+ ml_wrapper.write(' Z3_context _a0 = ctx_p->ctx;\n')
+ have_context = True
+ else:
+ k = param_kind(param)
+ if k == OUT_ARRAY:
+ ml_wrapper.write(' %s * _a%s = (%s*) malloc(sizeof(%s) * (_a%s));\n' % (
type2str(param_type(param)),
- i,
+ i,
type2str(param_type(param)),
type2str(param_type(param)),
param_array_capacity_pos(param)))
- elif k == OUT_MANAGED_ARRAY:
- ml_wrapper.write(' %s * _a%s = 0;\n' % (type2str(param_type(param)), i))
- elif k == IN_ARRAY or k == INOUT_ARRAY:
- t = param_type(param)
- ts = type2str(t)
- ml_wrapper.write(' %s * _a%s = (%s*) malloc(sizeof(%s) * _a%s);\n' % (ts, i, ts, ts, param_array_capacity_pos(param)))
- elif k == IN:
- t = param_type(param)
- ml_wrapper.write(' %s _a%s = %s;\n' % (type2str(t), i, ml_unwrap(t, type2str(t), 'a' + str(i))))
- elif k == OUT:
- ml_wrapper.write(' %s _a%s;\n' % (type2str(param_type(param)), i))
- elif k == INOUT:
- ml_wrapper.write(' %s _a%s = a%s;\n' % (type2str(param_type(param)), i, i))
+ elif k == OUT_MANAGED_ARRAY:
+ ml_wrapper.write(' %s * _a%s = 0;\n' % (type2str(param_type(param)), i))
+ elif k == IN_ARRAY or k == INOUT_ARRAY:
+ t = param_type(param)
+ ts = type2str(t)
+ ml_wrapper.write(' %s * _a%s = (%s*) malloc(sizeof(%s) * _a%s);\n' % (ts, i, ts, ts, param_array_capacity_pos(param)))
+ elif k == IN:
+ t = param_type(param)
+ ml_wrapper.write(' %s _a%s = %s;\n' % (type2str(t), i, ml_unwrap(t, type2str(t), 'a' + str(i))))
+ elif k == OUT:
+ ml_wrapper.write(' %s _a%s;\n' % (type2str(param_type(param)), i))
+ elif k == INOUT:
+ ml_wrapper.write(' %s _a%s = a%s;\n' % (type2str(param_type(param)), i, i))
i = i + 1
- if result != VOID:
- ml_wrapper.write(' %s z3_result;\n' % type2str(result))
-
i = 0
for param in params:
k = param_kind(param)
if k == IN_ARRAY or k == INOUT_ARRAY:
t = param_type(param)
ts = type2str(t)
- ml_wrapper.write(' for (_i = 0; _i < _a%s; _i++) { _a%s[_i] = %s; }\n' % (param_array_capacity_pos(param), i, ml_unwrap(t, ts, 'Field(a' + str(i) + ', _i)')))
+ ml_wrapper.write(' _iter = a' + str(i) + ';\n')
+ ml_wrapper.write(' for (_i = 0; _i < _a%s; _i++) {\n' % param_array_capacity_pos(param))
+ ml_wrapper.write(' assert(_iter != Val_emptylist);\n')
+ ml_wrapper.write(' _a%s[_i] = %s;\n' % (i, ml_unwrap(t, ts, 'Field(_iter, 0)')))
+ ml_wrapper.write(' _iter = Field(_iter, 1);\n')
+ ml_wrapper.write(' }\n')
+ ml_wrapper.write(' assert(_iter == Val_emptylist);\n\n')
i = i + 1
- # invoke procedure
- ml_wrapper.write(' ')
+ ml_wrapper.write('\n /* invoke Z3 function */\n ')
if result != VOID:
- ml_wrapper.write('z3_result = ')
+ ts = type2str(result)
+ if ml_has_plus_type(ts):
+ ml_wrapper.write('%s z3rv_m = ' % ts)
+ else:
+ ml_wrapper.write('%s z3rv = ' % ts)
+
+ # invoke procedure
ml_wrapper.write('%s(' % name)
i = 0
first = True
@@ -1390,37 +1396,84 @@ def mk_ml(ml_dir):
i = i + 1
ml_wrapper.write(');\n')
+ if have_context and name not in Unwrapped:
+ ml_wrapper.write(' int ec = Z3_get_error_code(ctx_p->ctx);\n')
+ ml_wrapper.write(' if (ec != 0) {\n')
+ ml_wrapper.write(' const char * msg = Z3_get_error_msg(ctx_p->ctx, ec);\n')
+ ml_wrapper.write(' caml_raise_with_string(*caml_named_value("Z3EXCEPTION"), msg);\n')
+ ml_wrapper.write(' }\n')
+
+ if result != VOID:
+ ts = type2str(result)
+ if ml_has_plus_type(ts):
+ pts = ml_plus_type(ts)
+ if name in NULLWrapped:
+ ml_wrapper.write(' %s z3rv = %s_mk(z3rv_m);\n' % (pts, pts))
+ else:
+ ml_wrapper.write(' %s z3rv = %s_mk(ctx_p, (%s) z3rv_m);\n' % (pts, pts, ml_minus_type(ts)))
+
# convert output params
if len(op) > 0:
- if result != VOID:
- ml_wrapper.write(' %s\n' % ml_set_wrap(result, "res_val", "z3_result"))
+ # we have output parameters (i.e. call-by-reference arguments to the Z3 native
+ # code function). Hence, the value returned by the OCaml native wrapper is a tuple
+ # which contains the Z3 native function's return value (if it is non-void) in its
+ # first and the output parameters in the following components.
+
+ ml_wrapper.write('\n /* construct return tuple */\n')
+ ml_wrapper.write(' result = caml_alloc(%s, 0);\n' % ret_size)
+
i = 0
for p in params:
+ pt = param_type(p)
+ ts = type2str(pt)
if param_kind(p) == OUT_ARRAY or param_kind(p) == INOUT_ARRAY:
- ml_wrapper.write(' _a%s_val = caml_alloc(_a%s, 0);\n' % (i, param_array_capacity_pos(p)))
- ml_wrapper.write(' for (_i = 0; _i < _a%s; _i++) { value t; %s Store_field(_a%s_val, _i, t); }\n' % (param_array_capacity_pos(p), ml_set_wrap(param_type(p), 't', '_a' + str(i) + '[_i]'), i))
+ # convert a C-array into an OCaml list and return it
+ ml_wrapper.write('\n _a%s_val = Val_emptylist;\n' % i)
+ ml_wrapper.write(' for (_i = _a%s; _i > 0; _i--) {\n' % param_array_capacity_pos(p))
+ pts = ml_plus_type(ts)
+ pops = ml_plus_ops_type(ts)
+ if ml_has_plus_type(ts):
+ ml_wrapper.write(' %s _a%dp = %s_mk(ctx_p, (%s) _a%d[_i]);\n' % (pts, i, pts, ml_minus_type(ts), i))
+ ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, 'tmp_val', '_a%dp' % i))
+ else:
+ ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, 'tmp_val', '_a%d[_i]' % i))
+ ml_wrapper.write(' _iter = caml_alloc(2,0);\n')
+ ml_wrapper.write(' Store_field(_iter, 0, tmp_val);\n')
+ ml_wrapper.write(' Store_field(_iter, 1, _a%s_val);\n' % i)
+ ml_wrapper.write(' _a%s_val = _iter;\n' % i)
+ ml_wrapper.write(' }\n\n')
elif param_kind(p) == OUT_MANAGED_ARRAY:
- ml_wrapper.write(' %s\n' % ml_set_wrap(param_type(p), "_a" + str(i) + "_val", "_a" + str(i) ))
+ wrp = ml_set_wrap(pt, '_a%d_val' % i, '_a%d' % i)
+ wrp = wrp.replace('*)', '**)')
+ wrp = wrp.replace('_plus', '')
+ ml_wrapper.write(' %s\n' % wrp)
elif is_out_param(p):
- ml_wrapper.write(' %s\n' % ml_set_wrap(param_type(p), "_a" + str(i) + "_val", "_a" + str(i) ))
+ if ml_has_plus_type(ts):
+ pts = ml_plus_type(ts)
+ ml_wrapper.write(' %s _a%dp = %s_mk(ctx_p, (%s) _a%d);\n' % (pts, i, pts, ml_minus_type(ts), i))
+ ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, '_a%d_val' % i, '_a%dp' % i))
+ else:
+ ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, '_a%d_val' % i, '_a%d' % i))
i = i + 1
- # return tuples
- if len(op) == 0:
- ml_wrapper.write(' %s\n' % ml_set_wrap(result, "result", "z3_result"))
- else:
- ml_wrapper.write(' result = caml_alloc(%s, 0);\n' % ret_size)
+ # return tuples
i = j = 0
if result != VOID:
- ml_wrapper.write(' Store_field(result, 0, res_val);\n')
+ ml_wrapper.write(' %s' % ml_alloc_and_store(result, 'z3rv_val', 'z3rv'))
+ ml_wrapper.write(' Store_field(result, 0, z3rv_val);\n')
j = j + 1
for p in params:
if is_out_param(p):
ml_wrapper.write(' Store_field(result, %s, _a%s_val);\n' % (j, i))
j = j + 1
i = i + 1
+ else:
+ # As we have no output parameters, we simply return the result
+ ml_wrapper.write('\n /* construct simple return value */\n')
+ ml_wrapper.write(' %s' % ml_alloc_and_store(result, "result", "z3rv"))
# local array cleanup
+ ml_wrapper.write('\n /* cleanup and return */\n')
i = 0
for p in params:
k = param_kind(p)
@@ -1432,7 +1485,7 @@ def mk_ml(ml_dir):
ml_wrapper.write(' CAMLreturn(result);\n')
ml_wrapper.write('}\n\n')
if len(ip) > 5:
- ml_wrapper.write('CAMLprim DLL_PUBLIC value n_%s_bytecode(value * argv, int argn) {\n' % ml_method_name(name))
+ ml_wrapper.write('CAMLprim DLL_PUBLIC value n_%s_bytecode(value * argv, int argn) {\n' % ml_method_name(name))
ml_wrapper.write(' return n_%s(' % ml_method_name(name))
i = 0
while i < len(ip):
@@ -1446,8 +1499,9 @@ def mk_ml(ml_dir):
ml_wrapper.write('#ifdef __cplusplus\n')
ml_wrapper.write('}\n')
ml_wrapper.write('#endif\n')
+
if mk_util.is_verbose():
- print ('Generated "%s"' % ml_nativef)
+ print ('Generated "%s"' % ml_wrapperf)
# Collect API(...) commands from
def def_APIs(api_files):
@@ -1636,6 +1690,7 @@ def generate_files(api_files,
if java_output_dir:
mk_java(java_output_dir, java_package_name)
+
if ml_output_dir:
mk_ml(ml_output_dir)
diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml
index ccf18a024..bbbb9e74b 100644
--- a/src/api/ml/z3.ml
+++ b/src/api/ml/z3.ml
@@ -7,204 +7,79 @@
open Z3enums
-exception Error = Z3native.Exception
+exception Error of string
+let _ = Callback.register_exception "Z3EXCEPTION" (Error "")
-(* Some helpers. *)
-let null = Z3native.mk_null()
-let is_null o = (Z3native.is_null o)
+type context = Z3native.context
-(* Internal types *)
-type z3_native_context = { m_n_ctx : Z3native.z3_context; m_n_obj_cnt: int; }
-type context = z3_native_context
-
-type z3_native_object = {
- m_ctx : context ;
- mutable m_n_obj : Z3native.ptr ;
- inc_ref : Z3native.z3_context -> Z3native.ptr -> unit;
- dec_ref : Z3native.z3_context -> Z3native.ptr -> unit }
-
-(** Internal stuff *)
-module Internal =
+module Log =
struct
- let dispose_context ctx =
- if ctx.m_n_obj_cnt == 0 then (
- (Z3native.del_context ctx.m_n_ctx)
- ) else (
- Printf.printf "ERROR: NOT DISPOSING CONTEXT (because it still has %d objects alive)\n" ctx.m_n_obj_cnt;
- )
-
- let create_context settings =
- let cfg = Z3native.mk_config () in
- let f e = (Z3native.set_param_value cfg (fst e) (snd e)) in
- (List.iter f settings) ;
- let v = Z3native.mk_context_rc cfg in
- Z3native.del_config(cfg) ;
- Z3native.set_ast_print_mode v (int_of_ast_print_mode PRINT_SMTLIB2_COMPLIANT) ;
- Z3native.set_internal_error_handler v ;
- let res = { m_n_ctx = v; m_n_obj_cnt = 0 } in
- let f = fun o -> dispose_context o in
- Gc.finalise f res;
- res
-
- let context_add1 ctx = ignore (ctx.m_n_obj_cnt = ctx.m_n_obj_cnt + 1)
- let context_sub1 ctx = ignore (ctx.m_n_obj_cnt = ctx.m_n_obj_cnt - 1)
- let context_gno ctx = ctx.m_n_ctx
-
-
- let z3obj_gc o = o.m_ctx
- let z3obj_gnc o = (context_gno o.m_ctx)
-
- let z3obj_gno o = o.m_n_obj
- let z3obj_sno o ctx no =
- (context_add1 ctx) ;
- o.inc_ref (context_gno ctx) no ;
- (
- if not (is_null o.m_n_obj) then
- o.dec_ref (context_gno ctx) o.m_n_obj ;
- (context_sub1 ctx)
- ) ;
- o.m_n_obj <- no
-
- let z3obj_dispose o =
- if not (is_null o.m_n_obj) then
- (
- o.dec_ref (z3obj_gnc o) o.m_n_obj ;
- (context_sub1 (z3obj_gc o))
- ) ;
- o.m_n_obj <- null
-
- let z3obj_create o =
- let f = fun o -> (z3obj_dispose o) in
- Gc.finalise f o
-
- let z3obj_nil_ref x y = ()
-
- let z3_native_object_of_ast_ptr : context -> Z3native.ptr -> z3_native_object = fun ctx no ->
- let res : z3_native_object = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.inc_ref ;
- dec_ref = Z3native.dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
-
-end
-
-open Internal
-
-module Log =
-struct
- let open_ filename = ((lbool_of_int (Z3native.open_log filename)) == L_TRUE)
+ let open_ filename =
+ lbool_of_int (Z3native.open_log filename) = L_TRUE
let close = Z3native.close_log
- let append s = Z3native.append_log s
+ let append = Z3native.append_log
end
module Version =
struct
- let major = let (x, _, _, _) = Z3native.get_version () in x
- let minor = let (_, x, _, _) = Z3native.get_version () in x
- let build = let (_, _, x, _) = Z3native.get_version () in x
- let revision = let (_, _, _, x) = Z3native.get_version () in x
- let to_string =
- let (mj, mn, bld, rev) = Z3native.get_version () in
- string_of_int mj ^ "." ^
- string_of_int mn ^ "." ^
- string_of_int bld ^ "." ^
- string_of_int rev
+ let (major, minor, build, revision) = Z3native.get_version ()
+
+ let to_string =
+ string_of_int major ^ "." ^
+ string_of_int minor ^ "." ^
+ string_of_int build ^ "." ^
+ string_of_int revision
end
-
-let mk_list ( f : int -> 'a ) ( n : int ) =
- let rec mk_list' ( f : int -> 'a ) ( i : int ) ( n : int ) ( tail : 'a list ) : 'a list =
- if (i >= n) then
- tail
+let mk_list f n =
+ let rec mk_list' i accu =
+ if i >= n then
+ List.rev accu
else
- (f i) :: (mk_list' f (i+1) n tail)
+ mk_list' (i + 1) ((f i)::accu)
in
- mk_list' f 0 n []
-
-let list_of_array ( x : _ array ) =
- let f i = (Array.get x i) in
- mk_list f (Array.length x)
-
-let mk_context ( cfg : ( string * string ) list ) =
- create_context cfg
+ mk_list' 0 []
+let mk_context (settings:(string * string) list) =
+ let cfg = Z3native.mk_config () in
+ let f e = Z3native.set_param_value cfg (fst e) (snd e) in
+ List.iter f settings;
+ let res = Z3native.mk_context_rc cfg in
+ Z3native.del_config cfg;
+ Z3native.set_ast_print_mode res (Z3enums.int_of_ast_print_mode PRINT_SMTLIB2_COMPLIANT);
+ Z3native.set_internal_error_handler res;
+ res
module Symbol =
struct
- type symbol = z3_native_object
+ type symbol = Z3native.symbol
+ let gc = Z3native.context_of_symbol
- let create_i ( ctx : context ) ( no : Z3native.ptr ) =
- let res : symbol = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = z3obj_nil_ref ;
- dec_ref = z3obj_nil_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
- let create_s ( ctx : context ) ( no : Z3native.ptr ) =
- let res : symbol = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = z3obj_nil_ref ;
- dec_ref = z3obj_nil_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
+ let kind o = symbol_kind_of_int (Z3native.get_symbol_kind (gc o) o)
+ let is_int_symbol o = kind o = INT_SYMBOL
+ let is_string_symbol o = kind o = STRING_SYMBOL
+ let get_int o = Z3native.get_symbol_int (gc o) o
+ let get_string o = Z3native.get_symbol_string (gc o) o
+ let to_string o =
+ match kind o with
+ | INT_SYMBOL -> string_of_int (Z3native.get_symbol_int (gc o) o)
+ | STRING_SYMBOL -> Z3native.get_symbol_string (gc o) o
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- match (symbol_kind_of_int (Z3native.get_symbol_kind (context_gno ctx) no)) with
- | INT_SYMBOL -> (create_i ctx no)
- | STRING_SYMBOL -> (create_s ctx no)
+ let mk_int = Z3native.mk_int_symbol
+ let mk_string = Z3native.mk_string_symbol
- let gc ( x : symbol ) = (z3obj_gc x)
- let gnc ( x : symbol ) = (z3obj_gnc x)
- let gno ( x : symbol ) = (z3obj_gno x)
-
- let symbol_lton ( a : symbol list ) =
- let f ( e : symbol ) = (gno e) in
- Array.of_list (List.map f a)
-
- let kind ( o : symbol ) = (symbol_kind_of_int (Z3native.get_symbol_kind (gnc o) (gno o)))
- let is_int_symbol ( o : symbol ) = (kind o) == INT_SYMBOL
- let is_string_symbol ( o : symbol ) = (kind o) == STRING_SYMBOL
- let get_int (o : symbol) = Z3native.get_symbol_int (z3obj_gnc o) (z3obj_gno o)
- let get_string (o : symbol ) = Z3native.get_symbol_string (z3obj_gnc o) (z3obj_gno o)
- let to_string ( o : symbol ) =
- match (kind o) with
- | INT_SYMBOL -> (string_of_int (Z3native.get_symbol_int (gnc o) (gno o)))
- | STRING_SYMBOL -> (Z3native.get_symbol_string (gnc o) (gno o))
-
- let mk_int ( ctx : context ) ( i : int ) =
- (create_i ctx (Z3native.mk_int_symbol (context_gno ctx) i))
-
- let mk_string ( ctx : context ) ( s : string ) =
- (create_s ctx (Z3native.mk_string_symbol (context_gno ctx) s))
-
- let mk_ints ( ctx : context ) ( names : int list ) =
- let f elem = mk_int ( ctx : context ) elem in
- (List.map f names)
-
- let mk_strings ( ctx : context ) ( names : string list ) =
- let f elem = mk_string ( ctx : context ) elem in
- (List.map f names)
+ let mk_ints ctx names = List.map (mk_int ctx) names
+ let mk_strings ctx names = List.map (mk_string ctx) names
end
-
module rec AST :
sig
- type ast = z3_native_object
- val context_of_ast : ast -> context
- val nc_of_ast : ast -> Z3native.z3_context
- val ptr_of_ast : ast -> Z3native.ptr
- val ast_of_ptr : context -> Z3native.ptr -> ast
+ type ast = Z3native.ast
+ val gc : ast -> context
module ASTVector :
sig
- type ast_vector = z3_native_object
- val create : context -> Z3native.ptr -> ast_vector
+ type ast_vector = Z3native.ast_vector
val mk_ast_vector : context -> ast_vector
val get_size : ast_vector -> int
val get : ast_vector -> int -> ast
@@ -218,8 +93,7 @@ sig
end
module ASTMap :
sig
- type ast_map = z3_native_object
- val create : context -> Z3native.ptr -> ast_map
+ type ast_map = Z3native.ast_map
val mk_ast_map : context -> ast_map
val contains : ast_map -> ast -> bool
val find : ast_map -> ast -> ast
@@ -244,175 +118,94 @@ sig
val equal : ast -> ast -> bool
val compare : ast -> ast -> int
val translate : ast -> context -> ast
- val unwrap_ast : ast -> Z3native.ptr
- val wrap_ast : context -> Z3native.z3_ast -> ast
-end = struct
- type ast = z3_native_object
+end = struct
+ type ast = Z3native.ast
+ let gc = Z3native.context_of_ast
- let context_of_ast ( x : ast ) = (z3obj_gc x)
- let nc_of_ast ( x : ast ) = (z3obj_gnc x)
- let ptr_of_ast ( x : ast ) = (z3obj_gno x)
-
- let rec ast_of_ptr : context -> Z3native.ptr -> ast = fun ctx no ->
- match (ast_kind_of_int (Z3native.get_ast_kind (context_gno ctx) no)) with
- | FUNC_DECL_AST
- | SORT_AST
- | QUANTIFIER_AST
- | APP_AST
- | NUMERAL_AST
- | VAR_AST -> z3_native_object_of_ast_ptr ctx no
- | UNKNOWN_AST -> raise (Z3native.Exception "Cannot create asts of type unknown")
-
- module ASTVector =
+ module ASTVector =
struct
- type ast_vector = z3_native_object
-
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : ast_vector = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.ast_vector_inc_ref ;
- dec_ref = Z3native.ast_vector_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
- let mk_ast_vector ( ctx : context ) = (create ctx (Z3native.mk_ast_vector (context_gno ctx)))
-
- let get_size ( x : ast_vector ) =
- Z3native.ast_vector_size (z3obj_gnc x) (z3obj_gno x)
+ type ast_vector = Z3native.ast_vector
+ let gc = Z3native.context_of_ast_vector
- let get ( x : ast_vector ) ( i : int ) =
- ast_of_ptr (z3obj_gc x) (Z3native.ast_vector_get (z3obj_gnc x) (z3obj_gno x) i)
+ let mk_ast_vector = Z3native.mk_ast_vector
+ let get_size (x:ast_vector) = Z3native.ast_vector_size (gc x) x
+ let get (x:ast_vector) (i:int) = Z3native.ast_vector_get (gc x) x i
+ let set (x:ast_vector) (i:int) (value:ast) = Z3native.ast_vector_set (gc x) x i value
+ let resize (x:ast_vector) (new_size:int) = Z3native.ast_vector_resize (gc x) x new_size
+ let push (x:ast_vector) (a:ast) = Z3native.ast_vector_push (gc x) x a
+ let translate (x:ast_vector) (to_ctx:context) = Z3native.ast_vector_translate (gc x) x to_ctx
- let set ( x : ast_vector ) ( i : int ) ( value : ast ) =
- Z3native.ast_vector_set (z3obj_gnc x) (z3obj_gno x) i (z3obj_gno value)
-
- let resize ( x : ast_vector ) ( new_size : int ) =
- Z3native.ast_vector_resize (z3obj_gnc x) (z3obj_gno x) new_size
-
- let push ( x : ast_vector ) ( a : ast ) =
- Z3native.ast_vector_push (z3obj_gnc x) (z3obj_gno x) (z3obj_gno a)
-
- let translate ( x : ast_vector ) ( to_ctx : context ) =
- create to_ctx (Z3native.ast_vector_translate (z3obj_gnc x) (z3obj_gno x) (context_gno to_ctx))
-
- let to_list ( x : ast_vector ) =
- let xs = (get_size x) in
- let f i = (get x i) in
+ let to_list (x:ast_vector) =
+ let xs = get_size x in
+ let f i = get x i in
mk_list f xs
- let to_expr_list ( x : ast_vector ) =
- let xs = (get_size x) in
- let f i = (Expr.expr_of_ptr (z3obj_gc x) (z3obj_gno (get x i))) in
+ let to_expr_list (x:ast_vector) =
+ let xs = get_size x in
+ let f i = get x i in
mk_list f xs
-
- let to_string ( x : ast_vector ) =
- Z3native.ast_vector_to_string (z3obj_gnc x) (z3obj_gno x)
+
+ let to_string x = Z3native.ast_vector_to_string (gc x) x
end
module ASTMap =
- struct
- type ast_map = z3_native_object
-
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : ast_map = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.ast_map_inc_ref ;
- dec_ref = Z3native.ast_map_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
- let mk_ast_map ( ctx : context ) = (create ctx (Z3native.mk_ast_map (context_gno ctx)))
+ struct
+ type ast_map = Z3native.ast_map
+ let gc = Z3native.context_of_ast_map
- let astmap_of_ptr ( ctx : context ) ( no : Z3native.ptr ) =
- let res : ast_map = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.ast_map_inc_ref ;
- dec_ref = Z3native.ast_map_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
- let contains ( x : ast_map ) ( key : ast ) =
- Z3native.ast_map_contains (z3obj_gnc x) (z3obj_gno x) (z3obj_gno key)
-
- let find ( x : ast_map ) ( key : ast ) =
- ast_of_ptr (z3obj_gc x) (Z3native.ast_map_find (z3obj_gnc x) (z3obj_gno x) (z3obj_gno key))
-
- let insert ( x : ast_map ) ( key : ast ) ( value : ast ) =
- Z3native.ast_map_insert (z3obj_gnc x) (z3obj_gno x) (z3obj_gno key) (z3obj_gno value)
+ let mk_ast_map = Z3native.mk_ast_map
+ let contains (x:ast_map) (key:ast) = Z3native.ast_map_contains (gc x) x key
+ let find (x:ast_map) (key:ast) = Z3native.ast_map_find (gc x) x key
+ let insert (x:ast_map) (key:ast) (value:ast) = Z3native.ast_map_insert (gc x) x key value
+ let erase (x:ast_map) (key:ast) = Z3native.ast_map_erase (gc x) x key
+ let reset (x:ast_map) = Z3native.ast_map_reset (gc x) x
+ let get_size (x:ast_map) = Z3native.ast_map_size (gc x) x
- let erase ( x : ast_map ) ( key : ast ) =
- Z3native.ast_map_erase (z3obj_gnc x) (z3obj_gno x) (z3obj_gno key)
-
- let reset ( x : ast_map ) =
- Z3native.ast_map_reset (z3obj_gnc x) (z3obj_gno x)
+ let get_keys (x:ast_map) =
+ let av = Z3native.ast_map_keys (gc x) x in
+ ASTVector.to_list av
- let get_size ( x : ast_map ) =
- Z3native.ast_map_size (z3obj_gnc x) (z3obj_gno x)
-
- let get_keys ( x : ast_map ) =
- let av = ASTVector.create (z3obj_gc x) (Z3native.ast_map_keys (z3obj_gnc x) (z3obj_gno x)) in
- (ASTVector.to_list av)
-
- let to_string ( x : ast_map ) =
- Z3native.ast_map_to_string (z3obj_gnc x) (z3obj_gno x)
+ let to_string (x:ast_map) = Z3native.ast_map_to_string (gc x) x
end
- let hash ( x : ast ) = Z3native.get_ast_hash (z3obj_gnc x) (z3obj_gno x)
- let get_id ( x : ast ) = Z3native.get_ast_id (z3obj_gnc x) (z3obj_gno x)
- let get_ast_kind ( x : ast ) = (ast_kind_of_int (Z3native.get_ast_kind (z3obj_gnc x) (z3obj_gno x)))
-
- let is_expr ( x : ast ) =
- match get_ast_kind ( x : ast ) with
- | APP_AST
- | NUMERAL_AST
- | QUANTIFIER_AST
- | VAR_AST -> true
- | _ -> false
-
- let is_app ( x : ast ) = (get_ast_kind x) == APP_AST
- let is_var ( x : ast ) = (get_ast_kind x) == VAR_AST
- let is_quantifier ( x : ast ) = (get_ast_kind x) == QUANTIFIER_AST
- let is_sort ( x : ast ) = (get_ast_kind x) == SORT_AST
- let is_func_decl ( x : ast ) = (get_ast_kind x) == FUNC_DECL_AST
+ let hash (x:ast) = Z3native.get_ast_hash (gc x) x
+ let get_id (x:ast) = Z3native.get_ast_id (gc x) x
+ let get_ast_kind (x:ast) = ast_kind_of_int (Z3native.get_ast_kind (gc x) x)
- let to_string ( x : ast ) = Z3native.ast_to_string (z3obj_gnc x) (z3obj_gno x)
- let to_sexpr ( x : ast ) = Z3native.ast_to_string (z3obj_gnc x) (z3obj_gno x)
+ let is_expr (x:ast) =
+ match get_ast_kind x with
+ | APP_AST
+ | NUMERAL_AST
+ | QUANTIFIER_AST
+ | VAR_AST -> true
+ | _ -> false
+ let is_app (x:ast) = get_ast_kind x = APP_AST
+ let is_var (x:ast) = get_ast_kind x = VAR_AST
+ let is_quantifier (x:ast) = get_ast_kind x = QUANTIFIER_AST
+ let is_sort (x:ast) = get_ast_kind x = SORT_AST
+ let is_func_decl (x:ast) = get_ast_kind x = FUNC_DECL_AST
- let equal ( a : ast ) ( b : ast ) = (a == b) ||
- if (z3obj_gnc a) != (z3obj_gnc b) then
- false
- else
- Z3native.is_eq_ast (z3obj_gnc a) (z3obj_gno a) (z3obj_gno b)
-
- let compare a b =
- if (get_id a) < (get_id b) then -1 else
- if (get_id a) > (get_id b) then 1 else
- 0
-
- let translate ( x : ast ) ( to_ctx : context ) =
- if (z3obj_gnc x) == (context_gno to_ctx) then
+ let to_string (x:ast) = Z3native.ast_to_string (gc x) x
+ let to_sexpr (x:ast) = Z3native.ast_to_string (gc x) x
+
+ (* The built-in equality uses the custom operations of the C layer *)
+ let equal = (=)
+
+ (* The standard comparison uses the custom operations of the C layer *)
+ let compare = Pervasives.compare
+
+ let translate (x:ast) (to_ctx:context) =
+ if gc x = to_ctx then
x
else
- ast_of_ptr to_ctx (Z3native.translate (z3obj_gnc x) (z3obj_gno x) (context_gno to_ctx))
-
- let unwrap_ast ( x : ast ) = (z3obj_gno x)
- let wrap_ast ( ctx : context ) ( ptr : Z3native.ptr ) = ast_of_ptr ctx ptr
+ Z3native.translate (gc x) x to_ctx
end
and Sort :
sig
- type sort = Sort of AST.ast
- val ast_of_sort : Sort.sort -> AST.ast
- val sort_of_ptr : context -> Z3native.ptr -> sort
+ type sort = AST.ast
val gc : sort -> context
- val gnc : sort -> Z3native.ptr
- val gno : sort -> Z3native.ptr
- val sort_lton : sort list -> Z3native.ptr array
- val sort_option_lton : sort option list -> Z3native.ptr array
val equal : sort -> sort -> bool
val get_id : sort -> int
val get_sort_kind : sort -> Z3enums.sort_kind
@@ -421,82 +214,34 @@ sig
val mk_uninterpreted : context -> Symbol.symbol -> sort
val mk_uninterpreted_s : context -> string -> sort
end = struct
- type sort = Sort of AST.ast
+ type sort = Z3native.sort
+ let gc = Z3native.context_of_ast
- let sort_of_ptr : context -> Z3native.ptr -> sort = fun ctx no ->
- if ((Z3enums.ast_kind_of_int (Z3native.get_ast_kind (context_gno ctx) no)) != Z3enums.SORT_AST) then
- raise (Z3native.Exception "Invalid coercion")
- else
- match (sort_kind_of_int (Z3native.get_sort_kind (context_gno ctx) no)) with
- | ARRAY_SORT
- | BOOL_SORT
- | BV_SORT
- | DATATYPE_SORT
- | INT_SORT
- | REAL_SORT
- | UNINTERPRETED_SORT
- | FINITE_DOMAIN_SORT
- | RELATION_SORT
- | RE_SORT
- | SEQ_SORT
- | FLOATING_POINT_SORT
- | ROUNDING_MODE_SORT -> Sort(z3_native_object_of_ast_ptr ctx no)
- | UNKNOWN_SORT -> raise (Z3native.Exception "Unknown sort kind encountered")
+ let equal a b = (a = b) || (gc a = gc b && Z3native.is_eq_sort (gc a) a b)
- let ast_of_sort s = match s with Sort(x) -> x
-
- let gc ( x : sort ) = (match x with Sort(a) -> (z3obj_gc a))
- let gnc ( x : sort ) = (match x with Sort(a) -> (z3obj_gnc a))
- let gno ( x : sort ) = (match x with Sort(a) -> (z3obj_gno a))
-
- let sort_lton ( a : sort list ) =
- let f ( e : sort ) = match e with Sort(a) -> (AST.ptr_of_ast a) in
- Array.of_list (List.map f a)
-
- let sort_option_lton ( a : sort option list ) =
- let f ( e : sort option ) = match e with None -> null | Some(Sort(a)) -> (AST.ptr_of_ast a) in
- Array.of_list (List.map f a)
-
- let equal : sort -> sort -> bool = fun a b ->
- (a == b) ||
- if (gnc a) != (gnc b) then
- false
- else
- (Z3native.is_eq_sort (gnc a) (gno a) (gno b))
-
-
- let get_id ( x : sort ) = Z3native.get_sort_id (gnc x) (gno x)
- let get_sort_kind ( x : sort ) = (sort_kind_of_int (Z3native.get_sort_kind (gnc x) (gno x)))
- let get_name ( x : sort ) = (Symbol.create (gc x) (Z3native.get_sort_name (gnc x) (gno x)))
- let to_string ( x : sort ) = Z3native.sort_to_string (gnc x) (gno x)
-
- let mk_uninterpreted ( ctx : context ) ( s : Symbol.symbol ) =
- let n = (Z3native.mk_uninterpreted_sort (context_gno ctx) (Symbol.gno s)) in
- Sort(z3_native_object_of_ast_ptr ctx n)
-
- let mk_uninterpreted_s ( ctx : context ) ( s : string ) =
- mk_uninterpreted ctx (Symbol.mk_string ( ctx : context ) s)
-end
+ let get_id (x:sort) = Z3native.get_sort_id (gc x) x
+ let get_sort_kind (x:sort) = sort_kind_of_int (Z3native.get_sort_kind (gc x) x)
+ let get_name (x:sort) = Z3native.get_sort_name (gc x) x
+ let to_string (x:sort) = Z3native.sort_to_string (gc x) x
+ let mk_uninterpreted = Z3native.mk_uninterpreted_sort
+ let mk_uninterpreted_s (ctx:context) (s:string) = mk_uninterpreted ctx (Symbol.mk_string ctx s)
+end
and FuncDecl :
-sig
- type func_decl = FuncDecl of AST.ast
- val ast_of_func_decl : FuncDecl.func_decl -> AST.ast
- val func_decl_of_ptr : context -> Z3native.ptr -> func_decl
+sig
+ type func_decl = Z3native.func_decl
val gc : func_decl -> context
- val gnc : func_decl -> Z3native.ptr
- val gno : func_decl -> Z3native.ptr
module Parameter :
sig
type parameter =
- P_Int of int
+ P_Int of int
| P_Dbl of float
| P_Sym of Symbol.symbol
| P_Srt of Sort.sort
| P_Ast of AST.ast
| P_Fdl of func_decl
| P_Rat of string
-
+
val get_kind : parameter -> Z3enums.parameter_kind
val get_int : parameter -> int
val get_float : parameter -> float
@@ -525,29 +270,12 @@ sig
val get_parameters : func_decl -> Parameter.parameter list
val apply : func_decl -> Expr.expr list -> Expr.expr
end = struct
- type func_decl = FuncDecl of AST.ast
-
- let func_decl_of_ptr : context -> Z3native.ptr -> func_decl = fun ctx no ->
- if ((Z3enums.ast_kind_of_int (Z3native.get_ast_kind (context_gno ctx) no)) != Z3enums.FUNC_DECL_AST) then
- raise (Z3native.Exception "Invalid coercion")
- else
- FuncDecl(z3_native_object_of_ast_ptr ctx no)
-
- let ast_of_func_decl f = match f with FuncDecl(x) -> x
-
- let create_ndr ( ctx : context ) ( name : Symbol.symbol ) ( domain : Sort.sort list ) ( range : Sort.sort ) =
- func_decl_of_ptr ctx (Z3native.mk_func_decl (context_gno ctx) (Symbol.gno name) (List.length domain) (Sort.sort_lton domain) (Sort.gno range))
-
- let create_pdr ( ctx : context) ( prefix : string ) ( domain : Sort.sort list ) ( range : Sort.sort ) =
- func_decl_of_ptr ctx (Z3native.mk_fresh_func_decl (context_gno ctx) prefix (List.length domain) (Sort.sort_lton domain) (Sort.gno range))
-
- let gc ( x : func_decl ) = match x with FuncDecl(a) -> (z3obj_gc a)
- let gnc ( x : func_decl ) = match x with FuncDecl(a) -> (z3obj_gnc a)
- let gno ( x : func_decl ) = match x with FuncDecl(a) -> (z3obj_gno a)
+ type func_decl = AST.ast
+ let gc = Z3native.context_of_ast
module Parameter =
- struct
- type parameter =
+ struct
+ type parameter =
| P_Int of int
| P_Dbl of float
| P_Sym of Symbol.symbol
@@ -555,124 +283,104 @@ end = struct
| P_Ast of AST.ast
| P_Fdl of func_decl
| P_Rat of string
-
- let get_kind ( x : parameter ) =
- (match x with
- | P_Int(_) -> PARAMETER_INT
- | P_Dbl(_) -> PARAMETER_DOUBLE
- | P_Sym(_) -> PARAMETER_SYMBOL
- | P_Srt(_) -> PARAMETER_SORT
- | P_Ast(_) -> PARAMETER_AST
- | P_Fdl(_) -> PARAMETER_FUNC_DECL
- | P_Rat(_) -> PARAMETER_RATIONAL)
-
- let get_int ( x : parameter ) =
- match x with
- | P_Int(x) -> x
- | _ -> raise (Z3native.Exception "parameter is not an int")
-
- let get_float ( x : parameter ) =
- match x with
- | P_Dbl(x) -> x
- | _ -> raise (Z3native.Exception "parameter is not a float")
-
- let get_symbol ( x : parameter ) =
- match x with
- | P_Sym(x) -> x
- | _ -> raise (Z3native.Exception "parameter is not a symbol")
-
- let get_sort ( x : parameter ) =
- match x with
- | P_Srt(x) -> x
- | _ -> raise (Z3native.Exception "parameter is not a sort")
- let get_ast ( x : parameter ) =
- match x with
- | P_Ast(x) -> x
- | _ -> raise (Z3native.Exception "parameter is not an ast")
+ let get_kind = function
+ | P_Int _ -> PARAMETER_INT
+ | P_Dbl _ -> PARAMETER_DOUBLE
+ | P_Sym _ -> PARAMETER_SYMBOL
+ | P_Srt _ -> PARAMETER_SORT
+ | P_Ast _ -> PARAMETER_AST
+ | P_Fdl _ -> PARAMETER_FUNC_DECL
+ | P_Rat _ -> PARAMETER_RATIONAL
- let get_func_decl ( x : parameter ) =
- match x with
- | P_Fdl(x) -> x
- | _ -> raise (Z3native.Exception "parameter is not a func_decl")
+ let get_int = function
+ | P_Int x -> x
+ | _ -> raise (Error "parameter is not an int")
- let get_rational ( x : parameter ) =
- match x with
- | P_Rat(x) -> x
- | _ -> raise (Z3native.Exception "parameter is not a rational string")
+ let get_float = function
+ | P_Dbl x -> x
+ | _ -> raise (Error "parameter is not a float")
+
+ let get_symbol = function
+ | P_Sym x -> x
+ | _ -> raise (Error "parameter is not a symbol")
+
+ let get_sort = function
+ | P_Srt x -> x
+ | _ -> raise (Error "parameter is not a sort")
+
+ let get_ast = function
+ | P_Ast x -> x
+ | _ -> raise (Error "parameter is not an ast")
+
+ let get_func_decl = function
+ | P_Fdl x -> x
+ | _ -> raise (Error "parameter is not a func_decl")
+
+ let get_rational = function
+ | P_Rat x -> x
+ | _ -> raise (Error "parameter is not a rational string")
end
- let mk_func_decl ( ctx : context ) ( name : Symbol.symbol ) ( domain : Sort.sort list ) ( range : Sort.sort ) =
- create_ndr ctx name domain range
+ let mk_func_decl (ctx:context) (name:Symbol.symbol) (domain:Sort.sort list) (range:Sort.sort) =
+ Z3native.mk_func_decl ctx name (List.length domain) domain range
- let mk_func_decl_s ( ctx : context ) ( name : string ) ( domain : Sort.sort list ) ( range : Sort.sort ) =
+ let mk_func_decl_s (ctx:context) (name:string) (domain:Sort.sort list) (range:Sort.sort) =
mk_func_decl ctx (Symbol.mk_string ctx name) domain range
- let mk_fresh_func_decl ( ctx : context ) ( prefix : string ) ( domain : Sort.sort list ) ( range : Sort.sort ) =
- create_pdr ctx prefix domain range
+ let mk_fresh_func_decl (ctx:context) (prefix:string) (domain:Sort.sort list) (range:Sort.sort) =
+ Z3native.mk_fresh_func_decl ctx prefix (List.length domain) domain range
- let mk_const_decl ( ctx : context ) ( name : Symbol.symbol ) ( range : Sort.sort ) =
- create_ndr ctx name [] range
+ let mk_const_decl (ctx:context) (name:Symbol.symbol) (range:Sort.sort) =
+ Z3native.mk_func_decl ctx name 0 [] range
- let mk_const_decl_s ( ctx : context ) ( name : string ) ( range : Sort.sort ) =
- create_ndr ctx (Symbol.mk_string ctx name) [] range
+ let mk_const_decl_s (ctx:context) (name:string) (range:Sort.sort) =
+ Z3native.mk_func_decl ctx (Symbol.mk_string ctx name) 0 [] range
- let mk_fresh_const_decl ( ctx : context ) ( prefix : string ) ( range : Sort.sort ) =
- create_pdr ctx prefix [] range
+ let mk_fresh_const_decl (ctx:context) (prefix:string) (range:Sort.sort) =
+ Z3native.mk_fresh_func_decl ctx prefix 0 [] range
+ let equal a b = (a = b) || (gc a = gc b && Z3native.is_eq_func_decl (gc a) a b)
- let equal ( a : func_decl ) ( b : func_decl ) = (a == b) ||
- if (gnc a) != (gnc b) then
- false
- else
- (Z3native.is_eq_func_decl (gnc a) (gno a) (gno b))
+ let to_string (x:func_decl) = Z3native.func_decl_to_string (gc x) x
+ let get_id (x:func_decl) = Z3native.get_func_decl_id (gc x) x
+ let get_arity (x:func_decl) = Z3native.get_arity (gc x) x
+ let get_domain_size (x:func_decl) = Z3native.get_domain_size (gc x) x
- let to_string ( x : func_decl ) = Z3native.func_decl_to_string (gnc x) (gno x)
-
- let get_id ( x : func_decl ) = Z3native.get_func_decl_id (gnc x) (gno x)
-
- let get_arity ( x : func_decl ) = Z3native.get_arity (gnc x) (gno x)
-
- let get_domain_size ( x : func_decl ) = Z3native.get_domain_size (gnc x) (gno x)
-
- let get_domain ( x : func_decl ) =
- let n = (get_domain_size x) in
- let f i = Sort.sort_of_ptr (gc x) (Z3native.get_domain (gnc x) (gno x) i) in
- mk_list f n
-
- let get_range ( x : func_decl ) =
- Sort.sort_of_ptr (gc x) (Z3native.get_range (gnc x) (gno x))
-
- let get_decl_kind ( x : func_decl ) = (decl_kind_of_int (Z3native.get_decl_kind (gnc x) (gno x)))
-
- let get_name ( x : func_decl ) = (Symbol.create (gc x) (Z3native.get_decl_name (gnc x) (gno x)))
-
- let get_num_parameters ( x : func_decl ) = (Z3native.get_decl_num_parameters (gnc x) (gno x))
-
- let get_parameters ( x : func_decl ) =
- let n = (get_num_parameters x) in
- let f i = (match (parameter_kind_of_int (Z3native.get_decl_parameter_kind (gnc x) (gno x) i)) with
- | PARAMETER_INT -> Parameter.P_Int (Z3native.get_decl_int_parameter (gnc x) (gno x) i)
- | PARAMETER_DOUBLE -> Parameter.P_Dbl (Z3native.get_decl_double_parameter (gnc x) (gno x) i)
- | PARAMETER_SYMBOL-> Parameter.P_Sym (Symbol.create (gc x) (Z3native.get_decl_symbol_parameter (gnc x) (gno x) i))
- | PARAMETER_SORT -> Parameter.P_Srt (Sort.sort_of_ptr (gc x) (Z3native.get_decl_sort_parameter (gnc x) (gno x) i))
- | PARAMETER_AST -> Parameter.P_Ast (AST.ast_of_ptr (gc x) (Z3native.get_decl_ast_parameter (gnc x) (gno x) i))
- | PARAMETER_FUNC_DECL -> Parameter.P_Fdl (func_decl_of_ptr (gc x) (Z3native.get_decl_func_decl_parameter (gnc x) (gno x) i))
- | PARAMETER_RATIONAL -> Parameter.P_Rat (Z3native.get_decl_rational_parameter (gnc x) (gno x) i)
- ) in
+ let get_domain (x:func_decl) =
+ let n = get_domain_size x in
+ let f i = Z3native.get_domain (gc x) x i in
mk_list f n
- let apply ( x : func_decl ) ( args : Expr.expr list ) = Expr.expr_of_func_app (gc x) x args
+ let get_range (x:func_decl) = Z3native.get_range (gc x) x
+ let get_decl_kind (x:func_decl) = decl_kind_of_int (Z3native.get_decl_kind (gc x) x)
+ let get_name (x:func_decl) = Z3native.get_decl_name (gc x) x
+ let get_num_parameters (x:func_decl) = Z3native.get_decl_num_parameters (gc x) x
+
+ let get_parameters (x:func_decl) =
+ let n = get_num_parameters x in
+ let f i =
+ match parameter_kind_of_int (Z3native.get_decl_parameter_kind (gc x) x i) with
+ | PARAMETER_INT -> Parameter.P_Int (Z3native.get_decl_int_parameter (gc x) x i)
+ | PARAMETER_DOUBLE -> Parameter.P_Dbl (Z3native.get_decl_double_parameter (gc x) x i)
+ | PARAMETER_SYMBOL-> Parameter.P_Sym (Z3native.get_decl_symbol_parameter (gc x) x i)
+ | PARAMETER_SORT -> Parameter.P_Srt (Z3native.get_decl_sort_parameter (gc x) x i)
+ | PARAMETER_AST -> Parameter.P_Ast (Z3native.get_decl_ast_parameter (gc x) x i)
+ | PARAMETER_FUNC_DECL -> Parameter.P_Fdl (Z3native.get_decl_func_decl_parameter (gc x) x i)
+ | PARAMETER_RATIONAL -> Parameter.P_Rat (Z3native.get_decl_rational_parameter (gc x) x i)
+ in
+ mk_list f n
+
+ let apply (x:func_decl) (args:Expr.expr list) = Expr.expr_of_func_app (gc x) x args
end
-and Params :
+and Params:
sig
- type params = z3_native_object
+ type params = Z3native.params
module ParamDescrs :
sig
- type param_descrs
- val param_descrs_of_ptr : context -> Z3native.ptr -> param_descrs
+ type param_descrs = Z3native.param_descrs
val validate : param_descrs -> params -> unit
val get_kind : param_descrs -> Symbol.symbol -> Z3enums.param_kind
val get_names : param_descrs -> Symbol.symbol list
@@ -689,77 +397,44 @@ sig
val update_param_value : context -> string -> string -> unit
val set_print_mode : context -> Z3enums.ast_print_mode -> unit
end = struct
- type params = z3_native_object
+ type params = Z3native.params
+ let gc = Z3native.context_of_params
- module ParamDescrs =
- struct
- type param_descrs = z3_native_object
+ module ParamDescrs =
+ struct
+ type param_descrs = Z3native.param_descrs
+ let gc = Z3native.context_of_param_descrs
- let param_descrs_of_ptr ( ctx : context ) ( no : Z3native.ptr ) =
- let res : param_descrs = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.param_descrs_inc_ref ;
- dec_ref = Z3native.param_descrs_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
- let validate ( x : param_descrs ) ( p : params ) =
- Z3native.params_validate (z3obj_gnc x) (z3obj_gno p) (z3obj_gno x)
-
- let get_kind ( x : param_descrs ) ( name : Symbol.symbol ) =
- (param_kind_of_int (Z3native.param_descrs_get_kind (z3obj_gnc x) (z3obj_gno x) (Symbol.gno name)))
-
- let get_names ( x : param_descrs ) =
- let n = Z3native.param_descrs_size (z3obj_gnc x) (z3obj_gno x) in
- let f i = Symbol.create (z3obj_gc x) (Z3native.param_descrs_get_name (z3obj_gnc x) (z3obj_gno x) i) in
+ let validate (x:param_descrs) (p:params) = Z3native.params_validate (gc x) p x
+ let get_kind (x:param_descrs) (name:Symbol.symbol) = param_kind_of_int (Z3native.param_descrs_get_kind (gc x) x name)
+
+ let get_names (x:param_descrs) =
+ let n = Z3native.param_descrs_size (gc x) x in
+ let f i = Z3native.param_descrs_get_name (gc x) x i in
mk_list f n
- let get_size ( x : param_descrs ) = Z3native.param_descrs_size (z3obj_gnc x) (z3obj_gno x)
- let to_string ( x : param_descrs ) = Z3native.param_descrs_to_string (z3obj_gnc x) (z3obj_gno x)
+ let get_size (x:param_descrs) = Z3native.param_descrs_size (gc x) x
+ let to_string (x:param_descrs) = Z3native.param_descrs_to_string (gc x) x
end
- let add_bool ( x : params ) ( name : Symbol.symbol ) ( value : bool ) =
- Z3native.params_set_bool (z3obj_gnc x) (z3obj_gno x) (Symbol.gno name) value
-
- let add_int ( x : params ) (name : Symbol.symbol ) ( value : int ) =
- Z3native.params_set_uint (z3obj_gnc x) (z3obj_gno x) (Symbol.gno name) value
-
- let add_float ( x : params ) ( name : Symbol.symbol ) ( value : float ) =
- Z3native.params_set_double (z3obj_gnc x) (z3obj_gno x) (Symbol.gno name) value
+ let add_bool (x:params) (name:Symbol.symbol) (value:bool) = Z3native.params_set_bool (gc x) x name value
+ let add_int (x:params) (name:Symbol.symbol) (value:int) = Z3native.params_set_uint (gc x) x name value
+ let add_float (x:params) (name:Symbol.symbol) (value:float) = Z3native.params_set_double (gc x) x name value
+ let add_symbol (x:params) (name:Symbol.symbol) (value:Symbol.symbol) = Z3native.params_set_symbol (gc x) x name value
+ let mk_params (ctx:context) = Z3native.mk_params ctx
+ let to_string (x:params) = Z3native.params_to_string (gc x) x
- let add_symbol ( x : params ) ( name : Symbol.symbol ) ( value : Symbol.symbol ) =
- Z3native.params_set_symbol (z3obj_gnc x) (z3obj_gno x) (Symbol.gno name) (Symbol.gno value)
-
- let mk_params ( ctx : context ) =
- let res : params = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.params_inc_ref ;
- dec_ref = Z3native.params_dec_ref } in
- (z3obj_sno res ctx (Z3native.mk_params (context_gno ctx))) ;
- (z3obj_create res) ;
- res
-
- let to_string ( x : params ) = Z3native.params_to_string (z3obj_gnc x) (z3obj_gno x)
-
- let update_param_value ( ctx : context ) ( id : string) ( value : string )=
- Z3native.update_param_value (context_gno ctx) id value
-
- let set_print_mode ( ctx : context ) ( value : ast_print_mode ) =
- Z3native.set_ast_print_mode (context_gno ctx) (int_of_ast_print_mode value)
+ let update_param_value (ctx:context) (id:string) (value:string) = Z3native.update_param_value ctx id value
+ let set_print_mode (ctx:context) (value:ast_print_mode) = Z3native.set_ast_print_mode ctx (int_of_ast_print_mode value)
end
(** General expressions (terms) *)
and Expr :
sig
- type expr = Expr of AST.ast
- val expr_of_ptr : context -> Z3native.ptr -> expr
+ type expr = AST.ast
val gc : expr -> context
- val gnc : expr -> Z3native.ptr
- val gno : expr -> Z3native.ptr
- val expr_lton : expr list -> Z3native.ptr array
- val ast_of_expr : expr -> AST.ast
- val expr_of_ast : AST.ast -> expr
+ val ast_of_expr : expr -> AST.ast
+ val expr_of_ast : AST.ast -> expr
val expr_of_func_app : context -> FuncDecl.func_decl -> expr list -> expr
val simplify : expr -> Params.params option -> expr
val get_simplify_help : context -> string
@@ -785,2319 +460,1598 @@ sig
val mk_numeral_string : context -> string -> Sort.sort -> expr
val mk_numeral_int : context -> int -> Sort.sort -> expr
val equal : expr -> expr -> bool
- val apply1 : context -> (Z3native.ptr -> Z3native.ptr -> Z3native.ptr) -> expr -> expr
- val apply2 : context -> (Z3native.ptr -> Z3native.ptr -> Z3native.ptr -> Z3native.ptr) -> expr -> expr -> expr
- val apply3 : context -> (Z3native.ptr -> Z3native.ptr -> Z3native.ptr -> Z3native.ptr -> Z3native.ptr)
- -> expr -> expr -> expr -> expr
- val apply4 : context -> (Z3native.ptr -> Z3native.ptr -> Z3native.ptr -> Z3native.ptr -> Z3native.ptr -> Z3native.ptr)
- -> expr -> expr -> expr -> expr -> expr
val compare : expr -> expr -> int
-end = struct
- type expr = Expr of AST.ast
-
- let gc e = match e with Expr(a) -> (z3obj_gc a)
- let gnc e = match e with Expr(a) -> (z3obj_gnc a)
- let gno e = match e with Expr(a) -> (z3obj_gno a)
+end = struct
+ type expr = AST.ast
+ let gc = Z3native.context_of_ast
- let inc_elist (es : expr list) =
- List.iter (fun e -> match e with Expr(o) -> o.inc_ref (gnc e) o.m_n_obj) es
-
- let dec_elist (es : expr list) =
- List.iter (fun e -> match e with Expr(o) -> o.dec_ref (gnc e) o.m_n_obj) es
-
- let expr_of_ptr : context -> Z3native.ptr -> expr = fun ctx no ->
- let e = z3_native_object_of_ast_ptr ctx no in
- if ast_kind_of_int (Z3native.get_ast_kind (context_gno ctx) no) == QUANTIFIER_AST then
- Expr(e)
+ let expr_of_ast a =
+ let q = Z3enums.ast_kind_of_int (Z3native.get_ast_kind (gc a) a) in
+ if q <> Z3enums.APP_AST && q <> VAR_AST && q <> QUANTIFIER_AST && q <> NUMERAL_AST then
+ raise (Error "Invalid coercion")
else
- let s = Z3native.get_sort (context_gno ctx) no in
- let sk = (sort_kind_of_int (Z3native.get_sort_kind (context_gno ctx) s)) in
- if (Z3native.is_algebraic_number (context_gno ctx) no) then
- Expr(e)
- else if (Z3native.is_numeral_ast (context_gno ctx) no) then
- match sk with
- | REAL_SORT
- | BOOL_SORT
- | ARRAY_SORT
- | BV_SORT
- | ROUNDING_MODE_SORT
- | RELATION_SORT
- | UNINTERPRETED_SORT
- | FLOATING_POINT_SORT
- | INT_SORT
- | DATATYPE_SORT
- | FINITE_DOMAIN_SORT -> Expr(e)
- | _ -> raise (Z3native.Exception "Unsupported numeral object")
- else
- Expr(e)
+ a
- let expr_of_ast a =
- let q = (Z3enums.ast_kind_of_int (Z3native.get_ast_kind (z3obj_gnc a) (z3obj_gno a))) in
- if (q != Z3enums.APP_AST && q != VAR_AST && q != QUANTIFIER_AST && q != NUMERAL_AST) then
- raise (Z3native.Exception "Invalid coercion")
+ let ast_of_expr e = e
+
+ let expr_of_func_app ctx f args =
+ Z3native.mk_app ctx f (List.length args) args
+
+ let simplify (x:expr) (p:Params.params option) =
+ match p with
+ | None -> Z3native.simplify (gc x) x
+ | Some pp -> Z3native.simplify_ex (gc x) x pp
+
+ let get_simplify_help = Z3native.simplify_get_help
+ let get_simplify_parameter_descrs = Z3native.simplify_get_param_descrs
+ let get_func_decl (x:expr) = Z3native.get_app_decl (gc x) x
+ let get_num_args (x:expr) = Z3native.get_app_num_args (gc x) x
+ let get_args (x:expr) =
+ let n = get_num_args x in
+ let f i = Z3native.get_app_arg (gc x) x i in
+ mk_list f n
+
+ let update (x:expr) (args:expr list) =
+ if AST.is_app x && List.length args <> get_num_args x then
+ raise (Error "Number of arguments does not match")
else
- Expr(a)
+ Z3native.update_term (gc x) x (List.length args) args
- let ast_of_expr e = match e with Expr(a) -> a
-
- let expr_lton ( a : expr list ) =
- let f ( e : expr ) = match e with Expr(a) -> (AST.ptr_of_ast a) in
- Array.of_list (List.map f a)
-
- let expr_of_func_app : context -> FuncDecl.func_decl -> expr list -> expr = fun ctx f args ->
- match f with FuncDecl.FuncDecl(fa) ->
- let o = Z3native.mk_app (context_gno ctx) (AST.ptr_of_ast fa) (List.length args) (expr_lton args) in
- expr_of_ptr ctx o
-
- let apply1 ctx f t =
- expr_of_ptr ctx (f (context_gno ctx) (gno t))
-
- let apply2 ctx f t1 t2 =
- expr_of_ptr ctx (f (context_gno ctx) (gno t1) (gno t2))
-
- let apply3 ctx f t1 t2 t3 =
- expr_of_ptr ctx (f (context_gno ctx) (gno t1) (gno t2) (gno t3))
-
- let apply4 ctx f t1 t2 t3 t4 =
- expr_of_ptr ctx (f (context_gno ctx) (gno t1) (gno t2) (gno t3) (gno t4))
-
- let simplify ( x : expr ) ( p : Params.params option ) = match p with
- | None -> expr_of_ptr (Expr.gc x) (Z3native.simplify (gnc x) (gno x))
- | Some pp -> expr_of_ptr (Expr.gc x) (Z3native.simplify_ex (gnc x) (gno x) (z3obj_gno pp))
-
- let get_simplify_help ( ctx : context ) =
- Z3native.simplify_get_help (context_gno ctx)
-
- let get_simplify_parameter_descrs ( ctx : context ) =
- Params.ParamDescrs.param_descrs_of_ptr ctx (Z3native.simplify_get_param_descrs (context_gno ctx))
- let get_func_decl ( x : expr ) = FuncDecl.func_decl_of_ptr (Expr.gc x) (Z3native.get_app_decl (gnc x) (gno x))
-
- let get_num_args ( x : expr ) = Z3native.get_app_num_args (gnc x) (gno x)
-
- let get_args ( x : expr ) = let n = (get_num_args x) in
- let f i = expr_of_ptr (Expr.gc x) (Z3native.get_app_arg (gnc x) (gno x) i) in
- mk_list f n
-
- let update ( x : expr ) ( args : expr list ) =
- if ((AST.is_app (ast_of_expr x)) && (List.length args <> (get_num_args x))) then
- raise (Z3native.Exception "Number of arguments does not match")
+ let substitute (x:expr) (from:expr list) (to_:expr list) =
+ let len = List.length from in
+ if List.length to_ <> len then
+ raise (Error "Argument sizes do not match")
else
- (inc_elist args;
- let r = expr_of_ptr (Expr.gc x) (Z3native.update_term (gnc x) (gno x) (List.length args) (expr_lton args)) in
- dec_elist args;
- r)
-
- let substitute ( x : expr ) from to_ =
- if (List.length from) <> (List.length to_) then
- raise (Z3native.Exception "Argument sizes do not match")
- else
- (inc_elist from;
- inc_elist to_;
- let r = expr_of_ptr (Expr.gc x) (Z3native.substitute (gnc x) (gno x) (List.length from) (expr_lton from) (expr_lton to_)) in
- dec_elist from;
- dec_elist to_;
- r)
-
- let substitute_one ( x : expr ) from to_ =
- substitute ( x : expr ) [ from ] [ to_ ]
-
- let substitute_vars ( x : expr ) to_ =
- (inc_elist to_;
- let r = expr_of_ptr (Expr.gc x) (Z3native.substitute_vars (gnc x) (gno x) (List.length to_) (expr_lton to_)) in
- dec_elist to_;
- r)
-
- let translate ( x : expr ) to_ctx =
- if (Expr.gc x) == to_ctx then
+ Z3native.substitute (gc x) x len from to_
+
+ let substitute_one x from to_ = substitute x [ from ] [ to_ ]
+ let substitute_vars x to_ =
+ Z3native.substitute_vars (gc x) x (List.length to_) to_
+
+ let translate (x:expr) to_ctx =
+ if gc x = to_ctx then
x
else
- expr_of_ptr to_ctx (Z3native.translate (gnc x) (gno x) (context_gno to_ctx))
+ Z3native.translate (gc x) x to_ctx
- let to_string ( x : expr ) = Z3native.ast_to_string (gnc x) (gno x)
+ let to_string (x:expr) = Z3native.ast_to_string (gc x) x
+ let is_numeral (x:expr) = Z3native.is_numeral_ast (gc x) x
+ let is_well_sorted (x:expr) = Z3native.is_well_sorted (gc x) x
+ let get_sort (x:expr) = Z3native.get_sort (gc x) x
+ let is_const (x:expr) =
+ AST.is_app x
+ && get_num_args x = 0
+ && FuncDecl.get_domain_size (get_func_decl x) = 0
- let is_numeral ( x : expr ) = (Z3native.is_numeral_ast (gnc x) (gno x))
-
- let is_well_sorted ( x : expr ) = Z3native.is_well_sorted (gnc x) (gno x)
-
- let get_sort ( x : expr ) = Sort.sort_of_ptr (Expr.gc x) (Z3native.get_sort (gnc x) (gno x))
-
- let is_const ( x : expr ) = (match x with Expr(a) -> (AST.is_app a)) &&
- (get_num_args x) == 0 &&
- (FuncDecl.get_domain_size (get_func_decl x)) == 0
-
- let mk_const ( ctx : context ) ( name : Symbol.symbol ) ( range : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_const (context_gno ctx) (Symbol.gno name) (Sort.gno range))
-
- let mk_const_s ( ctx : context ) ( name : string ) ( range : Sort.sort ) =
- mk_const ctx (Symbol.mk_string ctx name) range
-
- let mk_const_f ( ctx : context ) ( f : FuncDecl.func_decl ) = Expr.expr_of_func_app ctx f []
-
- let mk_fresh_const ( ctx : context ) ( prefix : string ) ( range : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_fresh_const (context_gno ctx) prefix (Sort.gno range))
-
- let mk_app ( ctx : context ) ( f : FuncDecl.func_decl ) ( args : expr list ) = expr_of_func_app ctx f args
-
- let mk_numeral_string ( ctx : context ) ( v : string ) ( ty : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_numeral (context_gno ctx) v (Sort.gno ty))
-
- let mk_numeral_int ( ctx : context ) ( v : int ) ( ty : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_int (context_gno ctx) v (Sort.gno ty))
-
- let equal ( a : expr ) ( b : expr ) = AST.equal (ast_of_expr a) (ast_of_expr b)
-
- let compare a b = AST.compare (ast_of_expr a) (ast_of_expr b)
+ let mk_const (ctx:context) (name:Symbol.symbol) (range:Sort.sort) = Z3native.mk_const ctx name range
+ let mk_const_s (ctx:context) (name:string) (range:Sort.sort) = mk_const ctx (Symbol.mk_string ctx name) range
+ let mk_const_f (ctx:context) (f:FuncDecl.func_decl) = expr_of_func_app ctx f []
+ let mk_fresh_const (ctx:context) (prefix:string) (range:Sort.sort) = Z3native.mk_fresh_const ctx prefix range
+ let mk_app (ctx:context) (f:FuncDecl.func_decl) (args:expr list) = expr_of_func_app ctx f args
+ let mk_numeral_string (ctx:context) (v:string) (ty:Sort.sort) = Z3native.mk_numeral ctx v ty
+ let mk_numeral_int (ctx:context) (v:int) (ty:Sort.sort) = Z3native.mk_int ctx v ty
+ let equal (a:expr) (b:expr) = AST.equal a b
+ let compare (a:expr) (b:expr) = AST.compare a b
end
open FuncDecl
open Expr
-module Boolean =
-struct
- let mk_sort ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_bool_sort (context_gno ctx)))
+module Boolean =
+struct
+ let mk_sort = Z3native.mk_bool_sort
+ let mk_const (ctx:context) (name:Symbol.symbol) = Expr.mk_const ctx name (mk_sort ctx)
+ let mk_const_s (ctx:context) (name:string) = mk_const ctx (Symbol.mk_string ctx name)
+ let mk_true = Z3native.mk_true
+ let mk_false = Z3native.mk_false
+ let mk_val (ctx:context) (value:bool) = if value then mk_true ctx else mk_false ctx
+ let mk_not = Z3native.mk_not
+ let mk_ite = Z3native.mk_ite
+ let mk_iff = Z3native.mk_iff
+ let mk_implies = Z3native.mk_implies
+ let mk_xor = Z3native.mk_xor
- let mk_const ( ctx : context ) ( name : Symbol.symbol ) =
- (Expr.mk_const ctx name (mk_sort ctx))
-
- let mk_const_s ( ctx : context ) ( name : string ) =
- mk_const ctx (Symbol.mk_string ctx name)
+ let mk_and ctx args = Z3native.mk_and ctx (List.length args) args
- let mk_true ( ctx : context ) =
- expr_of_ptr ctx (Z3native.mk_true (context_gno ctx))
+ let mk_or ctx args = Z3native.mk_or ctx (List.length args) args
- let mk_false ( ctx : context ) =
- expr_of_ptr ctx (Z3native.mk_false (context_gno ctx))
+ let mk_eq = Z3native.mk_eq
+ let mk_distinct ctx args = Z3native.mk_distinct ctx (List.length args) args
- let mk_val ( ctx : context ) ( value : bool ) =
- if value then mk_true ctx else mk_false ctx
-
- let mk_not ( ctx : context ) ( a : expr ) = apply1 ctx Z3native.mk_not a
+ let get_bool_value x = lbool_of_int (Z3native.get_bool_value (gc x) x)
- let mk_ite ( ctx : context ) ( t1 : expr ) ( t2 : expr ) ( t3 : expr ) =
- apply3 ctx Z3native.mk_ite t1 t2 t3
-
- let mk_iff ( ctx : context ) ( t1 : expr ) ( t2 : expr ) =
- apply2 ctx Z3native.mk_iff t1 t2
+ let is_bool x =
+ AST.is_expr x
+ && Z3native.is_eq_sort (gc x) (Z3native.mk_bool_sort (gc x)) (Z3native.get_sort (gc x) x)
- let mk_implies ( ctx : context ) ( t1 : expr ) ( t2 : expr ) =
- apply2 ctx Z3native.mk_implies t1 t2
-
- let mk_xor ( ctx : context ) ( t1 : expr ) ( t2 : expr ) =
- apply2 ctx Z3native.mk_xor t1 t2
-
- let mk_and ( ctx : context ) ( args : expr list ) =
- let f x = (Expr.gno (x)) in
- expr_of_ptr ctx (Z3native.mk_and (context_gno ctx) (List.length args) (Array.of_list (List.map f args)))
-
- let mk_or ( ctx : context ) ( args : expr list ) =
- let f x = (Expr.gno (x)) in
- expr_of_ptr ctx (Z3native.mk_or (context_gno ctx) (List.length args) (Array.of_list(List.map f args)))
-
- let mk_eq ( ctx : context ) ( x : expr ) ( y : expr ) =
- apply2 ctx Z3native.mk_eq x y
-
- let mk_distinct ( ctx : context ) ( args : expr list ) =
- expr_of_ptr ctx (Z3native.mk_distinct (context_gno ctx) (List.length args) (expr_lton args))
-
- let get_bool_value ( x : expr ) = lbool_of_int (Z3native.get_bool_value (gnc x) (gno x))
-
- let is_bool ( x : expr ) = (match x with Expr(a) -> (AST.is_expr a)) &&
- (Z3native.is_eq_sort (gnc x)
- (Z3native.mk_bool_sort (gnc x))
- (Z3native.get_sort (gnc x) (gno x)))
-
- let is_true ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_TRUE)
- let is_false ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_FALSE)
- let is_eq ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_EQ)
- let is_distinct ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_DISTINCT)
- let is_ite ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_ITE)
- let is_and ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_AND)
- let is_or ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_OR)
- let is_iff ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_IFF)
- let is_xor ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_XOR)
- let is_not ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_NOT)
- let is_implies ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_IMPLIES)
+ let is_true x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_TRUE
+ let is_false x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_FALSE
+ let is_eq x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_EQ
+ let is_distinct x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_DISTINCT
+ let is_ite x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_ITE
+ let is_and x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_AND
+ let is_or x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_OR
+ let is_iff x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_IFF
+ let is_xor x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_XOR
+ let is_not x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_NOT
+ let is_implies x = AST.is_app x && FuncDecl.get_decl_kind (get_func_decl x) = OP_IMPLIES
end
-module Quantifier =
-struct
- type quantifier = Quantifier of expr
+module Quantifier =
+struct
+ type quantifier = AST.ast
+ let gc = Z3native.context_of_ast
- let expr_of_quantifier e = match e with Quantifier(x) -> x
+ let expr_of_quantifier q = q
let quantifier_of_expr e =
- match e with Expr.Expr(a) ->
- let q = (Z3enums.ast_kind_of_int (Z3native.get_ast_kind (z3obj_gnc a) (z3obj_gno a))) in
- if (q != Z3enums.QUANTIFIER_AST) then
- raise (Z3native.Exception "Invalid coercion")
- else
- Quantifier(e)
-
- let gc ( x : quantifier ) = match (x) with Quantifier(e) -> (Expr.gc e)
- let gnc ( x : quantifier ) = match (x) with Quantifier(e) -> (Expr.gnc e)
- let gno ( x : quantifier ) = match (x) with Quantifier(e) -> (Expr.gno e)
-
- module Pattern =
+ let q = Z3enums.ast_kind_of_int (Z3native.get_ast_kind (gc e) e) in
+ if q <> Z3enums.QUANTIFIER_AST then
+ raise (Error "Invalid coercion")
+ else
+ e
+
+ module Pattern =
struct
- type pattern = Pattern of AST.ast
+ type pattern = Z3native.pattern
+ let gc = Z3native.context_of_ast
- let ast_of_pattern e = match e with Pattern(x) -> x
-
- let pattern_of_ast a =
- (* CMW: Unchecked ok? *)
- Pattern(a)
+ let get_num_terms x = Z3native.get_pattern_num_terms (gc x) x
- let gc ( x : pattern ) = match (x) with Pattern(a) -> (z3obj_gc a)
- let gnc ( x : pattern ) = match (x) with Pattern(a) -> (z3obj_gnc a)
- let gno ( x : pattern ) = match (x) with Pattern(a) -> (z3obj_gno a)
-
- let get_num_terms ( x : pattern ) =
- Z3native.get_pattern_num_terms (gnc x) (gno x)
-
- let get_terms ( x : pattern ) =
- let n = (get_num_terms x) in
- let f i = (expr_of_ptr (gc x) (Z3native.get_pattern (gnc x) (gno x) i)) in
+ let get_terms x =
+ let n = get_num_terms x in
+ let f i = Z3native.get_pattern (gc x) x i in
mk_list f n
- let to_string ( x : pattern ) = Z3native.pattern_to_string (gnc x) (gno x)
+ let to_string x = Z3native.pattern_to_string (gc x) x
end
- let get_index ( x : expr ) =
- if not (AST.is_var (match x with Expr.Expr(a) -> a)) then
- raise (Z3native.Exception "Term is not a bound variable.")
+ let get_index (x:expr) =
+ if not (AST.is_var x) then
+ raise (Error "Term is not a bound variable.")
else
- Z3native.get_index_value (Expr.gnc x) (Expr.gno x)
+ Z3native.get_index_value (gc x) x
- let is_universal ( x : quantifier ) =
- Z3native.is_quantifier_forall (gnc x) (gno x)
-
- let is_existential ( x : quantifier ) = not (is_universal x)
-
- let get_weight ( x : quantifier ) = Z3native.get_quantifier_weight (gnc x) (gno x)
-
- let get_num_patterns ( x : quantifier ) = Z3native.get_quantifier_num_patterns (gnc x) (gno x)
-
- let get_patterns ( x : quantifier ) =
- let n = (get_num_patterns x) in
- let f i = Pattern.Pattern (z3_native_object_of_ast_ptr (gc x) (Z3native.get_quantifier_pattern_ast (gnc x) (gno x) i)) in
+ let is_universal x = Z3native.is_quantifier_forall (gc x) x
+ let is_existential x = not (is_universal x)
+ let get_weight x = Z3native.get_quantifier_weight (gc x) x
+ let get_num_patterns x = Z3native.get_quantifier_num_patterns (gc x) x
+ let get_patterns x =
+ let n = get_num_patterns x in
+ let f i = Z3native.get_quantifier_pattern_ast (gc x) x i in
mk_list f n
-
- let get_num_no_patterns ( x : quantifier ) = Z3native.get_quantifier_num_no_patterns (gnc x) (gno x)
-
- let get_no_patterns ( x : quantifier ) =
- let n = (get_num_patterns x) in
- let f i = Pattern.Pattern (z3_native_object_of_ast_ptr (gc x) (Z3native.get_quantifier_no_pattern_ast (gnc x) (gno x) i)) in
+
+ let get_num_no_patterns x = Z3native.get_quantifier_num_no_patterns (gc x) x
+
+ let get_no_patterns x =
+ let n = get_num_patterns x in
+ let f i = Z3native.get_quantifier_no_pattern_ast (gc x) x i in
mk_list f n
-
- let get_num_bound ( x : quantifier ) = Z3native.get_quantifier_num_bound (gnc x) (gno x)
-
- let get_bound_variable_names ( x : quantifier ) =
- let n = (get_num_bound x) in
- let f i = (Symbol.create (gc x) (Z3native.get_quantifier_bound_name (gnc x) (gno x) i)) in
+
+ let get_num_bound x = Z3native.get_quantifier_num_bound (gc x) x
+
+ let get_bound_variable_names x =
+ let n = get_num_bound x in
+ let f i = Z3native.get_quantifier_bound_name (gc x) x i in
mk_list f n
-
- let get_bound_variable_sorts ( x : quantifier ) =
- let n = (get_num_bound x) in
- let f i = (Sort.sort_of_ptr (gc x) (Z3native.get_quantifier_bound_sort (gnc x) (gno x) i)) in
+
+ let get_bound_variable_sorts x =
+ let n = get_num_bound x in
+ let f i = Z3native.get_quantifier_bound_sort (gc x) x i in
mk_list f n
-
- let get_body ( x : quantifier ) =
- let ctx = gc x in
- expr_of_ptr ctx (Z3native.get_quantifier_body (context_gno ctx) (gno x))
- let mk_bound ( ctx : context ) ( index : int ) ( ty : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_bound (context_gno ctx) index (Sort.gno ty))
+ let get_body x = Z3native.get_quantifier_body (gc x) x
+ let mk_bound = Z3native.mk_bound
- let mk_pattern ( ctx : context ) ( terms : expr list ) =
- if (List.length terms) == 0 then
- raise (Z3native.Exception "Cannot create a pattern from zero terms")
+ let mk_pattern ctx terms =
+ let len = List.length terms in
+ if len = 0 then
+ raise (Error "Cannot create a pattern from zero terms")
else
- Pattern.Pattern(z3_native_object_of_ast_ptr ctx (Z3native.mk_pattern (context_gno ctx) (List.length terms) (expr_lton terms)))
+ Z3native.mk_pattern ctx len terms
- let mk_forall ( ctx : context ) ( sorts : Sort.sort list ) ( names : Symbol.symbol list ) ( body : expr ) ( weight : int option ) ( patterns : Pattern.pattern list ) ( nopatterns : expr list ) ( quantifier_id : Symbol.symbol option ) ( skolem_id : Symbol.symbol option ) =
- if (List.length sorts) != (List.length names) then
- raise (Z3native.Exception "Number of sorts does not match number of names")
- else if ((List.length nopatterns) == 0 && quantifier_id == None && skolem_id == None) then
- Quantifier(expr_of_ptr ctx (Z3native.mk_quantifier (context_gno ctx) true
- (match weight with | None -> 1 | Some(x) -> x)
- (List.length patterns) (let f x = (AST.ptr_of_ast (Pattern.ast_of_pattern x)) in (Array.of_list (List.map f patterns)))
- (List.length sorts) (Sort.sort_lton sorts)
- (Symbol.symbol_lton names)
- (Expr.gno body)))
+ let _internal_mk_quantifier ~universal ctx sorts names body weight patterns nopatterns quantifier_id skolem_id =
+ let len = List.length sorts in
+ if List.length names <> len then
+ raise (Error "Number of sorts does not match number of names")
else
- Quantifier(expr_of_ptr ctx (Z3native.mk_quantifier_ex (context_gno ctx) true
- (match weight with | None -> 1 | Some(x) -> x)
- (match quantifier_id with | None -> null | Some(x) -> (Symbol.gno x))
- (match skolem_id with | None -> null | Some(x) -> (Symbol.gno x))
- (List.length patterns) (let f x = (AST.ptr_of_ast (Pattern.ast_of_pattern x)) in (Array.of_list (List.map f patterns)))
- (List.length nopatterns) (expr_lton nopatterns)
- (List.length sorts) (Sort.sort_lton sorts)
- (Symbol.symbol_lton names)
- (Expr.gno body)))
-
- let mk_forall_const ( ctx : context ) ( bound_constants : expr list ) ( body : expr ) ( weight : int option ) ( patterns : Pattern.pattern list ) ( nopatterns : expr list ) ( quantifier_id : Symbol.symbol option ) ( skolem_id : Symbol.symbol option ) =
- if ((List.length nopatterns) == 0 && quantifier_id == None && skolem_id == None) then
- Quantifier(expr_of_ptr ctx (Z3native.mk_quantifier_const (context_gno ctx) true
- (match weight with | None -> 1 | Some(x) -> x)
- (List.length bound_constants) (expr_lton bound_constants)
- (List.length patterns) (let f x = (AST.ptr_of_ast (Pattern.ast_of_pattern x)) in (Array.of_list (List.map f patterns)))
- (Expr.gno body)))
- else
- Quantifier(expr_of_ptr ctx (Z3native.mk_quantifier_const_ex (context_gno ctx) true
- (match weight with | None -> 1 | Some(x) -> x)
- (match quantifier_id with | None -> null | Some(x) -> (Symbol.gno x))
- (match skolem_id with | None -> null | Some(x) -> (Symbol.gno x))
- (List.length bound_constants) (expr_lton bound_constants)
- (List.length patterns) (let f x = (AST.ptr_of_ast (Pattern.ast_of_pattern x)) in (Array.of_list (List.map f patterns)))
- (List.length nopatterns) (expr_lton nopatterns)
- (Expr.gno body)))
+ match nopatterns, quantifier_id, skolem_id with
+ | [], None, None ->
+ Z3native.mk_quantifier ctx universal
+ (match weight with | None -> 1 | Some x -> x)
+ (List.length patterns) patterns
+ len sorts
+ names body
+ | _ ->
+ Z3native.mk_quantifier_ex ctx universal
+ (match weight with | None -> 1 | Some x -> x)
+ (match quantifier_id with | None -> Z3native.mk_null_symbol ctx | Some x -> x)
+ (match skolem_id with | None -> Z3native.mk_null_symbol ctx | Some x -> x)
+ (List.length patterns) patterns
+ (List.length nopatterns) nopatterns
+ len sorts
+ names body
- let mk_exists ( ctx : context ) ( sorts : Sort.sort list ) ( names : Symbol.symbol list ) ( body : expr ) ( weight : int option ) ( patterns : Pattern.pattern list ) ( nopatterns : expr list ) ( quantifier_id : Symbol.symbol option ) ( skolem_id : Symbol.symbol option ) =
- if (List.length sorts) != (List.length names) then
- raise (Z3native.Exception "Number of sorts does not match number of names")
- else if ((List.length nopatterns) == 0 && quantifier_id == None && skolem_id == None) then
- Quantifier(expr_of_ptr ctx (Z3native.mk_quantifier (context_gno ctx) false
- (match weight with | None -> 1 | Some(x) -> x)
- (List.length patterns) (let f x = (AST.ptr_of_ast (Pattern.ast_of_pattern x)) in (Array.of_list (List.map f patterns)))
- (List.length sorts) (Sort.sort_lton sorts)
- (Symbol.symbol_lton names)
- (Expr.gno body)))
- else
- Quantifier(expr_of_ptr ctx (Z3native.mk_quantifier_ex (context_gno ctx) false
- (match weight with | None -> 1 | Some(x) -> x)
- (match quantifier_id with | None -> null | Some(x) -> (Symbol.gno x))
- (match skolem_id with | None -> null | Some(x) -> (Symbol.gno x))
- (List.length patterns) (let f x = (AST.ptr_of_ast (Pattern.ast_of_pattern x)) in (Array.of_list (List.map f patterns)))
- (List.length nopatterns) (expr_lton nopatterns)
- (List.length sorts) (Sort.sort_lton sorts)
- (Symbol.symbol_lton names)
- (Expr.gno body)))
-
- let mk_exists_const ( ctx : context ) ( bound_constants : expr list ) ( body : expr ) ( weight : int option ) ( patterns : Pattern.pattern list ) ( nopatterns : expr list ) ( quantifier_id : Symbol.symbol option ) ( skolem_id : Symbol.symbol option ) =
- if ((List.length nopatterns) == 0 && quantifier_id == None && skolem_id == None) then
- Quantifier(expr_of_ptr ctx (Z3native.mk_quantifier_const (context_gno ctx) false
- (match weight with | None -> 1 | Some(x) -> x)
- (List.length bound_constants) (expr_lton bound_constants)
- (List.length patterns) (let f x = (AST.ptr_of_ast (Pattern.ast_of_pattern x)) in (Array.of_list (List.map f patterns)))
- (Expr.gno body)))
- else
- Quantifier(expr_of_ptr ctx (Z3native.mk_quantifier_const_ex (context_gno ctx) false
- (match weight with | None -> 1 | Some(x) -> x)
- (match quantifier_id with | None -> null | Some(x) -> (Symbol.gno x))
- (match skolem_id with | None -> null | Some(x) -> (Symbol.gno x))
- (List.length bound_constants) (expr_lton bound_constants)
- (List.length patterns) (let f x = (AST.ptr_of_ast (Pattern.ast_of_pattern x)) in (Array.of_list (List.map f patterns)))
- (List.length nopatterns) (expr_lton nopatterns)
- (Expr.gno body)))
+ let _internal_mk_quantifier_const ~universal ctx bound_constants body weight patterns nopatterns quantifier_id skolem_id =
+ match nopatterns, quantifier_id, skolem_id with
+ | [], None, None ->
+ Z3native.mk_quantifier_const ctx universal
+ (match weight with | None -> 1 | Some x -> x)
+ (List.length bound_constants) bound_constants
+ (List.length patterns) patterns
+ body
+ | _ ->
+ Z3native.mk_quantifier_const_ex ctx universal
+ (match weight with | None -> 1 | Some x -> x)
+ (match quantifier_id with | None -> Z3native.mk_null_symbol ctx | Some x -> x)
+ (match skolem_id with | None -> Z3native.mk_null_symbol ctx | Some x -> x)
+ (List.length bound_constants) bound_constants
+ (List.length patterns) patterns
+ (List.length nopatterns) nopatterns
+ body
- let mk_quantifier ( ctx : context ) ( universal : bool ) ( sorts : Sort.sort list ) ( names : Symbol.symbol list ) ( body : expr ) ( weight : int option ) ( patterns : Pattern.pattern list ) ( nopatterns : expr list ) ( quantifier_id : Symbol.symbol option ) ( skolem_id : Symbol.symbol option ) =
- if (universal) then
- (mk_forall ctx sorts names body weight patterns nopatterns quantifier_id skolem_id)
- else
- (mk_exists ctx sorts names body weight patterns nopatterns quantifier_id skolem_id)
+ let mk_forall = _internal_mk_quantifier ~universal:true
+ let mk_forall_const = _internal_mk_quantifier_const ~universal:true
+ let mk_exists = _internal_mk_quantifier ~universal:false
+ let mk_exists_const = _internal_mk_quantifier_const ~universal:false
- let mk_quantifier ( ctx : context ) ( universal : bool ) ( bound_constants : expr list ) ( body : expr ) ( weight : int option ) ( patterns : Pattern.pattern list ) ( nopatterns : expr list ) ( quantifier_id : Symbol.symbol option ) ( skolem_id : Symbol.symbol option ) =
- if (universal) then
+ let mk_quantifier (ctx:context) (universal:bool) (sorts:Sort.sort list) (names:Symbol.symbol list) (body:expr) (weight:int option) (patterns:Pattern.pattern list) (nopatterns:expr list) (quantifier_id:Symbol.symbol option) (skolem_id:Symbol.symbol option) =
+ if universal then
+ mk_forall ctx sorts names body weight patterns nopatterns quantifier_id skolem_id
+ else
+ mk_exists ctx sorts names body weight patterns nopatterns quantifier_id skolem_id
+
+ let mk_quantifier (ctx:context) (universal:bool) (bound_constants:expr list) (body:expr) (weight:int option) (patterns:Pattern.pattern list) (nopatterns:expr list) (quantifier_id:Symbol.symbol option) (skolem_id:Symbol.symbol option) =
+ if universal then
mk_forall_const ctx bound_constants body weight patterns nopatterns quantifier_id skolem_id
else
mk_exists_const ctx bound_constants body weight patterns nopatterns quantifier_id skolem_id
- let to_string ( x : quantifier ) = (Expr.to_string (expr_of_quantifier x))
+ let to_string x = Expr.to_string x
end
-
-module Z3Array =
+module Z3Array =
struct
- let mk_sort ( ctx : context ) ( domain : Sort.sort ) ( range : Sort.sort ) =
- Sort.sort_of_ptr ctx (Z3native.mk_array_sort (context_gno ctx) (Sort.gno domain) (Sort.gno range))
+ let mk_sort = Z3native.mk_array_sort
+ let is_store x = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_STORE
+ let is_select x = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SELECT
+ let is_constant_array x = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_CONST_ARRAY
+ let is_default_array x = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ARRAY_DEFAULT
+ let is_array_map x = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ARRAY_MAP
+ let is_as_array x = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_AS_ARRAY
- let is_store ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_STORE)
- let is_select ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SELECT)
- let is_constant_array ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_CONST_ARRAY)
- let is_default_array ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ARRAY_DEFAULT)
- let is_array_map ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ARRAY_MAP)
- let is_as_array ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_AS_ARRAY)
- let is_array ( x : expr ) =
- (Z3native.is_app (Expr.gnc x) (Expr.gno x)) &&
- ((sort_kind_of_int (Z3native.get_sort_kind (Expr.gnc x) (Z3native.get_sort (Expr.gnc x) (Expr.gno x)))) == ARRAY_SORT)
+ let is_array x =
+ Z3native.is_app (Expr.gc x) x &&
+ sort_kind_of_int (Z3native.get_sort_kind (Expr.gc x) (Z3native.get_sort (Expr.gc x) x)) = ARRAY_SORT
- let get_domain ( x : Sort.sort ) = Sort.sort_of_ptr (Sort.gc x) (Z3native.get_array_sort_domain (Sort.gnc x) (Sort.gno x))
- let get_range ( x : Sort.sort ) = Sort.sort_of_ptr (Sort.gc x) (Z3native.get_array_sort_range (Sort.gnc x) (Sort.gno x))
+ let get_domain x = Z3native.get_array_sort_domain (Sort.gc x) x
+ let get_range x = Z3native.get_array_sort_range (Sort.gc x) x
- let mk_const ( ctx : context ) ( name : Symbol.symbol ) ( domain : Sort.sort ) ( range : Sort.sort ) =
- (Expr.mk_const ctx name (mk_sort ctx domain range))
-
- let mk_const_s ( ctx : context ) ( name : string ) ( domain : Sort.sort ) ( range : Sort.sort ) =
- mk_const ctx (Symbol.mk_string ctx name) domain range
-
- let mk_select ( ctx : context ) ( a : expr ) ( i : expr ) =
- apply2 ctx Z3native.mk_select a i
+ let mk_const ctx name domain range = Expr.mk_const ctx name (mk_sort ctx domain range)
- let mk_store ( ctx : context ) ( a : expr ) ( i : expr ) ( v : expr ) =
- apply3 ctx Z3native.mk_store a i v
+ let mk_const_s ctx name domain range = mk_const ctx (Symbol.mk_string ctx name) domain range
- let mk_const_array ( ctx : context ) ( domain : Sort.sort ) ( v : expr ) =
- expr_of_ptr ctx (Z3native.mk_const_array (context_gno ctx) (Sort.gno domain) (Expr.gno v))
+ let mk_select = Z3native.mk_select
+ let mk_store = Z3native.mk_store
+ let mk_const_array = Z3native.mk_const_array
- let mk_map ( ctx : context ) ( f : func_decl ) ( args : expr list ) =
- let m x = (Expr.gno x) in
- expr_of_ptr ctx (Z3native.mk_map (context_gno ctx) (FuncDecl.gno f) (List.length args) (Array.of_list (List.map m args)))
+ let mk_map ctx f args =
+ Z3native.mk_map ctx f (List.length args) args
- let mk_term_array ( ctx : context ) ( arg : expr ) =
- apply1 ctx Z3native.mk_array_default arg
-
- let mk_array_ext ( ctx : context) ( arg1 : expr ) ( arg2 : expr ) =
- apply2 ctx Z3native.mk_array_ext arg1 arg2
+ let mk_term_array = Z3native.mk_array_default
+ let mk_array_ext = Z3native.mk_array_ext
end
-module Set =
-struct
- let mk_sort ( ctx : context ) ( ty : Sort.sort ) =
- Sort.sort_of_ptr ctx (Z3native.mk_set_sort (context_gno ctx) (Sort.gno ty))
-
- let is_union ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SET_UNION)
- let is_intersect ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SET_INTERSECT)
- let is_difference ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SET_DIFFERENCE)
- let is_complement ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SET_COMPLEMENT)
- let is_subset ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SET_SUBSET)
-
-
- let mk_empty ( ctx : context ) ( domain : Sort.sort ) =
- (expr_of_ptr ctx (Z3native.mk_empty_set (context_gno ctx) (Sort.gno domain)))
-
- let mk_full ( ctx : context ) ( domain : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_full_set (context_gno ctx) (Sort.gno domain))
-
- let mk_set_add ( ctx : context ) ( set : expr ) ( element : expr ) =
- apply2 ctx Z3native.mk_set_add set element
-
- let mk_del ( ctx : context ) ( set : expr ) ( element : expr ) =
- apply2 ctx Z3native.mk_set_del set element
-
- let mk_union ( ctx : context ) ( args : expr list ) =
- expr_of_ptr ctx (Z3native.mk_set_union (context_gno ctx) (List.length args) (expr_lton args))
-
- let mk_intersection ( ctx : context ) ( args : expr list ) =
- expr_of_ptr ctx (Z3native.mk_set_intersect (context_gno ctx) (List.length args) (expr_lton args))
-
- let mk_difference ( ctx : context ) ( arg1 : expr ) ( arg2 : expr ) =
- apply2 ctx Z3native.mk_set_difference arg1 arg2
-
- let mk_complement ( ctx : context ) ( arg : expr ) =
- apply1 ctx Z3native.mk_set_complement arg
-
- let mk_membership ( ctx : context ) ( elem : expr ) ( set : expr ) =
- apply2 ctx Z3native.mk_set_member elem set
-
- let mk_subset ( ctx : context ) ( arg1 : expr ) ( arg2 : expr ) =
- apply2 ctx Z3native.mk_set_subset arg1 arg2
-
-end
-
-
-module FiniteDomain =
-struct
- let mk_sort ( ctx : context ) ( name : Symbol.symbol ) ( size : int ) =
- Sort.sort_of_ptr ctx (Z3native.mk_finite_domain_sort (context_gno ctx) (Symbol.gno name) size)
-
- let mk_sort_s ( ctx : context ) ( name : string ) ( size : int ) =
- mk_sort ctx (Symbol.mk_string ctx name) size
-
- let is_finite_domain ( x : expr ) =
- let nc = (Expr.gnc x) in
- (Z3native.is_app (Expr.gnc x) (Expr.gno x)) &&
- (sort_kind_of_int (Z3native.get_sort_kind nc (Z3native.get_sort nc (Expr.gno x))) == FINITE_DOMAIN_SORT)
-
- let is_lt ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FD_LT)
-
- let get_size ( x : Sort.sort ) =
- let (r, v) = (Z3native.get_finite_domain_sort_size (Sort.gnc x) (Sort.gno x)) in
- if r then v
- else raise (Z3native.Exception "Conversion failed.")
-end
-
-
-module Relation =
+module Set =
struct
- let is_relation ( x : expr ) =
- let nc = (Expr.gnc x) in
- ((Z3native.is_app (Expr.gnc x) (Expr.gno x)) &&
- (sort_kind_of_int (Z3native.get_sort_kind nc (Z3native.get_sort nc (Expr.gno x))) == RELATION_SORT))
+ let mk_sort = Z3native.mk_set_sort
- let is_store ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_STORE)
- let is_empty ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_EMPTY)
- let is_is_empty ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_IS_EMPTY)
- let is_join ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_JOIN)
- let is_union ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_UNION)
- let is_widen ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_WIDEN)
- let is_project ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_PROJECT)
- let is_filter ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_FILTER)
- let is_negation_filter ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_NEGATION_FILTER)
- let is_rename ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_RENAME)
- let is_complement ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_COMPLEMENT)
- let is_select ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_SELECT)
- let is_clone ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_RA_CLONE)
+ let is_union (x:expr) = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SET_UNION
+ let is_intersect (x:expr) = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SET_INTERSECT
+ let is_difference (x:expr) = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SET_DIFFERENCE
+ let is_complement (x:expr) = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SET_COMPLEMENT
+ let is_subset (x:expr) = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SET_SUBSET
- let get_arity ( x : Sort.sort ) = Z3native.get_relation_arity (Sort.gnc x) (Sort.gno x)
+ let mk_empty = Z3native.mk_empty_set
+ let mk_full = Z3native.mk_full_set
+ let mk_set_add = Z3native.mk_set_add
+ let mk_del = Z3native.mk_set_del
+ let mk_union ctx args =
+ Z3native.mk_set_union ctx (List.length args) args
- let get_column_sorts ( x : Sort.sort ) =
+ let mk_intersection ctx args =
+ Z3native.mk_set_intersect ctx (List.length args) args
+
+ let mk_difference = Z3native.mk_set_difference
+ let mk_complement = Z3native.mk_set_complement
+ let mk_membership = Z3native.mk_set_member
+ let mk_subset = Z3native.mk_set_subset
+end
+
+
+module FiniteDomain =
+struct
+ let mk_sort = Z3native.mk_finite_domain_sort
+ let mk_sort_s ctx name size = mk_sort ctx (Symbol.mk_string ctx name) size
+
+ let is_finite_domain (x:expr) =
+ let nc = Expr.gc x in
+ Z3native.is_app nc x &&
+ sort_kind_of_int (Z3native.get_sort_kind nc (Z3native.get_sort nc x)) = FINITE_DOMAIN_SORT
+
+ let is_lt (x:expr) = AST.is_app x && FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FD_LT
+
+ let get_size x =
+ match Z3native.get_finite_domain_sort_size (Sort.gc x) x with
+ | true, v -> v
+ | false, _ -> raise (Error "Conversion failed.")
+end
+
+
+module Relation =
+struct
+ let is_relation x =
+ let nc = Expr.gc x in
+ Z3native.is_app nc x
+ && sort_kind_of_int (Z3native.get_sort_kind nc (Z3native.get_sort nc x)) = RELATION_SORT
+
+ let is_store (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_STORE)
+ let is_empty (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_EMPTY)
+ let is_is_empty (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_IS_EMPTY)
+ let is_join (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_JOIN)
+ let is_union (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_UNION)
+ let is_widen (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_WIDEN)
+ let is_project (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_PROJECT)
+ let is_filter (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_FILTER)
+ let is_negation_filter (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_NEGATION_FILTER)
+ let is_rename (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_RENAME)
+ let is_complement (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_COMPLEMENT)
+ let is_select (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_SELECT)
+ let is_clone (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_RA_CLONE)
+
+ let get_arity (x:Sort.sort) = Z3native.get_relation_arity (Sort.gc x) x
+
+ let get_column_sorts (x:Sort.sort) =
let n = get_arity x in
- let f i = (Sort.sort_of_ptr (Sort.gc x) (Z3native.get_relation_column (Sort.gnc x) (Sort.gno x) i)) in
+ let f i = Z3native.get_relation_column (Sort.gc x) x i in
mk_list f n
end
-
-module Datatype =
+
+module Datatype =
struct
- module Constructor =
+ module Constructor =
struct
- type constructor = z3_native_object
-
- module FieldNumTable = Hashtbl.Make(struct
- type t = AST.ast
- let equal x y = AST.compare x y = 0
- let hash = AST.hash
- end)
+ type constructor = Z3native.constructor
+
+ module FieldNumTable = Hashtbl.Make(struct
+ type t = AST.ast
+ let equal x y = AST.compare x y = 0
+ let hash = AST.hash
+ end)
let _field_nums = FieldNumTable.create 0
- let create ( ctx : context ) ( name : Symbol.symbol ) ( recognizer : Symbol.symbol ) ( field_names : Symbol.symbol list ) ( sorts : Sort.sort option list ) ( sort_refs : int list ) =
- let n = (List.length field_names) in
- if n != (List.length sorts) then
- raise (Z3native.Exception "Number of field names does not match number of sorts")
+ let create (ctx:context) (name:Symbol.symbol) (recognizer:Symbol.symbol) (field_names:Symbol.symbol list) (sorts:Sort.sort option list) (sort_refs:int list) =
+ let n = List.length field_names in
+ if n <> List.length sorts then
+ raise (Error "Number of field names does not match number of sorts")
else
- if n != (List.length sort_refs) then
- raise (Z3native.Exception "Number of field names does not match number of sort refs")
- else
- let ptr = (Z3native.mk_constructor (context_gno ctx) (Symbol.gno name)
- (Symbol.gno recognizer)
- n
- (Symbol.symbol_lton field_names)
- (Sort.sort_option_lton sorts)
- (Array.of_list sort_refs)) in
- let no : constructor = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = z3obj_nil_ref ;
- dec_ref = z3obj_nil_ref} in
- (z3obj_sno no ctx ptr) ;
- (z3obj_create no) ;
- let f = fun o -> Z3native.del_constructor (z3obj_gnc o) (z3obj_gno o) in
- Gc.finalise f no ;
- FieldNumTable.add _field_nums no n ;
- no
-
- let get_num_fields ( x : constructor ) = FieldNumTable.find _field_nums x
+ if n <> List.length sort_refs then
+ raise (Error "Number of field names does not match number of sort refs")
+ else
+ let no = Z3native.mk_constructor ctx name
+ recognizer
+ n
+ field_names
+ (let f x = match x with None -> Z3native.mk_null_ast ctx | Some s -> s in
+ List.map f sorts)
+ sort_refs in
+ FieldNumTable.add _field_nums no n;
+ no
- let get_constructor_decl ( x : constructor ) =
- let (a, _, _) = (Z3native.query_constructor (z3obj_gnc x) (z3obj_gno x) (get_num_fields x)) in
- func_decl_of_ptr (z3obj_gc x) a
+ let get_num_fields (x:constructor) = FieldNumTable.find _field_nums x
- let get_tester_decl ( x : constructor ) =
- let (_, b, _) = (Z3native.query_constructor (z3obj_gnc x) (z3obj_gno x) (get_num_fields x)) in
- func_decl_of_ptr (z3obj_gc x) b
+ let get_constructor_decl (x:constructor) =
+ let (a, _, _) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in
+ a
- let get_accessor_decls ( x : constructor ) =
- let (_, _, c) = (Z3native.query_constructor (z3obj_gnc x) (z3obj_gno x) (get_num_fields x)) in
- let f i = func_decl_of_ptr (z3obj_gc x) (Array.get c i) in
- mk_list f (Array.length c)
-
+ let get_tester_decl (x:constructor) =
+ let (_, b, _) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in
+ b
+
+ let get_accessor_decls (x:constructor) =
+ let (_, _, c) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in
+ c
end
module ConstructorList =
struct
- type constructor_list = z3_native_object
+ type constructor_list = Z3native.constructor_list
- let create ( ctx : context ) ( c : Constructor.constructor list ) =
- let res : constructor_list = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = z3obj_nil_ref ;
- dec_ref = z3obj_nil_ref} in
- let f x =(z3obj_gno x) in
- (z3obj_sno res ctx (Z3native.mk_constructor_list (context_gno ctx) (List.length c) (Array.of_list (List.map f c)))) ;
- (z3obj_create res) ;
- let f = fun o -> Z3native.del_constructor_list (z3obj_gnc o) (z3obj_gno o) in
- Gc.finalise f res;
- res
+ let create (ctx:context) (c:Constructor.constructor list) =
+ Z3native.mk_constructor_list ctx (List.length c) c
end
-
- let mk_constructor ( ctx : context ) ( name : Symbol.symbol ) ( recognizer : Symbol.symbol ) ( field_names : Symbol.symbol list ) ( sorts : Sort.sort option list ) ( sort_refs : int list ) =
+
+ let mk_constructor (ctx:context) (name:Symbol.symbol) (recognizer:Symbol.symbol) (field_names:Symbol.symbol list) (sorts:Sort.sort option list) (sort_refs:int list) =
Constructor.create ctx name recognizer field_names sorts sort_refs
-
- let mk_constructor_s ( ctx : context ) ( name : string ) ( recognizer : Symbol.symbol ) ( field_names : Symbol.symbol list ) ( sorts : Sort.sort option list ) ( sort_refs : int list ) =
+ let mk_constructor_s (ctx:context) (name:string) (recognizer:Symbol.symbol) (field_names:Symbol.symbol list) (sorts:Sort.sort option list) (sort_refs:int list) =
mk_constructor ctx (Symbol.mk_string ctx name) recognizer field_names sorts sort_refs
- let mk_sort ( ctx : context ) ( name : Symbol.symbol ) ( constructors : Constructor.constructor list ) =
- let f x = (z3obj_gno x) in
- let (x,_) = (Z3native.mk_datatype (context_gno ctx) (Symbol.gno name) (List.length constructors) (Array.of_list (List.map f constructors))) in
- Sort.sort_of_ptr ctx x
+ let mk_sort (ctx:context) (name:Symbol.symbol) (constructors:Constructor.constructor list) =
+ let (x,_) = Z3native.mk_datatype ctx name (List.length constructors) constructors in
+ x
- let mk_sort_s ( ctx : context ) ( name : string ) ( constructors : Constructor.constructor list ) =
+ let mk_sort_s (ctx:context) (name:string) (constructors:Constructor.constructor list) =
mk_sort ctx (Symbol.mk_string ctx name) constructors
-
- let mk_sorts ( ctx : context ) ( names : Symbol.symbol list ) ( c : Constructor.constructor list list ) =
- let n = (List.length names) in
- let f e = (AST.ptr_of_ast (ConstructorList.create ctx e)) in
- let cla = (Array.of_list (List.map f c)) in
- let (r, a) = (Z3native.mk_datatypes (context_gno ctx) n (Symbol.symbol_lton names) cla) in
- let g i = (Sort.sort_of_ptr ctx (Array.get r i)) in
- mk_list g (Array.length r)
- let mk_sorts_s ( ctx : context ) ( names : string list ) ( c : Constructor.constructor list list ) =
- mk_sorts ctx
- (
- let f e = (Symbol.mk_string ctx e) in
- List.map f names
- )
- c
+ let mk_sorts (ctx:context) (names:Symbol.symbol list) (c:Constructor.constructor list list) =
+ let n = List.length names in
+ let f e = ConstructorList.create ctx e in
+ let cla = List.map f c in
+ let (r, _) = Z3native.mk_datatypes ctx n names cla in
+ r
- let get_num_constructors ( x : Sort.sort ) = Z3native.get_datatype_sort_num_constructors (Sort.gnc x) (Sort.gno x)
+ let mk_sorts_s (ctx:context) (names:string list) (c:Constructor.constructor list list) =
+ mk_sorts ctx (List.map (fun x -> Symbol.mk_string ctx x) names) c
- let get_constructors ( x : Sort.sort ) =
- let n = (get_num_constructors x) in
- let f i = func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor (Sort.gnc x) (Sort.gno x) i) in
+ let get_num_constructors (x:Sort.sort) = Z3native.get_datatype_sort_num_constructors (Sort.gc x) x
+
+ let get_constructors (x:Sort.sort) =
+ let n = get_num_constructors x in
+ let f i = Z3native.get_datatype_sort_constructor (Sort.gc x) x i in
mk_list f n
- let get_recognizers ( x : Sort.sort ) =
+ let get_recognizers (x:Sort.sort) =
let n = (get_num_constructors x) in
- let f i = func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_recognizer (Sort.gnc x) (Sort.gno x) i) in
+ let f i = Z3native.get_datatype_sort_recognizer (Sort.gc x) x i in
mk_list f n
-
- let get_accessors ( x : Sort.sort ) =
+
+ let get_accessors (x:Sort.sort) =
let n = (get_num_constructors x) in
let f i = (
- let fd = func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor (Sort.gnc x) (Sort.gno x) i) in
- let ds = Z3native.get_domain_size (FuncDecl.gnc fd) (FuncDecl.gno fd) in
- let g j = func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor_accessor (Sort.gnc x) (Sort.gno x) i j) in
- mk_list g ds
- ) in
+ let fd = Z3native.get_datatype_sort_constructor (Sort.gc x) x i in
+ let ds = Z3native.get_domain_size (FuncDecl.gc fd) fd in
+ let g j = Z3native.get_datatype_sort_constructor_accessor (Sort.gc x) x i j in
+ mk_list g ds) in
mk_list f n
end
-module Enumeration =
-struct
- let mk_sort ( ctx : context ) ( name : Symbol.symbol ) ( enum_names : Symbol.symbol list ) =
- let (a, _, _) = (Z3native.mk_enumeration_sort (context_gno ctx) (Symbol.gno name) (List.length enum_names) (Symbol.symbol_lton enum_names)) in
- Sort.sort_of_ptr ctx a
+module Enumeration =
+struct
+ let mk_sort (ctx:context) (name:Symbol.symbol) (enum_names:Symbol.symbol list) =
+ let (a, _, _) = Z3native.mk_enumeration_sort ctx name (List.length enum_names) enum_names in
+ a
- let mk_sort_s ( ctx : context ) ( name : string ) ( enum_names : string list ) =
+ let mk_sort_s (ctx:context) (name:string) (enum_names:string list) =
mk_sort ctx (Symbol.mk_string ctx name) (Symbol.mk_strings ctx enum_names)
- let get_const_decls ( x : Sort.sort ) =
- let n = Z3native.get_datatype_sort_num_constructors (Sort.gnc x) (Sort.gno x) in
- let f i = (func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor (Sort.gnc x) (Sort.gno x) i)) in
+ let get_const_decls (x:Sort.sort) =
+ let n = Z3native.get_datatype_sort_num_constructors (Sort.gc x) x in
+ let f i = Z3native.get_datatype_sort_constructor (Sort.gc x) x i in
mk_list f n
- let get_const_decl ( x : Sort.sort ) ( inx : int ) =
- func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor (Sort.gnc x) (Sort.gno x) inx)
+ let get_const_decl (x:Sort.sort) (inx:int) = Z3native.get_datatype_sort_constructor (Sort.gc x) x inx
- let get_consts ( x : Sort.sort ) =
- let n = Z3native.get_datatype_sort_num_constructors (Sort.gnc x) (Sort.gno x) in
- let f i = (Expr.mk_const_f (Sort.gc x) (get_const_decl x i)) in
+ let get_consts (x:Sort.sort) =
+ let n = Z3native.get_datatype_sort_num_constructors (Sort.gc x) x in
+ let f i = Expr.mk_const_f (Sort.gc x) (get_const_decl x i) in
mk_list f n
- let get_const ( x : Sort.sort ) ( inx : int ) =
- Expr.mk_const_f (Sort.gc x) (get_const_decl x inx)
+ let get_const (x:Sort.sort) (inx:int) = Expr.mk_const_f (Sort.gc x) (get_const_decl x inx)
- let get_tester_decls ( x : Sort.sort ) =
- let n = Z3native.get_datatype_sort_num_constructors (Sort.gnc x) (Sort.gno x) in
- let f i = (func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_recognizer (Sort.gnc x) (Sort.gno x) i)) in
+ let get_tester_decls (x:Sort.sort) =
+ let n = Z3native.get_datatype_sort_num_constructors (Sort.gc x) x in
+ let f i = Z3native.get_datatype_sort_recognizer (Sort.gc x) x i in
mk_list f n
-
- let get_tester_decl ( x : Sort.sort ) ( inx : int ) =
- func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_recognizer (Sort.gnc x) (Sort.gno x) inx)
+
+ let get_tester_decl (x:Sort.sort) (inx:int) = Z3native.get_datatype_sort_recognizer (Sort.gc x) x inx
end
-module Z3List =
-struct
- let mk_sort ( ctx : context ) ( name : Symbol.symbol ) ( elem_sort : Sort.sort ) =
- let (r, _, _, _, _, _, _) = (Z3native.mk_list_sort (context_gno ctx) (Symbol.gno name) (Sort.gno elem_sort)) in
- Sort.sort_of_ptr ctx r
-
- let mk_list_s ( ctx : context ) ( name : string ) elem_sort =
- mk_sort ctx (Symbol.mk_string ctx name) elem_sort
-
- let get_nil_decl ( x : Sort.sort ) =
- func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor (Sort.gnc x) (Sort.gno x) 0)
-
- let get_is_nil_decl ( x : Sort.sort ) =
- func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_recognizer (Sort.gnc x) (Sort.gno x) 0)
-
- let get_cons_decl ( x : Sort.sort ) =
- func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor (Sort.gnc x) (Sort.gno x) 1)
-
- let get_is_cons_decl ( x : Sort.sort ) =
- func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_recognizer (Sort.gnc x) (Sort.gno x) 1)
-
- let get_head_decl ( x : Sort.sort ) =
- func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor_accessor (Sort.gnc x) (Sort.gno x) 1 0)
-
- let get_tail_decl ( x : Sort.sort ) =
- func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor_accessor (Sort.gnc x) (Sort.gno x) 1 1)
-
- let nil ( x : Sort.sort ) = expr_of_func_app (Sort.gc x) (get_nil_decl x) []
-end
-
-
-module Tuple =
+module Z3List =
struct
- let mk_sort ( ctx : context ) ( name : Symbol.symbol ) ( field_names : Symbol.symbol list ) ( field_sorts : Sort.sort list ) =
- let (r, _, _) = (Z3native.mk_tuple_sort (context_gno ctx) (Symbol.gno name) (List.length field_names) (Symbol.symbol_lton field_names) (Sort.sort_lton field_sorts)) in
- Sort.sort_of_ptr ctx r
+ let mk_sort (ctx:context) (name:Symbol.symbol) (elem_sort:Sort.sort) =
+ let (r, _, _, _, _, _, _) = Z3native.mk_list_sort ctx name elem_sort in
+ r
- let get_mk_decl ( x : Sort.sort ) =
- func_decl_of_ptr (Sort.gc x) (Z3native.get_tuple_sort_mk_decl (Sort.gnc x) (Sort.gno x))
+ let mk_list_s (ctx:context) (name:string) elem_sort = mk_sort ctx (Symbol.mk_string ctx name) elem_sort
+ let get_nil_decl (x:Sort.sort) = Z3native.get_datatype_sort_constructor (Sort.gc x) x 0
+ let get_is_nil_decl (x:Sort.sort) = Z3native.get_datatype_sort_recognizer (Sort.gc x) x 0
+ let get_cons_decl (x:Sort.sort) = Z3native.get_datatype_sort_constructor (Sort.gc x) x 1
+ let get_is_cons_decl (x:Sort.sort) =Z3native.get_datatype_sort_recognizer (Sort.gc x) x 1
+ let get_head_decl (x:Sort.sort) = Z3native.get_datatype_sort_constructor_accessor (Sort.gc x) x 1 0
+ let get_tail_decl (x:Sort.sort) = Z3native.get_datatype_sort_constructor_accessor (Sort.gc x) x 1 1
+ let nil (x:Sort.sort) = expr_of_func_app (Sort.gc x) (get_nil_decl x) []
+end
- let get_num_fields ( x : Sort.sort ) = Z3native.get_tuple_sort_num_fields (Sort.gnc x) (Sort.gno x)
-
- let get_field_decls ( x : Sort.sort ) =
+
+module Tuple =
+struct
+ let mk_sort (ctx:context) (name:Symbol.symbol) (field_names:Symbol.symbol list) (field_sorts:Sort.sort list) =
+ let (r, _, _) = Z3native.mk_tuple_sort ctx name (List.length field_names) field_names field_sorts in
+ r
+
+ let get_mk_decl (x:Sort.sort) = Z3native.get_tuple_sort_mk_decl (Sort.gc x) x
+ let get_num_fields (x:Sort.sort) = Z3native.get_tuple_sort_num_fields (Sort.gc x) x
+
+ let get_field_decls (x:Sort.sort) =
let n = get_num_fields x in
- let f i = func_decl_of_ptr (Sort.gc x) (Z3native.get_tuple_sort_field_decl (Sort.gnc x) (Sort.gno x) i) in
+ let f i =Z3native.get_tuple_sort_field_decl (Sort.gc x) x i in
mk_list f n
end
module Arithmetic =
struct
- let is_int ( x : expr ) =
- ((sort_kind_of_int (Z3native.get_sort_kind (Expr.gnc x) (Z3native.get_sort (Expr.gnc x) (Expr.gno x)))) == INT_SORT)
-
- let is_arithmetic_numeral ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ANUM)
+ let is_int (x:expr) =
+ ((sort_kind_of_int (Z3native.get_sort_kind (Expr.gc x) (Z3native.get_sort (Expr.gc x) x))) = INT_SORT)
- let is_le ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_LE)
-
- let is_ge ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_GE)
-
- let is_lt ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_LT)
-
- let is_gt ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_GT)
-
- let is_add ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ADD)
-
- let is_sub ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SUB)
-
- let is_uminus ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_UMINUS)
-
- let is_mul ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_MUL)
-
- let is_div ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_DIV)
-
- let is_idiv ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_IDIV)
-
- let is_remainder ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_REM)
-
- let is_modulus ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_MOD)
-
- let is_int2real ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_TO_REAL)
-
- let is_real2int ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_TO_INT)
-
- let is_real_is_int ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_IS_INT)
-
- let is_real ( x : expr ) =
- ((sort_kind_of_int (Z3native.get_sort_kind (Expr.gnc x) (Z3native.get_sort (Expr.gnc x) (Expr.gno x)))) == REAL_SORT)
-
- let is_int_numeral ( x : expr ) = (Expr.is_numeral x) && (is_int x)
-
- let is_rat_numeral ( x : expr ) = (Expr.is_numeral x) && (is_real x)
-
- let is_algebraic_number ( x : expr ) = Z3native.is_algebraic_number (Expr.gnc x) (Expr.gno x)
+ let is_arithmetic_numeral (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ANUM)
+ let is_le (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_LE)
+ let is_ge (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_GE)
+ let is_lt (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_LT)
+ let is_gt (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_GT)
+ let is_add (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ADD)
+ let is_sub (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SUB)
+ let is_uminus (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_UMINUS)
+ let is_mul (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_MUL)
+ let is_div (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_DIV)
+ let is_idiv (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_IDIV)
+ let is_remainder (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_REM)
+ let is_modulus (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_MOD)
+ let is_int2real (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_TO_REAL)
+ let is_real2int (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_TO_INT)
+ let is_real_is_int (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_IS_INT)
+ let is_real (x:expr) = ((sort_kind_of_int (Z3native.get_sort_kind (Expr.gc x) (Z3native.get_sort (Expr.gc x) x))) = REAL_SORT)
+ let is_int_numeral (x:expr) = (Expr.is_numeral x) && (is_int x)
+ let is_rat_numeral (x:expr) = (Expr.is_numeral x) && (is_real x)
+ let is_algebraic_number (x:expr) = Z3native.is_algebraic_number (Expr.gc x) x
module Integer =
- struct
- let mk_sort ( ctx : context ) =
- Sort.sort_of_ptr ctx (Z3native.mk_int_sort (context_gno ctx))
+ struct
+ let mk_sort = Z3native.mk_int_sort
- let get_int ( x : expr ) =
- let (r, v) = Z3native.get_numeral_int (Expr.gnc x) (Expr.gno x) in
- if r then v
- else raise (Z3native.Exception "Conversion failed.")
+ let get_int x =
+ match Z3native.get_numeral_int (Expr.gc x) x with
+ | true, v -> v
+ | false, _ -> raise (Error "Conversion failed.")
- let get_big_int ( x : expr ) =
- if (is_int_numeral x) then
- let s = (Z3native.get_numeral_string (Expr.gnc x) (Expr.gno x)) in
- (Big_int.big_int_of_string s)
- else raise (Z3native.Exception "Conversion failed.")
-
- let numeral_to_string ( x : expr ) = Z3native.get_numeral_string (Expr.gnc x) (Expr.gno x)
+ let get_big_int (x:expr) =
+ if is_int_numeral x then
+ let s = (Z3native.get_numeral_string (Expr.gc x) x) in
+ Big_int.big_int_of_string s
+ else
+ raise (Error "Conversion failed.")
- let mk_const ( ctx : context ) ( name : Symbol.symbol ) =
- Expr.mk_const ctx name (mk_sort ctx)
-
- let mk_const_s ( ctx : context ) ( name : string ) =
- mk_const ctx (Symbol.mk_string ctx name)
-
- let mk_mod ( ctx : context ) ( t1 : expr ) ( t2 : expr ) =
- apply2 ctx Z3native.mk_mod t1 t2
-
- let mk_rem ( ctx : context ) ( t1 : expr ) ( t2 : expr ) =
- apply2 ctx Z3native.mk_rem t1 t2
-
- let mk_numeral_s ( ctx : context ) ( v : string ) =
- expr_of_ptr ctx (Z3native.mk_numeral (context_gno ctx) v (Sort.gno (mk_sort ctx)))
-
- let mk_numeral_i ( ctx : context ) ( v : int ) =
- expr_of_ptr ctx (Z3native.mk_int (context_gno ctx) v (Sort.gno (mk_sort ctx)))
-
- let mk_int2real ( ctx : context ) ( t : expr ) =
- apply1 ctx Z3native.mk_int2real t
-
- let mk_int2bv ( ctx : context ) ( n : int ) ( t : expr ) =
- (Expr.expr_of_ptr ctx (Z3native.mk_int2bv (context_gno ctx) n (Expr.gno t)))
+ let numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) x
+ let mk_const (ctx:context) (name:Symbol.symbol) = Expr.mk_const ctx name (mk_sort ctx)
+ let mk_const_s (ctx:context) (name:string) = mk_const ctx (Symbol.mk_string ctx name)
+ let mk_mod = Z3native.mk_mod
+ let mk_rem = Z3native.mk_rem
+ let mk_numeral_s (ctx:context) (v:string) = Z3native.mk_numeral ctx v (mk_sort ctx)
+ let mk_numeral_i (ctx:context) (v:int) = Z3native.mk_int ctx v (mk_sort ctx)
+ let mk_int2real = Z3native.mk_int2real
+ let mk_int2bv = Z3native.mk_int2bv
end
module Real =
- struct
- let mk_sort ( ctx : context ) =
- Sort.sort_of_ptr ctx (Z3native.mk_real_sort (context_gno ctx))
+ struct
+ let mk_sort = Z3native.mk_real_sort
+ let get_numerator x = Z3native.get_numerator (Expr.gc x) x
+ let get_denominator x = Z3native.get_denominator (Expr.gc x) x
- let get_numerator ( x : expr ) =
- apply1 (Expr.gc x) Z3native.get_numerator x
-
- let get_denominator ( x : expr ) =
- apply1 (Expr.gc x) Z3native.get_denominator x
-
- let get_ratio ( x : expr ) =
- if (is_rat_numeral x) then
- let s = (Z3native.get_numeral_string (Expr.gnc x) (Expr.gno x)) in
- (Ratio.ratio_of_string s)
- else raise (Z3native.Exception "Conversion failed.")
+ let get_ratio x =
+ if is_rat_numeral x then
+ let s = Z3native.get_numeral_string (Expr.gc x) x in
+ Ratio.ratio_of_string s
+ else
+ raise (Error "Conversion failed.")
- let to_decimal_string ( x : expr ) ( precision : int ) =
- Z3native.get_numeral_decimal_string (Expr.gnc x) (Expr.gno x) precision
-
- let numeral_to_string ( x : expr ) = Z3native.get_numeral_string (Expr.gnc x) (Expr.gno x)
+ let to_decimal_string (x:expr) (precision:int) = Z3native.get_numeral_decimal_string (Expr.gc x) x precision
+ let numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) x
+ let mk_const (ctx:context) (name:Symbol.symbol) = Expr.mk_const ctx name (mk_sort ctx)
+ let mk_const_s (ctx:context) (name:string) = mk_const ctx (Symbol.mk_string ctx name)
+ let mk_numeral_nd (ctx:context) (num:int) (den:int) =
+ if den = 0 then
+ raise (Error "Denominator is zero")
+ else
+ Z3native.mk_real ctx num den
- let mk_const ( ctx : context ) ( name : Symbol.symbol ) =
- Expr.mk_const ctx name (mk_sort ctx)
-
- let mk_const_s ( ctx : context ) ( name : string ) =
- mk_const ctx (Symbol.mk_string ctx name)
-
- let mk_numeral_nd ( ctx : context ) ( num : int ) ( den : int ) =
- if (den == 0) then
- raise (Z3native.Exception "Denominator is zero")
- else
- expr_of_ptr ctx (Z3native.mk_real (context_gno ctx) num den)
-
- let mk_numeral_s ( ctx : context ) ( v : string ) =
- expr_of_ptr ctx (Z3native.mk_numeral (context_gno ctx) v (Sort.gno (mk_sort ctx)))
-
- let mk_numeral_i ( ctx : context ) ( v : int ) =
- expr_of_ptr ctx (Z3native.mk_int (context_gno ctx) v (Sort.gno (mk_sort ctx)))
-
- let mk_is_integer ( ctx : context ) ( t : expr ) =
- apply1 ctx Z3native.mk_is_int t
-
- let mk_real2int ( ctx : context ) ( t : expr ) =
- apply1 ctx Z3native.mk_real2int t
+ let mk_numeral_s (ctx:context) (v:string) = Z3native.mk_numeral ctx v (mk_sort ctx)
+ let mk_numeral_i (ctx:context) (v:int) = Z3native.mk_int ctx v (mk_sort ctx)
+ let mk_is_integer = Z3native.mk_is_int
+ let mk_real2int = Z3native.mk_real2int
module AlgebraicNumber =
- struct
- let to_upper ( x : expr ) ( precision : int ) =
- expr_of_ptr (Expr.gc x) (Z3native.get_algebraic_number_upper (Expr.gnc x) (Expr.gno x) precision)
-
- let to_lower ( x : expr ) precision =
- expr_of_ptr (Expr.gc x) (Z3native.get_algebraic_number_lower (Expr.gnc x) (Expr.gno x) precision)
-
- let to_decimal_string ( x : expr ) ( precision : int ) =
- Z3native.get_numeral_decimal_string (Expr.gnc x) (Expr.gno x) precision
-
- let numeral_to_string ( x : expr ) = Z3native.get_numeral_string (Expr.gnc x) (Expr.gno x)
+ struct
+ let to_upper (x:expr) (precision:int) = Z3native.get_algebraic_number_upper (Expr.gc x) x precision
+ let to_lower (x:expr) (precision:int) = Z3native.get_algebraic_number_lower (Expr.gc x) x precision
+ let to_decimal_string (x:expr) (precision:int) = Z3native.get_numeral_decimal_string (Expr.gc x) x precision
+ let numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) x
end
end
- let mk_add ( ctx : context ) ( t : expr list ) =
- let f x = (Expr.gno x) in
- (expr_of_ptr ctx (Z3native.mk_add (context_gno ctx) (List.length t) (Array.of_list (List.map f t))))
+ let mk_add (ctx:context) (t:expr list) =
+ Z3native.mk_add ctx (List.length t) t
- let mk_mul ( ctx : context ) ( t : expr list ) =
- let f x = (Expr.gno x) in
- (expr_of_ptr ctx (Z3native.mk_mul (context_gno ctx) (List.length t) (Array.of_list (List.map f t))))
+ let mk_mul (ctx:context) (t:expr list) =
+ Z3native.mk_mul ctx (List.length t) t
- let mk_sub ( ctx : context ) ( t : expr list ) =
- let f x = (Expr.gno x) in
- (expr_of_ptr ctx (Z3native.mk_sub (context_gno ctx) (List.length t) (Array.of_list (List.map f t))))
-
- let mk_unary_minus ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_unary_minus t
+ let mk_sub (ctx:context) (t:expr list) =
+ Z3native.mk_sub ctx (List.length t) t
- let mk_div ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_div t1 t2
-
- let mk_power ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_power t1 t2
-
- let mk_lt ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_lt t1 t2
-
- let mk_le ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_le t1 t2
-
- let mk_gt ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_gt t1 t2
-
- let mk_ge ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_ge t1 t2
+ let mk_unary_minus = Z3native.mk_unary_minus
+ let mk_div = Z3native.mk_div
+ let mk_power = Z3native.mk_power
+ let mk_lt = Z3native.mk_lt
+ let mk_le = Z3native.mk_le
+ let mk_gt = Z3native.mk_gt
+ let mk_ge = Z3native.mk_ge
end
module BitVector =
-struct
- let mk_sort ( ctx : context ) size =
- Sort.sort_of_ptr ctx (Z3native.mk_bv_sort (context_gno ctx) size)
- let is_bv ( x : expr ) =
- ((sort_kind_of_int (Z3native.get_sort_kind (Expr.gnc x) (Z3native.get_sort (Expr.gnc x) (Expr.gno x)))) == BV_SORT)
- let is_bv_numeral ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BNUM)
- let is_bv_bit1 ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BIT1)
- let is_bv_bit0 ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BIT0)
- let is_bv_uminus ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BNEG)
- let is_bv_add ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BADD)
- let is_bv_sub ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BSUB)
- let is_bv_mul ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BMUL)
- let is_bv_sdiv ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BSDIV)
- let is_bv_udiv ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BUDIV)
- let is_bv_SRem ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BSREM)
- let is_bv_urem ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BUREM)
- let is_bv_smod ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BSMOD)
- let is_bv_sdiv0 ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BSDIV0)
- let is_bv_udiv0 ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BUDIV0)
- let is_bv_srem0 ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BSREM0)
- let is_bv_urem0 ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BUREM0)
- let is_bv_smod0 ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BSMOD0)
- let is_bv_ule ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ULEQ)
- let is_bv_sle ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SLEQ)
- let is_bv_uge ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_UGEQ)
- let is_bv_sge ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SGEQ)
- let is_bv_ult ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ULT)
- let is_bv_slt ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SLT)
- let is_bv_ugt ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_UGT)
- let is_bv_sgt ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SGT)
- let is_bv_and ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BAND)
- let is_bv_or ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BOR)
- let is_bv_not ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BNOT)
- let is_bv_xor ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BXOR)
- let is_bv_nand ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BNAND)
- let is_bv_nor ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BNOR)
- let is_bv_xnor ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BXNOR)
- let is_bv_concat ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_CONCAT)
- let is_bv_signextension ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SIGN_EXT)
- let is_bv_zeroextension ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ZERO_EXT)
- let is_bv_extract ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_EXTRACT)
- let is_bv_repeat ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_REPEAT)
- let is_bv_reduceor ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BREDOR)
- let is_bv_reduceand ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BREDAND)
- let is_bv_comp ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BCOMP)
- let is_bv_shiftleft ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BSHL)
- let is_bv_shiftrightlogical ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BLSHR)
- let is_bv_shiftrightarithmetic ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BASHR)
- let is_bv_rotateleft ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ROTATE_LEFT)
- let is_bv_rotateright ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ROTATE_RIGHT)
- let is_bv_rotateleftextended ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_EXT_ROTATE_LEFT)
- let is_bv_rotaterightextended ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_EXT_ROTATE_RIGHT)
- let is_int2bv ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_INT2BV)
- let is_bv2int ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_BV2INT)
- let is_bv_carry ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_CARRY)
- let is_bv_xor3 ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_XOR3)
- let get_size (x : Sort.sort ) = Z3native.get_bv_sort_size (Sort.gnc x) (Sort.gno x)
- let get_int ( x : expr ) =
- let (r, v) = Z3native.get_numeral_int (Expr.gnc x) (Expr.gno x) in
- if r then v
- else raise (Z3native.Exception "Conversion failed.")
- let numeral_to_string ( x : expr ) = Z3native.get_numeral_string (Expr.gnc x) (Expr.gno x)
- let mk_const ( ctx : context ) ( name : Symbol.symbol ) ( size : int ) =
- Expr.mk_const ctx name (mk_sort ctx size)
- let mk_const_s ( ctx : context ) ( name : string ) ( size : int ) =
+struct
+ let mk_sort (ctx:context) size = Z3native.mk_bv_sort ctx size
+ let is_bv (x:expr) =
+ ((sort_kind_of_int (Z3native.get_sort_kind (Expr.gc x) (Z3native.get_sort (Expr.gc x) x))) = BV_SORT)
+ let is_bv_numeral (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BNUM)
+ let is_bv_bit1 (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BIT1)
+ let is_bv_bit0 (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BIT0)
+ let is_bv_uminus (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BNEG)
+ let is_bv_add (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BADD)
+ let is_bv_sub (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BSUB)
+ let is_bv_mul (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BMUL)
+ let is_bv_sdiv (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BSDIV)
+ let is_bv_udiv (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BUDIV)
+ let is_bv_SRem (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BSREM)
+ let is_bv_urem (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BUREM)
+ let is_bv_smod (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BSMOD)
+ let is_bv_sdiv0 (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BSDIV0)
+ let is_bv_udiv0 (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BUDIV0)
+ let is_bv_srem0 (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BSREM0)
+ let is_bv_urem0 (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BUREM0)
+ let is_bv_smod0 (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BSMOD0)
+ let is_bv_ule (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ULEQ)
+ let is_bv_sle (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SLEQ)
+ let is_bv_uge (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_UGEQ)
+ let is_bv_sge (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SGEQ)
+ let is_bv_ult (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ULT)
+ let is_bv_slt (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SLT)
+ let is_bv_ugt (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_UGT)
+ let is_bv_sgt (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SGT)
+ let is_bv_and (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BAND)
+ let is_bv_or (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BOR)
+ let is_bv_not (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BNOT)
+ let is_bv_xor (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BXOR)
+ let is_bv_nand (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BNAND)
+ let is_bv_nor (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BNOR)
+ let is_bv_xnor (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BXNOR)
+ let is_bv_concat (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_CONCAT)
+ let is_bv_signextension (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SIGN_EXT)
+ let is_bv_zeroextension (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ZERO_EXT)
+ let is_bv_extract (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_EXTRACT)
+ let is_bv_repeat (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_REPEAT)
+ let is_bv_reduceor (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BREDOR)
+ let is_bv_reduceand (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BREDAND)
+ let is_bv_comp (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BCOMP)
+ let is_bv_shiftleft (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BSHL)
+ let is_bv_shiftrightlogical (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BLSHR)
+ let is_bv_shiftrightarithmetic (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BASHR)
+ let is_bv_rotateleft (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ROTATE_LEFT)
+ let is_bv_rotateright (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ROTATE_RIGHT)
+ let is_bv_rotateleftextended (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_EXT_ROTATE_LEFT)
+ let is_bv_rotaterightextended (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_EXT_ROTATE_RIGHT)
+ let is_int2bv (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_INT2BV)
+ let is_bv2int (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_BV2INT)
+ let is_bv_carry (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_CARRY)
+ let is_bv_xor3 (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_XOR3)
+ let get_size (x:Sort.sort) = Z3native.get_bv_sort_size (Sort.gc x) x
+
+ let get_int (x:expr) =
+ match Z3native.get_numeral_int (Expr.gc x) x with
+ | true, v -> v
+ | false, _ -> raise (Error "Conversion failed.")
+
+ let numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) x
+ let mk_const (ctx:context) (name:Symbol.symbol) (size:int) =
+ Expr.mk_const ctx name (mk_sort ctx size)
+ let mk_const_s (ctx:context) (name:string) (size:int) =
mk_const ctx (Symbol.mk_string ctx name) size
- let mk_not ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_bvnot t
- let mk_redand ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_bvredand t
- let mk_redor ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_bvredor t
- let mk_and ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvand t1 t2
- let mk_or ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvor t1 t2
- let mk_xor ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvxor t1 t2
- let mk_nand ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvnand t1 t2
- let mk_nor ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvnor t1 t2
- let mk_xnor ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvxnor t1 t2
- let mk_neg ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_bvneg t
- let mk_add ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvadd t1 t2
- let mk_sub ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvsub t1 t2
- let mk_mul ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvmul t1 t2
- let mk_udiv ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvudiv t1 t2
- let mk_sdiv ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvsdiv t1 t2
- let mk_urem ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvurem t1 t2
- let mk_srem ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvsrem t1 t2
- let mk_smod ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvsmod t1 t2
- let mk_ult ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvult t1 t2
- let mk_slt ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvslt t1 t2
- let mk_ule ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvule t1 t2
- let mk_sle ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvsle t1 t2
- let mk_uge ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvuge t1 t2
- let mk_sge ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvsge t1 t2
- let mk_ugt ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvugt t1 t2
- let mk_sgt ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvsgt t1 t2
- let mk_concat ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_concat t1 t2
- let mk_extract ( ctx : context ) ( high : int ) ( low : int ) ( t : expr ) =
- expr_of_ptr ctx (Z3native.mk_extract (context_gno ctx) high low (Expr.gno t))
- let mk_sign_ext ( ctx : context ) ( i : int ) ( t : expr ) =
- expr_of_ptr ctx (Z3native.mk_sign_ext (context_gno ctx) i (Expr.gno t))
- let mk_zero_ext ( ctx : context ) ( i : int ) ( t : expr ) =
- expr_of_ptr ctx (Z3native.mk_zero_ext (context_gno ctx) i (Expr.gno t))
- let mk_repeat ( ctx : context ) ( i : int ) ( t : expr ) =
- expr_of_ptr ctx (Z3native.mk_repeat (context_gno ctx) i (Expr.gno t))
- let mk_shl ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvshl t1 t2
- let mk_lshr ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvlshr t1 t2
- let mk_ashr ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvashr t1 t2
- let mk_rotate_left ( ctx : context ) ( i : int ) ( t : expr ) =
- expr_of_ptr ctx (Z3native.mk_rotate_left (context_gno ctx) i (Expr.gno t))
- let mk_rotate_right ( ctx : context ) ( i : int ) ( t : expr ) =
- expr_of_ptr ctx (Z3native.mk_rotate_right (context_gno ctx) i (Expr.gno t))
- let mk_ext_rotate_left ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_ext_rotate_left t1 t2
- let mk_ext_rotate_right ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_ext_rotate_right t1 t2
- let mk_bv2int ( ctx : context ) ( t : expr ) ( signed : bool ) =
- expr_of_ptr ctx (Z3native.mk_bv2int (context_gno ctx) (Expr.gno t) signed)
- let mk_add_no_overflow ( ctx : context ) ( t1 : expr ) ( t2 : expr ) ( signed : bool) =
- (expr_of_ptr ctx (Z3native.mk_bvadd_no_overflow (context_gno ctx) (Expr.gno t1) (Expr.gno t2) signed))
- let mk_add_no_underflow ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvadd_no_underflow t1 t2
- let mk_sub_no_overflow ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvsub_no_overflow t1 t2
- let mk_sub_no_underflow ( ctx : context ) ( t1 : expr ) ( t2 : expr ) ( signed : bool) =
- (expr_of_ptr ctx (Z3native.mk_bvsub_no_underflow (context_gno ctx) (Expr.gno t1) (Expr.gno t2) signed))
- let mk_sdiv_no_overflow ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvsdiv_no_overflow t1 t2
- let mk_neg_no_overflow ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_bvneg_no_overflow t
- let mk_mul_no_overflow ( ctx : context ) ( t1 : expr ) ( t2 : expr ) ( signed : bool) =
- (expr_of_ptr ctx (Z3native.mk_bvmul_no_overflow (context_gno ctx) (Expr.gno t1) (Expr.gno t2) signed))
- let mk_mul_no_underflow ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_bvmul_no_underflow t1 t2
- let mk_numeral ( ctx : context ) ( v : string ) ( size : int ) =
- expr_of_ptr ctx (Z3native.mk_numeral (context_gno ctx) v (Sort.gno (mk_sort ctx size)))
+ let mk_not = Z3native.mk_bvnot
+ let mk_redand = Z3native.mk_bvredand
+ let mk_redor = Z3native.mk_bvredor
+ let mk_and = Z3native.mk_bvand
+ let mk_or = Z3native.mk_bvor
+ let mk_xor = Z3native.mk_bvxor
+ let mk_nand = Z3native.mk_bvnand
+ let mk_nor = Z3native.mk_bvnor
+ let mk_xnor = Z3native.mk_bvxnor
+ let mk_neg = Z3native.mk_bvneg
+ let mk_add = Z3native.mk_bvadd
+ let mk_sub = Z3native.mk_bvsub
+ let mk_mul = Z3native.mk_bvmul
+ let mk_udiv = Z3native.mk_bvudiv
+ let mk_sdiv = Z3native.mk_bvsdiv
+ let mk_urem = Z3native.mk_bvurem
+ let mk_srem = Z3native.mk_bvsrem
+ let mk_smod = Z3native.mk_bvsmod
+ let mk_ult = Z3native.mk_bvult
+ let mk_slt = Z3native.mk_bvslt
+ let mk_ule = Z3native.mk_bvule
+ let mk_sle = Z3native.mk_bvsle
+ let mk_uge = Z3native.mk_bvuge
+ let mk_sge = Z3native.mk_bvsge
+ let mk_ugt = Z3native.mk_bvugt
+ let mk_sgt = Z3native.mk_bvsgt
+ let mk_concat = Z3native.mk_concat
+ let mk_extract = Z3native.mk_extract
+ let mk_sign_ext = Z3native.mk_sign_ext
+ let mk_zero_ext = Z3native.mk_zero_ext
+ let mk_repeat = Z3native.mk_repeat
+ let mk_shl = Z3native.mk_bvshl
+ let mk_lshr = Z3native.mk_bvlshr
+ let mk_ashr = Z3native.mk_bvashr
+ let mk_rotate_left = Z3native.mk_rotate_left
+ let mk_rotate_right = Z3native.mk_rotate_right
+ let mk_ext_rotate_left = Z3native.mk_ext_rotate_left
+ let mk_ext_rotate_right = Z3native.mk_ext_rotate_right
+ let mk_bv2int = Z3native.mk_bv2int
+ let mk_add_no_overflow = Z3native.mk_bvadd_no_overflow
+ let mk_add_no_underflow = Z3native.mk_bvadd_no_underflow
+ let mk_sub_no_overflow = Z3native.mk_bvsub_no_overflow
+ let mk_sub_no_underflow = Z3native.mk_bvsub_no_underflow
+ let mk_sdiv_no_overflow = Z3native.mk_bvsdiv_no_overflow
+ let mk_neg_no_overflow = Z3native.mk_bvneg_no_overflow
+ let mk_mul_no_overflow = Z3native.mk_bvmul_no_overflow
+ let mk_mul_no_underflow = Z3native.mk_bvmul_no_underflow
+ let mk_numeral ctx v size = Z3native.mk_numeral ctx v (mk_sort ctx size)
end
-module FloatingPoint =
+module FloatingPoint =
struct
- module RoundingMode =
+ module RoundingMode =
struct
- let mk_sort ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_rounding_mode_sort (context_gno ctx)))
- let is_fprm ( x : expr ) =
- (Sort.get_sort_kind (Expr.get_sort(x))) == ROUNDING_MODE_SORT
- let mk_round_nearest_ties_to_even ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_round_nearest_ties_to_even (context_gno ctx)))
- let mk_rne ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_rne (context_gno ctx)))
- let mk_round_nearest_ties_to_away ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_round_nearest_ties_to_away (context_gno ctx)))
- let mk_rna ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_rna (context_gno ctx)))
- let mk_round_toward_positive ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_round_toward_positive (context_gno ctx)))
- let mk_rtp ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_rtp (context_gno ctx)))
- let mk_round_toward_negative ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_round_toward_negative (context_gno ctx)))
- let mk_rtn ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_rtn (context_gno ctx)))
- let mk_round_toward_zero ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_round_toward_zero (context_gno ctx)))
- let mk_rtz ( ctx : context ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_rtz (context_gno ctx)))
+ let mk_sort = Z3native.mk_fpa_rounding_mode_sort
+ let is_fprm x = Sort.get_sort_kind (Expr.get_sort x) = ROUNDING_MODE_SORT
+ let mk_round_nearest_ties_to_even = Z3native.mk_fpa_round_nearest_ties_to_even
+ let mk_rne = Z3native.mk_fpa_rne
+ let mk_round_nearest_ties_to_away = Z3native.mk_fpa_round_nearest_ties_to_away
+ let mk_rna = Z3native.mk_fpa_rna
+ let mk_round_toward_positive = Z3native.mk_fpa_round_toward_positive
+ let mk_rtp = Z3native.mk_fpa_rtp
+ let mk_round_toward_negative = Z3native.mk_fpa_round_toward_negative
+ let mk_rtn = Z3native.mk_fpa_rtn
+ let mk_round_toward_zero = Z3native.mk_fpa_round_toward_zero
+ let mk_rtz = Z3native.mk_fpa_rtz
end
-
- let mk_sort ( ctx : context ) ( ebits : int ) ( sbits : int ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_sort (context_gno ctx) ebits sbits))
- let mk_sort_half ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_sort_half (context_gno ctx)))
- let mk_sort_16 ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_sort_16 (context_gno ctx)))
- let mk_sort_single ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_sort_single (context_gno ctx)))
- let mk_sort_32 ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_sort_32 (context_gno ctx)))
- let mk_sort_double ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_sort_double (context_gno ctx)))
- let mk_sort_64 ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_sort_64 (context_gno ctx)))
- let mk_sort_quadruple ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_sort_quadruple (context_gno ctx)))
- let mk_sort_128 ( ctx : context ) =
- (Sort.sort_of_ptr ctx (Z3native.mk_fpa_sort_128 (context_gno ctx)))
- let mk_nan ( ctx : context ) ( s : Sort.sort ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_nan (context_gno ctx) (Sort.gno s)))
- let mk_inf ( ctx : context ) ( s : Sort.sort ) ( negative : bool ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_inf (context_gno ctx) (Sort.gno s) negative))
- let mk_zero ( ctx : context ) ( s : Sort.sort ) ( negative : bool ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_zero (context_gno ctx) (Sort.gno s) negative))
+ let mk_sort = Z3native.mk_fpa_sort
+ let mk_sort_half = Z3native.mk_fpa_sort_half
+ let mk_sort_16 = Z3native.mk_fpa_sort_16
+ let mk_sort_single = Z3native.mk_fpa_sort_single
+ let mk_sort_32 = Z3native.mk_fpa_sort_32
+ let mk_sort_double = Z3native.mk_fpa_sort_double
+ let mk_sort_64 = Z3native.mk_fpa_sort_64
+ let mk_sort_quadruple = Z3native.mk_fpa_sort_quadruple
+ let mk_sort_128 = Z3native.mk_fpa_sort_128
- let mk_fp ( ctx : context ) ( sign : expr ) ( exponent : expr ) ( significand : expr ) =
- apply3 ctx Z3native.mk_fpa_fp sign exponent significand
- let mk_numeral_f ( ctx : context ) ( value : float ) ( s : Sort.sort ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_numeral_double (context_gno ctx) value (Sort.gno s)))
- let mk_numeral_i ( ctx : context ) ( value : int ) ( s : Sort.sort ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_numeral_int (context_gno ctx) value (Sort.gno s)))
- let mk_numeral_i_u ( ctx : context ) ( sign : bool ) ( exponent : int ) ( significand : int ) ( s : Sort.sort ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_numeral_int64_uint64 (context_gno ctx) sign exponent significand (Sort.gno s)))
- let mk_numeral_s ( ctx : context ) ( v : string ) ( s : Sort.sort ) =
- (expr_of_ptr ctx (Z3native.mk_numeral (context_gno ctx) v (Sort.gno s)))
+ let mk_nan = Z3native.mk_fpa_nan
+ let mk_inf = Z3native.mk_fpa_inf
+ let mk_zero = Z3native.mk_fpa_zero
+ let mk_fp = Z3native.mk_fpa_fp
+ let mk_numeral_f = Z3native.mk_fpa_numeral_double
+ let mk_numeral_i = Z3native.mk_fpa_numeral_int
+ let mk_numeral_i_u = Z3native.mk_fpa_numeral_int64_uint64
+ let mk_numeral_s = Z3native.mk_numeral
- let is_fp ( x : expr ) = (Sort.get_sort_kind (Expr.get_sort x)) == FLOATING_POINT_SORT
- let is_abs ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_ABS)
- let is_neg ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_NEG)
- let is_add ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_ADD)
- let is_sub ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_SUB)
- let is_mul ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_MUL)
- let is_div ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_DIV)
- let is_fma ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_FMA)
- let is_sqrt ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_SQRT)
- let is_rem ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_REM)
- let is_round_to_integral ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_ROUND_TO_INTEGRAL)
- let is_min ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_MIN)
- let is_max ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_MAX)
- let is_leq ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_LE)
- let is_lt ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_LT)
- let is_geq ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_GE)
- let is_gt ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_GT)
- let is_eq ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_EQ)
- let is_is_normal ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_IS_NORMAL)
- let is_is_subnormal ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_IS_SUBNORMAL)
- let is_is_zero ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_IS_ZERO)
- let is_is_infinite ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_IS_INF)
- let is_is_nan ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_IS_NAN)
- let is_is_negative ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_IS_NEGATIVE)
- let is_is_positive ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_IS_POSITIVE)
- let is_to_fp ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_TO_FP)
- let is_to_fp_unsigned ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_TO_FP_UNSIGNED)
- let is_to_ubv ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_TO_UBV)
- let is_to_sbv ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_TO_SBV)
- let is_to_real ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_TO_REAL)
- let is_to_ieee_bv ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FPA_TO_IEEE_BV)
-
- let numeral_to_string ( x : expr ) = Z3native.get_numeral_string (Expr.gnc x) (Expr.gno x)
- let mk_const ( ctx : context ) ( name : Symbol.symbol ) ( s : Sort.sort ) =
- Expr.mk_const ctx name s
- let mk_const_s ( ctx : context ) ( name : string ) ( s : Sort.sort ) =
- mk_const ctx (Symbol.mk_string ctx name) s
+ let is_fp (x:expr) = (Sort.get_sort_kind (Expr.get_sort x)) = FLOATING_POINT_SORT
+ let is_abs (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_ABS)
+ let is_neg (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_NEG)
+ let is_add (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_ADD)
+ let is_sub (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_SUB)
+ let is_mul (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_MUL)
+ let is_div (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_DIV)
+ let is_fma (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_FMA)
+ let is_sqrt (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_SQRT)
+ let is_rem (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_REM)
+ let is_round_to_integral (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_ROUND_TO_INTEGRAL)
+ let is_min (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_MIN)
+ let is_max (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_MAX)
+ let is_leq (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_LE)
+ let is_lt (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_LT)
+ let is_geq (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_GE)
+ let is_gt (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_GT)
+ let is_eq (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_EQ)
+ let is_is_normal (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_IS_NORMAL)
+ let is_is_subnormal (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_IS_SUBNORMAL)
+ let is_is_zero (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_IS_ZERO)
+ let is_is_infinite (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_IS_INF)
+ let is_is_nan (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_IS_NAN)
+ let is_is_negative (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_IS_NEGATIVE)
+ let is_is_positive (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_IS_POSITIVE)
+ let is_to_fp (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_TO_FP)
+ let is_to_fp_unsigned (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_TO_FP_UNSIGNED)
+ let is_to_ubv (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_TO_UBV)
+ let is_to_sbv (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_TO_SBV)
+ let is_to_real (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_TO_REAL)
+ let is_to_ieee_bv (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_TO_IEEE_BV)
- let mk_abs ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_abs t
- let mk_neg ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_neg t
- let mk_add ( ctx : context ) ( rm : expr ) ( t1 : expr ) ( t2 : expr ) = apply3 ctx Z3native.mk_fpa_add rm t1 t2
- let mk_sub ( ctx : context ) ( rm : expr ) ( t1 : expr ) ( t2 : expr ) = apply3 ctx Z3native.mk_fpa_sub rm t1 t2
- let mk_mul ( ctx : context ) ( rm : expr ) ( t1 : expr ) ( t2 : expr ) = apply3 ctx Z3native.mk_fpa_mul rm t1 t2
- let mk_div ( ctx : context ) ( rm : expr ) ( t1 : expr ) ( t2 : expr ) = apply3 ctx Z3native.mk_fpa_div rm t1 t2
- let mk_fma ( ctx : context ) ( rm : expr ) ( t1 : expr ) ( t2 : expr ) ( t3 : expr ) = apply4 ctx Z3native.mk_fpa_fma rm t1 t2 t3
- let mk_sqrt ( ctx : context ) ( rm : expr ) ( t : expr ) = apply2 ctx Z3native.mk_fpa_sqrt rm t
- let mk_rem ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_fpa_rem t1 t2
- let mk_round_to_integral ( ctx : context ) ( rm : expr ) ( t : expr ) = apply2 ctx Z3native.mk_fpa_round_to_integral rm t
- let mk_min ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_fpa_min t1 t2
- let mk_max ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_fpa_max t1 t2
- let mk_leq ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_fpa_leq t1 t2
- let mk_lt ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_fpa_lt t1 t2
- let mk_geq ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_fpa_geq t1 t2
- let mk_gt ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_fpa_gt t1 t2
- let mk_eq ( ctx : context ) ( t1 : expr ) ( t2 : expr ) = apply2 ctx Z3native.mk_fpa_eq t1 t2
- let mk_is_normal ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_is_normal t
- let mk_is_subnormal ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_is_subnormal t
- let mk_is_zero ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_is_zero t
- let mk_is_infinite ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_is_infinite t
- let mk_is_nan ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_is_nan t
- let mk_is_negative ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_is_negative t
- let mk_is_positive ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_is_positive t
- let mk_to_fp_bv ( ctx : context ) ( t : expr ) ( s : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_fpa_to_fp_bv (context_gno ctx) (Expr.gno t) (Sort.gno s))
- let mk_to_fp_float ( ctx : context ) ( rm : expr) ( t : expr ) ( s : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_fpa_to_fp_float (context_gno ctx) (Expr.gno rm) (Expr.gno t) (Sort.gno s))
- let mk_to_fp_real ( ctx : context ) ( rm : expr ) ( t : expr ) ( s : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_fpa_to_fp_real (context_gno ctx) (Expr.gno rm) (Expr.gno t) (Sort.gno s))
- let mk_to_fp_signed ( ctx : context ) ( rm : expr) ( t : expr ) ( s : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_fpa_to_fp_signed (context_gno ctx) (Expr.gno rm) (Expr.gno t) (Sort.gno s))
- let mk_to_fp_unsigned ( ctx : context ) ( rm : expr) ( t : expr ) ( s : Sort.sort ) =
- expr_of_ptr ctx (Z3native.mk_fpa_to_fp_unsigned (context_gno ctx) (Expr.gno rm) (Expr.gno t) (Sort.gno s))
- let mk_to_ubv ( ctx : context ) ( rm : expr) ( t : expr ) ( size : int ) =
- expr_of_ptr ctx (Z3native.mk_fpa_to_ubv (context_gno ctx) (Expr.gno rm) (Expr.gno t) size)
- let mk_to_sbv ( ctx : context ) ( rm : expr) ( t : expr ) ( size : int ) =
- expr_of_ptr ctx (Z3native.mk_fpa_to_sbv (context_gno ctx) (Expr.gno rm) (Expr.gno t) size)
- let mk_to_real ( ctx : context ) ( t : expr ) = apply1 ctx Z3native.mk_fpa_to_real t
+ let numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) x
- let get_ebits ( ctx : context ) ( s : Sort.sort ) =
- (Z3native.fpa_get_ebits (context_gno ctx) (Sort.gno s))
- let get_sbits ( ctx : context ) ( s : Sort.sort ) =
- (Z3native.fpa_get_sbits (context_gno ctx) (Sort.gno s))
- let get_numeral_sign ( ctx : context ) ( t : expr ) =
- (Z3native.fpa_get_numeral_sign (context_gno ctx) (Expr.gno t))
- let get_numeral_significand_string ( ctx : context ) ( t : expr ) =
- (Z3native.fpa_get_numeral_significand_string (context_gno ctx) (Expr.gno t))
- let get_numeral_significand_uint ( ctx : context ) ( t : expr ) =
- (Z3native.fpa_get_numeral_significand_uint64 (context_gno ctx) (Expr.gno t))
- let get_numeral_exponent_string ( ctx : context ) ( t : expr ) =
- (Z3native.fpa_get_numeral_exponent_string (context_gno ctx) (Expr.gno t))
- let get_numeral_exponent_int ( ctx : context ) ( t : expr ) =
- (Z3native.fpa_get_numeral_exponent_int64 (context_gno ctx) (Expr.gno t))
+ let mk_const = Expr.mk_const
+ let mk_const_s = Expr.mk_const_s
- let mk_to_ieee_bv ( ctx : context ) ( t : expr ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_to_ieee_bv (context_gno ctx) (Expr.gno t)))
- let mk_to_fp_int_real ( ctx : context ) ( rm : expr ) ( exponent : expr ) ( significand : expr ) ( s : Sort.sort ) =
- (expr_of_ptr ctx (Z3native.mk_fpa_to_fp_int_real (context_gno ctx) (Expr.gno rm) (Expr.gno exponent) (Expr.gno significand) (Sort.gno s)))
-
- let numeral_to_string ( x : expr ) = Z3native.get_numeral_string (Expr.gnc x) (Expr.gno x)
+ let mk_abs = Z3native.mk_fpa_abs
+ let mk_neg = Z3native.mk_fpa_neg
+ let mk_add = Z3native.mk_fpa_add
+ let mk_sub = Z3native.mk_fpa_sub
+ let mk_mul = Z3native.mk_fpa_mul
+ let mk_div = Z3native.mk_fpa_div
+ let mk_fma = Z3native.mk_fpa_fma
+ let mk_sqrt = Z3native.mk_fpa_sqrt
+ let mk_rem = Z3native.mk_fpa_rem
+ let mk_round_to_integral = Z3native.mk_fpa_round_to_integral
+ let mk_min = Z3native.mk_fpa_min
+ let mk_max = Z3native.mk_fpa_max
+ let mk_leq = Z3native.mk_fpa_leq
+ let mk_lt = Z3native.mk_fpa_lt
+ let mk_geq = Z3native.mk_fpa_geq
+ let mk_gt = Z3native.mk_fpa_gt
+ let mk_eq = Z3native.mk_fpa_eq
+ let mk_is_normal = Z3native.mk_fpa_is_normal
+ let mk_is_subnormal = Z3native.mk_fpa_is_subnormal
+ let mk_is_zero = Z3native.mk_fpa_is_zero
+ let mk_is_infinite = Z3native.mk_fpa_is_infinite
+ let mk_is_nan = Z3native.mk_fpa_is_nan
+ let mk_is_negative = Z3native.mk_fpa_is_negative
+ let mk_is_positive = Z3native.mk_fpa_is_positive
+ let mk_to_fp_bv = Z3native.mk_fpa_to_fp_bv
+ let mk_to_fp_float = Z3native.mk_fpa_to_fp_float
+ let mk_to_fp_real = Z3native.mk_fpa_to_fp_real
+ let mk_to_fp_signed = Z3native.mk_fpa_to_fp_signed
+ let mk_to_fp_unsigned = Z3native.mk_fpa_to_fp_unsigned
+ let mk_to_ubv = Z3native.mk_fpa_to_ubv
+ let mk_to_sbv = Z3native.mk_fpa_to_sbv
+ let mk_to_real = Z3native.mk_fpa_to_real
+ let get_ebits = Z3native.fpa_get_ebits
+ let get_sbits = Z3native.fpa_get_sbits
+ let get_numeral_sign = Z3native.fpa_get_numeral_sign
+ let get_numeral_significand_string = Z3native.fpa_get_numeral_significand_string
+ let get_numeral_significand_uint = Z3native.fpa_get_numeral_significand_uint64
+ let get_numeral_exponent_string = Z3native.fpa_get_numeral_exponent_string
+ let get_numeral_exponent_int = Z3native.fpa_get_numeral_exponent_int64
+ let mk_to_ieee_bv = Z3native.mk_fpa_to_ieee_bv
+ let mk_to_fp_int_real = Z3native.mk_fpa_to_fp_int_real
+ let numeral_to_string x = Z3native.get_numeral_string (Expr.gc x) x
end
-module Proof =
+module Proof =
struct
- let is_true ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_TRUE)
- let is_asserted ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_ASSERTED)
- let is_goal ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_GOAL)
- let is_oeq ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_OEQ)
- let is_modus_ponens ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_MODUS_PONENS)
- let is_reflexivity ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_REFLEXIVITY)
- let is_symmetry ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_SYMMETRY)
- let is_transitivity ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_TRANSITIVITY)
- let is_Transitivity_star ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_TRANSITIVITY_STAR)
- let is_monotonicity ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_MONOTONICITY)
- let is_quant_intro ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_QUANT_INTRO)
- let is_distributivity ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_DISTRIBUTIVITY)
- let is_and_elimination ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_AND_ELIM)
- let is_or_elimination ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_NOT_OR_ELIM)
- let is_rewrite ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_REWRITE)
- let is_rewrite_star ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_REWRITE_STAR)
- let is_pull_quant ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_PULL_QUANT)
- let is_pull_quant_star ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_PULL_QUANT_STAR)
- let is_push_quant ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_PUSH_QUANT)
- let is_elim_unused_vars ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_ELIM_UNUSED_VARS)
- let is_der ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_DER)
- let is_quant_inst ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_QUANT_INST)
- let is_hypothesis ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_HYPOTHESIS)
- let is_lemma ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_LEMMA)
- let is_unit_resolution ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_UNIT_RESOLUTION)
- let is_iff_true ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_IFF_TRUE)
- let is_iff_false ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_IFF_FALSE)
- let is_commutativity ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_COMMUTATIVITY) (* *)
- let is_def_axiom ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_DEF_AXIOM)
- let is_def_intro ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_DEF_INTRO)
- let is_apply_def ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_APPLY_DEF)
- let is_iff_oeq ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_IFF_OEQ)
- let is_nnf_pos ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_NNF_POS)
- let is_nnf_neg ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_NNF_NEG)
- let is_nnf_star ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_NNF_STAR)
- let is_cnf_star ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_CNF_STAR)
- let is_skolemize ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_SKOLEMIZE)
- let is_modus_ponens_oeq ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_MODUS_PONENS_OEQ)
- let is_theory_lemma ( x : expr ) = (AST.is_app (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_PR_TH_LEMMA)
+ let is_true (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_TRUE)
+ let is_asserted (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_ASSERTED)
+ let is_goal (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_GOAL)
+ let is_oeq (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_OEQ)
+ let is_modus_ponens (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_MODUS_PONENS)
+ let is_reflexivity (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_REFLEXIVITY)
+ let is_symmetry (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_SYMMETRY)
+ let is_transitivity (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_TRANSITIVITY)
+ let is_Transitivity_star (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_TRANSITIVITY_STAR)
+ let is_monotonicity (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_MONOTONICITY)
+ let is_quant_intro (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_QUANT_INTRO)
+ let is_distributivity (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_DISTRIBUTIVITY)
+ let is_and_elimination (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_AND_ELIM)
+ let is_or_elimination (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_NOT_OR_ELIM)
+ let is_rewrite (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_REWRITE)
+ let is_rewrite_star (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_REWRITE_STAR)
+ let is_pull_quant (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_PULL_QUANT)
+ let is_pull_quant_star (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_PULL_QUANT_STAR)
+ let is_push_quant (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_PUSH_QUANT)
+ let is_elim_unused_vars (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_ELIM_UNUSED_VARS)
+ let is_der (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_DER)
+ let is_quant_inst (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_QUANT_INST)
+ let is_hypothesis (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_HYPOTHESIS)
+ let is_lemma (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_LEMMA)
+ let is_unit_resolution (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_UNIT_RESOLUTION)
+ let is_iff_true (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_IFF_TRUE)
+ let is_iff_false (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_IFF_FALSE)
+ let is_commutativity (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_COMMUTATIVITY) (* *)
+ let is_def_axiom (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_DEF_AXIOM)
+ let is_def_intro (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_DEF_INTRO)
+ let is_apply_def (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_APPLY_DEF)
+ let is_iff_oeq (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_IFF_OEQ)
+ let is_nnf_pos (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_NNF_POS)
+ let is_nnf_neg (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_NNF_NEG)
+ let is_nnf_star (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_NNF_STAR)
+ let is_cnf_star (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_CNF_STAR)
+ let is_skolemize (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_SKOLEMIZE)
+ let is_modus_ponens_oeq (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_MODUS_PONENS_OEQ)
+ let is_theory_lemma (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_PR_TH_LEMMA)
end
module Goal =
-struct
- type goal = z3_native_object
+struct
+ type goal = Z3native.goal
+ let gc = Z3native.context_of_goal
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : goal = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.goal_inc_ref ;
- dec_ref = Z3native.goal_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
- let get_precision ( x : goal ) =
- goal_prec_of_int (Z3native.goal_precision (z3obj_gnc x) (z3obj_gno x))
-
- let is_precise ( x : goal ) =
- (get_precision x) == GOAL_PRECISE
-
- let is_underapproximation ( x : goal ) =
- (get_precision x) == GOAL_UNDER
+ let get_precision (x:goal) = goal_prec_of_int (Z3native.goal_precision (gc x) x)
+ let is_precise (x:goal) = (get_precision x) = GOAL_PRECISE
+ let is_underapproximation (x:goal) = (get_precision x) = GOAL_UNDER
+ let is_overapproximation (x:goal) = (get_precision x) = GOAL_OVER
+ let is_garbage (x:goal) = (get_precision x) = GOAL_UNDER_OVER
- let is_overapproximation ( x : goal ) =
- (get_precision x) == GOAL_OVER
-
- let is_garbage ( x : goal ) =
- (get_precision x) == GOAL_UNDER_OVER
-
- let add ( x : goal ) ( constraints : expr list ) =
- let f e = Z3native.goal_assert (z3obj_gnc x) (z3obj_gno x) (Expr.gno e) in
- ignore (List.map f constraints) ;
- ()
-
- let is_inconsistent ( x : goal ) =
- Z3native.goal_inconsistent (z3obj_gnc x) (z3obj_gno x)
+ let add x constraints =
+ List.iter (Z3native.goal_assert (gc x) x) constraints
- let get_depth ( x : goal ) = Z3native.goal_depth (z3obj_gnc x) (z3obj_gno x)
-
- let reset ( x : goal ) = Z3native.goal_reset (z3obj_gnc x) (z3obj_gno x)
-
- let get_size ( x : goal ) = Z3native.goal_size (z3obj_gnc x) (z3obj_gno x)
+ let is_inconsistent (x:goal) = Z3native.goal_inconsistent (gc x) x
+ let get_depth (x:goal) = Z3native.goal_depth (gc x) x
+ let reset (x:goal) = Z3native.goal_reset (gc x) x
+ let get_size (x:goal) = Z3native.goal_size (gc x) x
- let get_formulas ( x : goal ) =
- let n = get_size x in
- let f i = ((expr_of_ptr (z3obj_gc x)
- (Z3native.goal_formula (z3obj_gnc x) (z3obj_gno x) i))) in
+ let get_formulas (x:goal) =
+ let n = get_size x in
+ let f i = Z3native.goal_formula (gc x) x i in
mk_list f n
- let get_num_exprs ( x : goal ) = Z3native.goal_num_exprs (z3obj_gnc x) (z3obj_gno x)
-
- let is_decided_sat ( x : goal ) =
- Z3native.goal_is_decided_sat (z3obj_gnc x) (z3obj_gno x)
-
- let is_decided_unsat ( x : goal ) =
- Z3native.goal_is_decided_unsat (z3obj_gnc x) (z3obj_gno x)
-
- let translate ( x : goal ) ( to_ctx : context ) =
- create to_ctx (Z3native.goal_translate (z3obj_gnc x) (z3obj_gno x) (context_gno to_ctx))
+ let get_num_exprs (x:goal) = Z3native.goal_num_exprs (gc x) x
+ let is_decided_sat (x:goal) = Z3native.goal_is_decided_sat (gc x) x
+ let is_decided_unsat (x:goal) = Z3native.goal_is_decided_unsat (gc x) x
+ let translate (x:goal) (to_ctx:context) = Z3native.goal_translate (gc x) x to_ctx
- let simplify ( x : goal ) ( p : Params.params option ) =
- let tn = Z3native.mk_tactic (z3obj_gnc x) "simplify" in
- Z3native.tactic_inc_ref (z3obj_gnc x) tn ;
+ let simplify (x:goal) (p:Params.params option) =
+ let tn = Z3native.mk_tactic (gc x) "simplify" in
+ Z3native.tactic_inc_ref (gc x) tn;
let arn = match p with
- | None -> Z3native.tactic_apply (z3obj_gnc x) tn (z3obj_gno x)
- | Some(pn) -> Z3native.tactic_apply_ex (z3obj_gnc x) tn (z3obj_gno x) (z3obj_gno pn)
+ | None -> Z3native.tactic_apply (gc x) tn x
+ | Some pn -> Z3native.tactic_apply_ex (gc x) tn x pn
in
- Z3native.apply_result_inc_ref (z3obj_gnc x) arn ;
- let sg = Z3native.apply_result_get_num_subgoals (z3obj_gnc x) arn in
- let res = if sg == 0 then
- raise (Z3native.Exception "No subgoals")
- else
- Z3native.apply_result_get_subgoal (z3obj_gnc x) arn 0 in
- Z3native.apply_result_dec_ref (z3obj_gnc x) arn ;
- Z3native.tactic_dec_ref (z3obj_gnc x) tn ;
- create (z3obj_gc x) res
+ Z3native.apply_result_inc_ref (gc x) arn;
+ let sg = Z3native.apply_result_get_num_subgoals (gc x) arn in
+ let res = if sg = 0 then
+ raise (Error "No subgoals")
+ else
+ Z3native.apply_result_get_subgoal (gc x) arn 0 in
+ Z3native.apply_result_dec_ref (gc x) arn;
+ Z3native.tactic_dec_ref (gc x) tn;
+ res
- let mk_goal ( ctx : context ) ( models : bool ) ( unsat_cores : bool ) ( proofs : bool ) =
- create ctx (Z3native.mk_goal (context_gno ctx) models unsat_cores proofs)
+ let mk_goal = Z3native.mk_goal
- let to_string ( x : goal ) = Z3native.goal_to_string (z3obj_gnc x) (z3obj_gno x)
+ let to_string (x:goal) = Z3native.goal_to_string (gc x) x
- let as_expr ( x : goal ) =
- let n = get_size x in
- if n = 0 then
- (Boolean.mk_true (z3obj_gc x))
- else if n = 1 then
- (List.hd (get_formulas x))
- else
- (Boolean.mk_and (z3obj_gc x) (get_formulas x))
-end
+ let as_expr (x:goal) =
+ match get_size x with
+ | 0 -> Boolean.mk_true (gc x)
+ | 1 -> List.hd (get_formulas x)
+ | _ -> Boolean.mk_and (gc x) (get_formulas x)
+end
module Model =
struct
- type model = z3_native_object
+ type model = Z3native.model
+ let gc = Z3native.context_of_model
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : model = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.model_inc_ref ;
- dec_ref = Z3native.model_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
module FuncInterp =
struct
- type func_interp = z3_native_object
+ type func_interp = Z3native.func_interp
+ let gc = Z3native.context_of_func_interp
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : func_interp = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.func_interp_inc_ref ;
- dec_ref = Z3native.func_interp_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
module FuncEntry =
- struct
- type func_entry = z3_native_object
-
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : func_entry = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.func_entry_inc_ref ;
- dec_ref = Z3native.func_entry_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
- let get_value ( x : func_entry ) =
- expr_of_ptr (z3obj_gc x) (Z3native.func_entry_get_value (z3obj_gnc x) (z3obj_gno x))
+ struct
+ type func_entry = Z3native.func_entry
+ let gc = Z3native.context_of_func_entry
- let get_num_args ( x : func_entry ) = Z3native.func_entry_get_num_args (z3obj_gnc x) (z3obj_gno x)
-
- let get_args ( x : func_entry ) =
- let n = (get_num_args x) in
- let f i = (expr_of_ptr (z3obj_gc x) (Z3native.func_entry_get_arg (z3obj_gnc x) (z3obj_gno x) i)) in
- mk_list f n
-
- let to_string ( x : func_entry ) =
- let a = (get_args x) in
- let f c p = (p ^ (Expr.to_string c) ^ ", ") in
- "[" ^ List.fold_right f a ((Expr.to_string (get_value x)) ^ "]")
+ let get_value (x:func_entry) = Z3native.func_entry_get_value (gc x) x
+ let get_num_args (x:func_entry) = Z3native.func_entry_get_num_args (gc x) x
+
+ let get_args (x:func_entry) =
+ let n = get_num_args x in
+ let f i = Z3native.func_entry_get_arg (gc x) x i in
+ mk_list f n
+
+ let to_string (x:func_entry) =
+ let a = get_args x in
+ let f c p = (p ^ (Expr.to_string c) ^ ", ") in
+ "[" ^ List.fold_right f a ((Expr.to_string (get_value x)) ^ "]")
end
- let get_num_entries ( x: func_interp ) = Z3native.func_interp_get_num_entries (z3obj_gnc x) (z3obj_gno x)
+ let get_num_entries (x:func_interp) = Z3native.func_interp_get_num_entries (gc x) x
- let get_entries ( x : func_interp ) =
- let n = (get_num_entries x) in
- let f i = (FuncEntry.create (z3obj_gc x) (Z3native.func_interp_get_entry (z3obj_gnc x) (z3obj_gno x) i)) in
+ let get_entries (x:func_interp) =
+ let n = get_num_entries x in
+ let f i = Z3native.func_interp_get_entry (gc x) x i in
mk_list f n
- let get_else ( x : func_interp ) = expr_of_ptr (z3obj_gc x) (Z3native.func_interp_get_else (z3obj_gnc x) (z3obj_gno x))
+ let get_else (x:func_interp) = Z3native.func_interp_get_else (gc x) x
- let get_arity ( x : func_interp ) = Z3native.func_interp_get_arity (z3obj_gnc x) (z3obj_gno x)
+ let get_arity (x:func_interp) = Z3native.func_interp_get_arity (gc x) x
- let to_string ( x : func_interp ) =
+ let to_string (x:func_interp) =
let f c p = (
- let n = (FuncEntry.get_num_args c) in
- p ^
- let g c p = (p ^ (Expr.to_string c) ^ ", ") in
- (if n > 1 then "[" else "") ^
- (List.fold_right
- g
- (FuncEntry.get_args c)
- ((if n > 1 then "]" else "") ^ " -> " ^ (Expr.to_string (FuncEntry.get_value c)) ^ ", "))
- ) in
+ let n = FuncEntry.get_num_args c in
+ p ^
+ let g c p = (p ^ (Expr.to_string c) ^ ", ") in
+ (if n > 1 then "[" else "") ^
+ (List.fold_right
+ g
+ (FuncEntry.get_args c)
+ ((if n > 1 then "]" else "") ^ " -> " ^ (Expr.to_string (FuncEntry.get_value c)) ^ ", "))) in
List.fold_right f (get_entries x) ("else -> " ^ (Expr.to_string (get_else x)) ^ "]")
end
-
- let get_const_interp ( x : model ) ( f : func_decl ) =
- if (FuncDecl.get_arity f) != 0 ||
- (sort_kind_of_int (Z3native.get_sort_kind (FuncDecl.gnc f) (Z3native.get_range (FuncDecl.gnc f) (FuncDecl.gno f)))) == ARRAY_SORT then
- raise (Z3native.Exception "Non-zero arity functions and arrays have FunctionInterpretations as a model. Use FuncInterp.")
+
+ let get_const_interp (x:model) (f:func_decl) =
+ if FuncDecl.get_arity f <> 0 ||
+ (sort_kind_of_int (Z3native.get_sort_kind (FuncDecl.gc f) (Z3native.get_range (FuncDecl.gc f) f))) = ARRAY_SORT then
+ raise (Error "Non-zero arity functions and arrays have FunctionInterpretations as a model. Use FuncInterp.")
else
- let np = Z3native.model_get_const_interp (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno f) in
- if (Z3native.is_null np) then
- None
+ let np = Z3native.model_get_const_interp (gc x) x f in
+ if Z3native.is_null_ast np then
+ None
else
- Some (expr_of_ptr (z3obj_gc x) np)
+ Some np
- let get_const_interp_e ( x : model ) ( a : expr ) = get_const_interp x (Expr.get_func_decl a)
+ let get_const_interp_e (x:model) (a:expr) = get_const_interp x (Expr.get_func_decl a)
-
- let rec get_func_interp ( x : model ) ( f : func_decl ) =
- let sk = (sort_kind_of_int (Z3native.get_sort_kind (z3obj_gnc x) (Z3native.get_range (FuncDecl.gnc f) (FuncDecl.gno f)))) in
- if (FuncDecl.get_arity f) == 0 then
- let n = Z3native.model_get_const_interp (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno f) in
- if (Z3native.is_null n) then
- None
- else
- match sk with
- | ARRAY_SORT ->
- if not (Z3native.is_as_array (z3obj_gnc x) n) then
- raise (Z3native.Exception "Argument was not an array constant")
- else
- let fd = Z3native.get_as_array_func_decl (z3obj_gnc x) n in
- get_func_interp x (func_decl_of_ptr (z3obj_gc x) fd)
- | _ -> raise (Z3native.Exception "Constant functions do not have a function interpretation; use ConstInterp");
+ let rec get_func_interp (x:model) (f:func_decl) =
+ let sk = sort_kind_of_int (Z3native.get_sort_kind (gc x) (Z3native.get_range (FuncDecl.gc f) f)) in
+ if FuncDecl.get_arity f = 0 then
+ let n = Z3native.model_get_const_interp (gc x) x f in
+ if Z3native.is_null_ast n then
+ None
+ else
+ match sk with
+ | ARRAY_SORT ->
+ if not (Z3native.is_as_array (gc x) n) then
+ raise (Error "Argument was not an array constant")
+ else
+ let fd = Z3native.get_as_array_func_decl (gc x) n in
+ get_func_interp x fd
+ | _ -> raise (Error "Constant functions do not have a function interpretation; use ConstInterp");
else
- let n = (Z3native.model_get_func_interp (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno f)) in
- if (Z3native.is_null n) then None else Some (FuncInterp.create (z3obj_gc x) n)
-
+ let n = Z3native.model_get_func_interp (gc x) x f in
+ if Z3native.is_null_func_interp n then None else Some n
+
(** The number of constants that have an interpretation in the model. *)
- let get_num_consts ( x : model ) = Z3native.model_get_num_consts (z3obj_gnc x) (z3obj_gno x)
-
- let get_const_decls ( x : model ) =
+ let get_num_consts (x:model) = Z3native.model_get_num_consts (gc x) x
+
+ let get_const_decls (x:model) =
let n = (get_num_consts x) in
- let f i = func_decl_of_ptr (z3obj_gc x) (Z3native.model_get_const_decl (z3obj_gnc x) (z3obj_gno x) i) in
+ let f i = Z3native.model_get_const_decl (gc x) x i in
mk_list f n
-
- let get_num_funcs ( x : model ) = Z3native.model_get_num_funcs (z3obj_gnc x) (z3obj_gno x)
-
- let get_func_decls ( x : model ) =
+
+ let get_num_funcs (x:model) = Z3native.model_get_num_funcs (gc x) x
+
+ let get_func_decls (x:model) =
let n = (get_num_funcs x) in
- let f i = func_decl_of_ptr (z3obj_gc x) (Z3native.model_get_func_decl (z3obj_gnc x) (z3obj_gno x) i) in
+ let f i = Z3native.model_get_func_decl (gc x) x i in
mk_list f n
-
- let get_decls ( x : model ) =
- let n_funcs = (get_num_funcs x) in
- let n_consts = (get_num_consts x ) in
- let f i = func_decl_of_ptr (z3obj_gc x) (Z3native.model_get_func_decl (z3obj_gnc x) (z3obj_gno x) i) in
- let g i = func_decl_of_ptr (z3obj_gc x) (Z3native.model_get_const_decl (z3obj_gnc x) (z3obj_gno x) i) in
+
+ let get_decls (x:model) =
+ let n_funcs = get_num_funcs x in
+ let n_consts = get_num_consts x in
+ let f i = Z3native.model_get_func_decl (gc x) x i in
+ let g i = Z3native.model_get_const_decl (gc x) x i in
(mk_list f n_funcs) @ (mk_list g n_consts)
-
- let eval ( x : model ) ( t : expr ) ( completion : bool ) =
- let (r, v) = (Z3native.model_eval (z3obj_gnc x) (z3obj_gno x) (Expr.gno t) completion) in
- if not r then
- None
- else
- Some(expr_of_ptr (z3obj_gc x) v)
- let evaluate ( x : model ) ( t : expr ) ( completion : bool ) =
- eval x t completion
-
- let get_num_sorts ( x : model ) = Z3native.model_get_num_sorts (z3obj_gnc x) (z3obj_gno x)
-
- let get_sorts ( x : model ) =
- let n = (get_num_sorts x) in
- let f i = (Sort.sort_of_ptr (z3obj_gc x) (Z3native.model_get_sort (z3obj_gnc x) (z3obj_gno x) i)) in
+ let eval (x:model) (t:expr) (completion:bool) =
+ match Z3native.model_eval (gc x) x t completion with
+ | (false, _) -> None
+ | (true, v) -> Some v
+
+ let evaluate = eval
+ let get_num_sorts (x:model) = Z3native.model_get_num_sorts (gc x) x
+
+ let get_sorts (x:model) =
+ let n = get_num_sorts x in
+ let f i = Z3native.model_get_sort (gc x) x i in
mk_list f n
- let sort_universe ( x : model ) ( s : Sort.sort ) =
- let av = AST.ASTVector.create (z3obj_gc x) (Z3native.model_get_sort_universe (z3obj_gnc x) (z3obj_gno x) (Sort.gno s)) in
- (AST.ASTVector.to_expr_list av)
+ let sort_universe (x:model) (s:Sort.sort) =
+ let av = Z3native.model_get_sort_universe (gc x) x s in
+ AST.ASTVector.to_expr_list av
- let to_string ( x : model ) = Z3native.model_to_string (z3obj_gnc x) (z3obj_gno x)
+ let to_string (x:model) = Z3native.model_to_string (gc x) x
end
module Probe =
struct
- type probe = z3_native_object
+ type probe = Z3native.probe
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : probe = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.probe_inc_ref ;
- dec_ref = Z3native.probe_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
+ let apply (x:probe) (g:Goal.goal) = Z3native.probe_apply (gc x) x g
+ let get_num_probes = Z3native.get_num_probes
- let apply ( x : probe ) ( g : Goal.goal ) =
- Z3native.probe_apply (z3obj_gnc x) (z3obj_gno x) (z3obj_gno g)
-
- let get_num_probes ( ctx : context ) =
- Z3native.get_num_probes (context_gno ctx)
-
- let get_probe_names ( ctx : context ) =
- let n = (get_num_probes ctx) in
- let f i = (Z3native.get_probe_name (context_gno ctx) i) in
+ let get_probe_names (ctx:context) =
+ let n = get_num_probes ctx in
+ let f i = Z3native.get_probe_name ctx i in
mk_list f n
- let get_probe_description ( ctx : context ) ( name : string ) =
- Z3native.probe_get_descr (context_gno ctx) name
-
- let mk_probe ( ctx : context ) ( name : string ) =
- (create ctx (Z3native.mk_probe (context_gno ctx) name))
-
- let const ( ctx : context ) ( v : float ) =
- (create ctx (Z3native.probe_const (context_gno ctx) v))
-
- let lt ( ctx : context ) ( p1 : probe ) ( p2 : probe ) =
- (create ctx (Z3native.probe_lt (context_gno ctx) (z3obj_gno p1) (z3obj_gno p2)))
-
- let gt ( ctx : context ) ( p1 : probe ) ( p2 : probe ) =
- (create ctx (Z3native.probe_gt (context_gno ctx) (z3obj_gno p1) (z3obj_gno p2)))
-
- let le ( ctx : context ) ( p1 : probe ) ( p2 : probe ) =
- (create ctx (Z3native.probe_le (context_gno ctx) (z3obj_gno p1) (z3obj_gno p2)))
-
- let ge ( ctx : context ) ( p1 : probe ) ( p2 : probe ) =
- (create ctx (Z3native.probe_ge (context_gno ctx) (z3obj_gno p1) (z3obj_gno p2)))
-
- let eq ( ctx : context ) ( p1 : probe ) ( p2 : probe ) =
- (create ctx (Z3native.probe_eq (context_gno ctx) (z3obj_gno p1) (z3obj_gno p2)))
-
- let and_ ( ctx : context ) ( p1 : probe ) ( p2 : probe ) =
- (create ctx (Z3native.probe_and (context_gno ctx) (z3obj_gno p1) (z3obj_gno p2)))
-
- let or_ ( ctx : context ) ( p1 : probe ) ( p2 : probe ) =
- (create ctx (Z3native.probe_or (context_gno ctx) (z3obj_gno p1) (z3obj_gno p2)))
-
- let not_ ( ctx : context ) ( p : probe ) =
- (create ctx (Z3native.probe_not (context_gno ctx) (z3obj_gno p)))
+ let get_probe_description = Z3native.probe_get_descr
+ let mk_probe = Z3native.mk_probe
+ let const = Z3native.probe_const
+ let lt = Z3native.probe_lt
+ let gt = Z3native.probe_gt
+ let le = Z3native.probe_le
+ let ge = Z3native.probe_ge
+ let eq = Z3native.probe_eq
+ let and_ = Z3native.probe_and
+ let or_ = Z3native.probe_or
+ let not_ = Z3native.probe_not
end
module Tactic =
-struct
- type tactic = z3_native_object
+struct
+ type tactic = Z3native.tactic
+ let gc = Z3native.context_of_tactic
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : tactic = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.tactic_inc_ref ;
- dec_ref = Z3native.tactic_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
module ApplyResult =
- struct
- type apply_result = z3_native_object
-
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : apply_result = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.apply_result_inc_ref ;
- dec_ref = Z3native.apply_result_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
- let get_num_subgoals ( x : apply_result ) =
- Z3native.apply_result_get_num_subgoals (z3obj_gnc x) (z3obj_gno x)
-
- let get_subgoals ( x : apply_result ) =
- let n = (get_num_subgoals x) in
- let f i = Goal.create (z3obj_gc x) (Z3native.apply_result_get_subgoal (z3obj_gnc x) (z3obj_gno x) i) in
+ struct
+ type apply_result = Z3native.apply_result
+ let gc = Z3native.context_of_apply_result
+
+ let get_num_subgoals (x:apply_result) = Z3native.apply_result_get_num_subgoals (gc x) x
+
+ let get_subgoals (x:apply_result) =
+ let n = get_num_subgoals x in
+ let f i = Z3native.apply_result_get_subgoal (gc x) x i in
mk_list f n
-
- let get_subgoal ( x : apply_result ) ( i : int ) =
- Goal.create (z3obj_gc x) (Z3native.apply_result_get_subgoal (z3obj_gnc x) (z3obj_gno x) i)
-
- let convert_model ( x : apply_result ) ( i : int ) ( m : Model.model ) =
- Model.create (z3obj_gc x) (Z3native.apply_result_convert_model (z3obj_gnc x) (z3obj_gno x) i (z3obj_gno m))
-
- let to_string ( x : apply_result ) = Z3native.apply_result_to_string (z3obj_gnc x) (z3obj_gno x)
+
+ let get_subgoal (x:apply_result) (i:int) = Z3native.apply_result_get_subgoal (gc x) x i
+ let convert_model (x:apply_result) (i:int) (m:Model.model) = Z3native.apply_result_convert_model (gc x) x i m
+ let to_string (x:apply_result) = Z3native.apply_result_to_string (gc x) x
end
- let get_help ( x : tactic ) = Z3native.tactic_get_help (z3obj_gnc x) (z3obj_gno x)
+ let get_help (x:tactic) = Z3native.tactic_get_help (gc x) x
+ let get_param_descrs (x:tactic) = Z3native.tactic_get_param_descrs (gc x) x
- let get_param_descrs ( x : tactic ) =
- Params.ParamDescrs.param_descrs_of_ptr (z3obj_gc x) (Z3native.tactic_get_param_descrs (z3obj_gnc x) (z3obj_gno x))
-
- let apply ( x : tactic ) ( g : Goal.goal ) ( p : Params.params option ) =
- match p with
- | None -> (ApplyResult.create (z3obj_gc x) (Z3native.tactic_apply (z3obj_gnc x) (z3obj_gno x) (z3obj_gno g)))
- | Some (pn) -> (ApplyResult.create (z3obj_gc x) (Z3native.tactic_apply_ex (z3obj_gnc x) (z3obj_gno x) (z3obj_gno g) (z3obj_gno pn)))
+ let apply (x:tactic) (g:Goal.goal) (p:Params.params option) =
+ match p with
+ | None -> Z3native.tactic_apply (gc x) x g
+ | Some pn -> Z3native.tactic_apply_ex (gc x) x g pn
- let get_num_tactics ( ctx : context ) = Z3native.get_num_tactics (context_gno ctx)
+ let get_num_tactics = Z3native.get_num_tactics
- let get_tactic_names ( ctx : context ) =
- let n = (get_num_tactics ctx ) in
- let f i = (Z3native.get_tactic_name (context_gno ctx) i) in
+ let get_tactic_names (ctx:context) =
+ let n = get_num_tactics ctx in
+ let f i = Z3native.get_tactic_name ctx i in
mk_list f n
- let get_tactic_description ( ctx : context ) ( name : string ) =
- Z3native.tactic_get_descr (context_gno ctx) name
+ let get_tactic_description = Z3native.tactic_get_descr
+ let mk_tactic = Z3native.mk_tactic
- let mk_tactic ( ctx : context ) ( name : string ) =
- create ctx (Z3native.mk_tactic (context_gno ctx) name)
-
- let and_then ( ctx : context ) ( t1 : tactic ) ( t2 : tactic ) ( ts : tactic list ) =
- let f p c = (match p with
- | None -> (Some (z3obj_gno c))
- | Some(x) -> (Some (Z3native.tactic_and_then (context_gno ctx) (z3obj_gno c) x))) in
+ let and_then (ctx:context) (t1:tactic) (t2:tactic) (ts:tactic list) =
+ let f p c = (match p with
+ | None -> Some c
+ | Some(x) -> Some (Z3native.tactic_and_then ctx c x)) in
match (List.fold_left f None ts) with
- | None ->
- create ctx (Z3native.tactic_and_then (context_gno ctx) (z3obj_gno t1) (z3obj_gno t2))
- | Some(x) ->
- let o = (Z3native.tactic_and_then (context_gno ctx) (z3obj_gno t2) x) in
- create ctx (Z3native.tactic_and_then (context_gno ctx) (z3obj_gno t1) o)
+ | None -> Z3native.tactic_and_then ctx t1 t2
+ | Some(x) -> let o = Z3native.tactic_and_then ctx t2 x in
+ Z3native.tactic_and_then ctx t1 o
- let or_else ( ctx : context ) ( t1 : tactic ) ( t2 : tactic ) =
- create ctx (Z3native.tactic_or_else (context_gno ctx) (z3obj_gno t1) (z3obj_gno t2))
-
- let try_for ( ctx : context ) ( t : tactic ) ( ms : int ) =
- create ctx (Z3native.tactic_try_for (context_gno ctx) (z3obj_gno t) ms)
-
- let when_ ( ctx : context ) ( p : Probe.probe ) ( t : tactic ) =
- create ctx (Z3native.tactic_when (context_gno ctx) (z3obj_gno p) (z3obj_gno t))
-
- let cond ( ctx : context ) ( p : Probe.probe ) ( t1 : tactic ) ( t2 : tactic ) =
- create ctx (Z3native.tactic_cond (context_gno ctx) (z3obj_gno p) (z3obj_gno t1) (z3obj_gno t2))
-
- let repeat ( ctx : context ) ( t : tactic ) ( max : int ) =
- create ctx (Z3native.tactic_repeat (context_gno ctx) (z3obj_gno t) max)
-
- let skip ( ctx : context ) =
- create ctx (Z3native.tactic_skip (context_gno ctx))
-
- let fail ( ctx : context ) =
- create ctx (Z3native.tactic_fail (context_gno ctx))
-
- let fail_if ( ctx : context ) ( p : Probe.probe ) =
- create ctx (Z3native.tactic_fail_if (context_gno ctx) (z3obj_gno p))
-
- let fail_if_not_decided ( ctx : context ) =
- create ctx (Z3native.tactic_fail_if_not_decided (context_gno ctx))
-
- let using_params ( ctx : context ) ( t : tactic ) ( p : Params.params ) =
- create ctx (Z3native.tactic_using_params (context_gno ctx) (z3obj_gno t) (z3obj_gno p))
-
- let with_ ( ctx : context ) ( t : tactic ) ( p : Params.params ) =
- using_params ctx t p
-
- let par_or ( ctx : context ) ( t : tactic list ) =
- let f e = (z3obj_gno e) in
- create ctx (Z3native.tactic_par_or (context_gno ctx) (List.length t) (Array.of_list (List.map f t)))
-
- let par_and_then ( ctx : context ) ( t1 : tactic ) ( t2 : tactic ) =
- create ctx (Z3native.tactic_par_and_then (context_gno ctx) (z3obj_gno t1) (z3obj_gno t2))
-
- let interrupt ( ctx : context ) =
- Z3native.interrupt (context_gno ctx)
+ let or_else = Z3native.tactic_or_else
+ let try_for = Z3native.tactic_try_for
+ let when_ = Z3native.tactic_when
+ let cond = Z3native.tactic_cond
+ let repeat = Z3native.tactic_repeat
+ let skip = Z3native.tactic_skip
+ let fail = Z3native.tactic_fail
+ let fail_if = Z3native.tactic_fail_if
+ let fail_if_not_decided = Z3native.tactic_fail_if_not_decided
+ let using_params = Z3native.tactic_using_params
+ let with_ = using_params
+ let par_or (ctx:context) (t:tactic list) = Z3native.tactic_par_or ctx (List.length t) t
+ let par_and_then = Z3native.tactic_par_and_then
+ let interrupt = Z3native.interrupt
end
module Statistics =
-struct
- type statistics = z3_native_object
-
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : statistics = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.stats_inc_ref ;
- dec_ref = Z3native.stats_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
+struct
+ type statistics = Z3native.stats
+ let gc = Z3native.context_of_stats
module Entry =
struct
- type statistics_entry = {
- mutable m_key : string;
- mutable m_is_int : bool ;
- mutable m_is_float : bool ;
- mutable m_int : int ;
- mutable m_float : float }
-
- let create_si k v =
- let res : statistics_entry = {
- m_key = k ;
- m_is_int = true ;
- m_is_float = false ;
- m_int = v ;
- m_float = 0.0
- } in
- res
+ type statistics_entry = {
+ m_key:string;
+ m_is_int:bool;
+ m_is_float:bool;
+ m_int:int;
+ m_float:float }
- let create_sd k v =
- let res : statistics_entry = {
- m_key = k ;
- m_is_int = false ;
- m_is_float = true ;
- m_int = 0 ;
- m_float = v
- } in
- res
-
+ let create_si k v =
+ { m_key = k; m_is_int = true; m_is_float = false; m_int = v; m_float = 0.0 }
- let get_key (x : statistics_entry) = x.m_key
- let get_int (x : statistics_entry) = x.m_int
- let get_float (x : statistics_entry) = x.m_float
- let is_int (x : statistics_entry) = x.m_is_int
- let is_float (x : statistics_entry) = x.m_is_float
- let to_string_value (x : statistics_entry) =
- if (is_int x) then
- string_of_int (get_int x)
- else if (is_float x) then
- string_of_float (get_float x)
- else
- raise (Z3native.Exception "Unknown statistical entry type")
- let to_string ( x : statistics_entry ) = (get_key x) ^ ": " ^ (to_string_value x)
+ let create_sd k v =
+ { m_key = k; m_is_int = false; m_is_float = true; m_int = 0; m_float = v }
+
+ let get_key (x:statistics_entry) = x.m_key
+ let get_int (x:statistics_entry) = x.m_int
+ let get_float (x:statistics_entry) = x.m_float
+ let is_int (x:statistics_entry) = x.m_is_int
+ let is_float (x:statistics_entry) = x.m_is_float
+ let to_string_value (x:statistics_entry) =
+ if is_int x then
+ string_of_int (get_int x)
+ else if is_float x then
+ string_of_float (get_float x)
+ else
+ raise (Error "Unknown statistical entry type")
+ let to_string (x:statistics_entry) = (get_key x) ^ ": " ^ (to_string_value x)
end
- let to_string ( x : statistics ) = Z3native.stats_to_string (z3obj_gnc x) (z3obj_gno x)
-
- let get_size ( x : statistics ) = Z3native.stats_size (z3obj_gnc x) (z3obj_gno x)
-
- let get_entries ( x : statistics ) =
- let n = (get_size x ) in
- let f i = (
- let k = Z3native.stats_get_key (z3obj_gnc x) (z3obj_gno x) i in
- if (Z3native.stats_is_uint (z3obj_gnc x) (z3obj_gno x) i) then
- (Entry.create_si k (Z3native.stats_get_uint_value (z3obj_gnc x) (z3obj_gno x) i))
- else
- (Entry.create_sd k (Z3native.stats_get_double_value (z3obj_gnc x) (z3obj_gno x) i))
- ) in
+ let to_string (x:statistics) = Z3native.stats_to_string (gc x) x
+ let get_size (x:statistics) = Z3native.stats_size (gc x) x
+
+ let get_entries (x:statistics) =
+ let n = get_size x in
+ let f i =
+ let k = Z3native.stats_get_key (gc x) x i in
+ if Z3native.stats_is_uint (gc x) x i then
+ Entry.create_si k (Z3native.stats_get_uint_value (gc x) x i)
+ else
+ Entry.create_sd k (Z3native.stats_get_double_value (gc x) x i)
+ in
mk_list f n
- let get_keys ( x : statistics ) =
- let n = (get_size x) in
- let f i = (Z3native.stats_get_key (z3obj_gnc x) (z3obj_gno x) i) in
+ let get_keys (x:statistics) =
+ let n = get_size x in
+ let f i = Z3native.stats_get_key (gc x) x i in
mk_list f n
-
- let get ( x : statistics ) ( key : string ) =
- let f p c = (if ((Entry.get_key c) == key) then (Some c) else p) in
- List.fold_left f None (get_entries x)
+
+ let get (x:statistics) (key:string) =
+ try Some(List.find (fun c -> Entry.get_key c = key) (get_entries x)) with
+ | Not_found -> None
end
module Solver =
-struct
- type solver = z3_native_object
+struct
+ type solver = Z3native.solver
type status = UNSATISFIABLE | UNKNOWN | SATISFIABLE
+ let gc = Z3native.context_of_solver
- let create ( ctx : context ) ( no : Z3native.ptr ) =
- let res : solver = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.solver_inc_ref ;
- dec_ref = Z3native.solver_dec_ref } in
- (z3obj_sno res ctx no) ;
- (z3obj_create res) ;
- res
-
- let string_of_status ( s : status) = match s with
+ let string_of_status (s:status) = match s with
| UNSATISFIABLE -> "unsatisfiable"
- | SATISFIABLE -> "satisfiable"
+ | SATISFIABLE -> "satisfiable"
| _ -> "unknown"
- let get_help ( x : solver ) = Z3native.solver_get_help (z3obj_gnc x) (z3obj_gno x)
+ let get_help (x:solver) = Z3native.solver_get_help (gc x) x
+ let set_parameters (x:solver) (p:Params.params) = Z3native.solver_set_params (gc x) x p
+ let get_param_descrs (x:solver) = Z3native.solver_get_param_descrs (gc x) x
+ let get_num_scopes (x:solver) = Z3native.solver_get_num_scopes (gc x) x
+ let push (x:solver) = Z3native.solver_push (gc x) x
+ let pop (x:solver) (n:int) = Z3native.solver_pop (gc x) x n
+ let reset (x:solver) = Z3native.solver_reset (gc x) x
- let set_parameters ( x : solver ) ( p : Params.params )=
- Z3native.solver_set_params (z3obj_gnc x) (z3obj_gno x) (z3obj_gno p)
+ let add x constraints =
+ List.iter (Z3native.solver_assert (gc x) x) constraints
- let get_param_descrs ( x : solver ) =
- Params.ParamDescrs.param_descrs_of_ptr (z3obj_gc x) (Z3native.solver_get_param_descrs (z3obj_gnc x) (z3obj_gno x))
+ let assert_and_track_l x cs ps =
+ try List.iter2 (Z3native.solver_assert_and_track (gc x) x) cs ps with
+ | Invalid_argument _ -> raise (Error "Argument size mismatch")
- let get_num_scopes ( x : solver ) = Z3native.solver_get_num_scopes (z3obj_gnc x) (z3obj_gno x)
+ let assert_and_track x = Z3native.solver_assert_and_track (gc x) x
- let push ( x : solver ) = Z3native.solver_push (z3obj_gnc x) (z3obj_gno x)
+ let get_num_assertions x =
+ let a = Z3native.solver_get_assertions (gc x) x in
+ AST.ASTVector.get_size a
- let pop ( x : solver ) ( n : int ) = Z3native.solver_pop (z3obj_gnc x) (z3obj_gno x) n
+ let get_assertions x =
+ let av = Z3native.solver_get_assertions (gc x) x in
+ AST.ASTVector.to_expr_list av
- let reset ( x : solver ) = Z3native.solver_reset (z3obj_gnc x) (z3obj_gno x)
-
- let add ( x : solver ) ( constraints : expr list ) =
- let f e = (Z3native.solver_assert (z3obj_gnc x) (z3obj_gno x) (Expr.gno e)) in
- ignore (List.map f constraints)
-
- let assert_and_track_l ( x : solver ) ( cs : expr list ) ( ps : expr list ) =
- if ((List.length cs) != (List.length ps)) then
- raise (Z3native.Exception "Argument size mismatch")
- else
- let f a b = (Z3native.solver_assert_and_track (z3obj_gnc x) (z3obj_gno x) (Expr.gno a) (Expr.gno b)) in
- ignore (List.iter2 f cs ps)
-
- let assert_and_track ( x : solver ) ( c : expr ) ( p : expr ) =
- Z3native.solver_assert_and_track (z3obj_gnc x) (z3obj_gno x) (Expr.gno c) (Expr.gno p)
-
- let get_num_assertions ( x : solver ) =
- let a = AST.ASTVector.create (z3obj_gc x) (Z3native.solver_get_assertions (z3obj_gnc x) (z3obj_gno x)) in
- (AST.ASTVector.get_size a)
-
- let get_assertions ( x : solver ) =
- let av = AST.ASTVector.create (z3obj_gc x) (Z3native.solver_get_assertions (z3obj_gnc x) (z3obj_gno x)) in
- (AST.ASTVector.to_expr_list av)
-
- let check ( x : solver ) ( assumptions : expr list ) =
- let r =
- if ((List.length assumptions) == 0) then
- lbool_of_int (Z3native.solver_check (z3obj_gnc x) (z3obj_gno x))
- else
- let f x = (Expr.gno x) in
- lbool_of_int (Z3native.solver_check_assumptions (z3obj_gnc x) (z3obj_gno x) (List.length assumptions) (Array.of_list (List.map f assumptions)))
+ let check (x:solver) (assumptions:expr list) =
+ let result =
+ match assumptions with
+ | [] -> Z3native.solver_check (gc x) x
+ | _::_ ->
+ Z3native.solver_check_assumptions (gc x) x (List.length assumptions) assumptions
in
- match r with
- | L_TRUE -> SATISFIABLE
- | L_FALSE -> UNSATISFIABLE
- | _ -> UNKNOWN
-
- let get_model ( x : solver ) =
- let q = Z3native.solver_get_model (z3obj_gnc x) (z3obj_gno x) in
- if (Z3native.is_null q) then
- None
- else
- Some (Model.create (z3obj_gc x) q)
-
- let get_proof ( x : solver ) =
- let q = Z3native.solver_get_proof (z3obj_gnc x) (z3obj_gno x) in
- if (Z3native.is_null q) then
- None
- else
- Some (expr_of_ptr (z3obj_gc x) q)
-
- let get_unsat_core ( x : solver ) =
- let av = AST.ASTVector.create (z3obj_gc x) (Z3native.solver_get_unsat_core (z3obj_gnc x) (z3obj_gno x)) in
- (AST.ASTVector.to_expr_list av)
+ match lbool_of_int result with
+ | L_TRUE -> SATISFIABLE
+ | L_FALSE -> UNSATISFIABLE
+ | _ -> UNKNOWN
- let get_reason_unknown ( x : solver ) = Z3native.solver_get_reason_unknown (z3obj_gnc x) (z3obj_gno x)
+ let get_model x =
+ let q = Z3native.solver_get_model (gc x) x in
+ if Z3native.is_null_model q then None else Some q
- let get_statistics ( x : solver ) =
- (Statistics.create (z3obj_gc x) (Z3native.solver_get_statistics (z3obj_gnc x) (z3obj_gno x)))
+ let get_proof x =
+ let q = Z3native.solver_get_proof (gc x) x in
+ if Z3native.is_null_ast q then None else Some q
- let mk_solver ( ctx : context ) ( logic : Symbol.symbol option ) =
+ let get_unsat_core x =
+ let av = Z3native.solver_get_unsat_core (gc x) x in
+ AST.ASTVector.to_expr_list av
+
+ let get_reason_unknown x = Z3native.solver_get_reason_unknown (gc x) x
+ let get_statistics x = Z3native.solver_get_statistics (gc x) x
+
+ let mk_solver ctx logic =
match logic with
- | None -> (create ctx (Z3native.mk_solver (context_gno ctx)))
- | Some (x) -> (create ctx (Z3native.mk_solver_for_logic (context_gno ctx) (Symbol.gno x)))
+ | None -> Z3native.mk_solver ctx
+ | Some x -> Z3native.mk_solver_for_logic ctx x
- let mk_solver_s ( ctx : context ) ( logic : string ) =
- mk_solver ctx (Some (Symbol.mk_string ctx logic))
-
- let mk_simple_solver ( ctx : context ) =
- create ctx (Z3native.mk_simple_solver (context_gno ctx))
-
- let mk_solver_t ( ctx : context ) ( t : Tactic.tactic ) =
- create ctx (Z3native.mk_solver_from_tactic (context_gno ctx) (z3obj_gno t))
-
- let translate ( x : solver ) ( to_ctx : context ) =
- create to_ctx (Z3native.solver_translate (z3obj_gnc x) (z3obj_gno x) (context_gno to_ctx))
-
- let to_string ( x : solver ) = Z3native.solver_to_string (z3obj_gnc x) (z3obj_gno x)
+ let mk_solver_s ctx logic = mk_solver ctx (Some (Symbol.mk_string ctx logic))
+ let mk_simple_solver = Z3native.mk_simple_solver
+ let mk_solver_t = Z3native.mk_solver_from_tactic
+ let translate x = Z3native.solver_translate (gc x) x
+ let to_string x = Z3native.solver_to_string (gc x) x
end
module Fixedpoint =
struct
- type fixedpoint = z3_native_object
-
- let create ( ctx : context ) =
- let res : fixedpoint = { m_ctx = ctx ;
- m_n_obj = null ;
- inc_ref = Z3native.fixedpoint_inc_ref ;
- dec_ref = Z3native.fixedpoint_dec_ref } in
- (z3obj_sno res ctx (Z3native.mk_fixedpoint (context_gno ctx))) ;
- (z3obj_create res) ;
- res
-
+ type fixedpoint = Z3native.fixedpoint
+ let gc = Z3native.context_of_fixedpoint
- let get_help ( x : fixedpoint ) =
- Z3native.fixedpoint_get_help (z3obj_gnc x) (z3obj_gno x)
-
- let set_parameters ( x : fixedpoint ) ( p : Params.params )=
- Z3native.fixedpoint_set_params (z3obj_gnc x) (z3obj_gno x) (z3obj_gno p)
-
- let get_param_descrs ( x : fixedpoint ) =
- Params.ParamDescrs.param_descrs_of_ptr (z3obj_gc x) (Z3native.fixedpoint_get_param_descrs (z3obj_gnc x) (z3obj_gno x))
-
- let add ( x : fixedpoint ) ( constraints : expr list ) =
- let f e = (Z3native.fixedpoint_assert (z3obj_gnc x) (z3obj_gno x) (Expr.gno e)) in
- ignore (List.map f constraints) ;
- ()
+ let get_help x = Z3native.fixedpoint_get_help (gc x) x
+ let set_parameters x = Z3native.fixedpoint_set_params (gc x) x
+ let get_param_descrs x = Z3native.fixedpoint_get_param_descrs (gc x) x
- let register_relation ( x : fixedpoint ) ( f : func_decl ) =
- Z3native.fixedpoint_register_relation (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno f)
-
- let add_rule ( x : fixedpoint ) ( rule : expr ) ( name : Symbol.symbol option ) =
- match name with
- | None -> Z3native.fixedpoint_add_rule (z3obj_gnc x) (z3obj_gno x) (Expr.gno rule) null
- | Some(y) -> Z3native.fixedpoint_add_rule (z3obj_gnc x) (z3obj_gno x) (Expr.gno rule) (Symbol.gno y)
+ let add x constraints =
+ List.iter (Z3native.fixedpoint_assert (gc x) x) constraints
- let add_fact ( x : fixedpoint ) ( pred : func_decl ) ( args : int list ) =
- Z3native.fixedpoint_add_fact (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno pred) (List.length args) (Array.of_list args)
+ let register_relation x = Z3native.fixedpoint_register_relation (gc x) x
- let query ( x : fixedpoint ) ( query : expr ) =
- match (lbool_of_int (Z3native.fixedpoint_query (z3obj_gnc x) (z3obj_gno x) (Expr.gno query))) with
- | L_TRUE -> Solver.SATISFIABLE
- | L_FALSE -> Solver.UNSATISFIABLE
- | _ -> Solver.UNKNOWN
+ let add_rule (x:fixedpoint) (rule:expr) (name:Symbol.symbol option) =
+ match name with
+ | None -> Z3native.fixedpoint_add_rule (gc x) x rule (Z3native.mk_null_symbol (gc x))
+ | Some y -> Z3native.fixedpoint_add_rule (gc x) x rule y
- let query_r ( x : fixedpoint ) ( relations : func_decl list ) =
- let f x = AST.ptr_of_ast (ast_of_func_decl x) in
- match (lbool_of_int (Z3native.fixedpoint_query_relations (z3obj_gnc x) (z3obj_gno x) (List.length relations) (Array.of_list (List.map f relations)))) with
- | L_TRUE -> Solver.SATISFIABLE
- | L_FALSE -> Solver.UNSATISFIABLE
- | _ -> Solver.UNKNOWN
-
- let push ( x : fixedpoint ) =
- Z3native.fixedpoint_push (z3obj_gnc x) (z3obj_gno x)
-
- let pop ( x : fixedpoint ) =
- Z3native.fixedpoint_pop (z3obj_gnc x) (z3obj_gno x)
+ let add_fact (x:fixedpoint) (pred:func_decl) (args:int list) =
+ Z3native.fixedpoint_add_fact (gc x) x pred (List.length args) args
- let update_rule ( x : fixedpoint ) ( rule : expr ) ( name : Symbol.symbol ) =
- Z3native.fixedpoint_update_rule (z3obj_gnc x) (z3obj_gno x) (Expr.gno rule) (Symbol.gno name)
+ let query (x:fixedpoint) (query:expr) =
+ match lbool_of_int (Z3native.fixedpoint_query (gc x) x query) with
+ | L_TRUE -> Solver.SATISFIABLE
+ | L_FALSE -> Solver.UNSATISFIABLE
+ | _ -> Solver.UNKNOWN
- let get_answer ( x : fixedpoint ) =
- let q = (Z3native.fixedpoint_get_answer (z3obj_gnc x) (z3obj_gno x)) in
- if (Z3native.is_null q) then
- None
- else
- Some (expr_of_ptr (z3obj_gc x) q)
+ let query_r (x:fixedpoint) (relations:func_decl list) =
+ match lbool_of_int (Z3native.fixedpoint_query_relations (gc x) x (List.length relations) relations) with
+ | L_TRUE -> Solver.SATISFIABLE
+ | L_FALSE -> Solver.UNSATISFIABLE
+ | _ -> Solver.UNKNOWN
- let get_reason_unknown ( x : fixedpoint ) =
- Z3native.fixedpoint_get_reason_unknown (z3obj_gnc x) (z3obj_gno x)
+ let push x = Z3native.fixedpoint_push (gc x) x
+ let pop x = Z3native.fixedpoint_pop (gc x) x
+ let update_rule x = Z3native.fixedpoint_update_rule (gc x) x
- let get_num_levels ( x : fixedpoint ) ( predicate : func_decl ) =
- Z3native.fixedpoint_get_num_levels (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno predicate)
+ let get_answer x =
+ let q = Z3native.fixedpoint_get_answer (gc x) x in
+ if Z3native.is_null_ast q then None else Some q
- let get_cover_delta ( x : fixedpoint ) ( level : int ) ( predicate : func_decl ) =
- let q = (Z3native.fixedpoint_get_cover_delta (z3obj_gnc x) (z3obj_gno x) level (FuncDecl.gno predicate)) in
- if (Z3native.is_null q) then
- None
- else
- Some (expr_of_ptr (z3obj_gc x) q)
-
- let add_cover ( x : fixedpoint ) ( level : int ) ( predicate : func_decl ) ( property : expr ) =
- Z3native.fixedpoint_add_cover (z3obj_gnc x) (z3obj_gno x) level (FuncDecl.gno predicate) (Expr.gno property)
-
- let to_string ( x : fixedpoint ) = Z3native.fixedpoint_to_string (z3obj_gnc x) (z3obj_gno x) 0 [||]
-
- let set_predicate_representation ( x : fixedpoint ) ( f : func_decl ) ( kinds : Symbol.symbol list ) =
- Z3native.fixedpoint_set_predicate_representation (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno f) (List.length kinds) (Symbol.symbol_lton kinds)
+ let get_reason_unknown x = Z3native.fixedpoint_get_reason_unknown (gc x) x
+ let get_num_levels x = Z3native.fixedpoint_get_num_levels (gc x) x
- let to_string_q ( x : fixedpoint ) ( queries : expr list ) =
- let f x = Expr.gno x in
- Z3native.fixedpoint_to_string (z3obj_gnc x) (z3obj_gno x) (List.length queries) (Array.of_list (List.map f queries))
+ let get_cover_delta (x:fixedpoint) (level:int) (predicate:func_decl) =
+ let q = Z3native.fixedpoint_get_cover_delta (gc x) x level predicate in
+ if Z3native.is_null_ast q then None else Some q
- let get_rules ( x : fixedpoint ) =
- let av = (AST.ASTVector.create (z3obj_gc x) (Z3native.fixedpoint_get_rules (z3obj_gnc x) (z3obj_gno x))) in
+ let add_cover (x:fixedpoint) (level:int) (predicate:func_decl) (property:expr) =
+ Z3native.fixedpoint_add_cover (gc x) x level predicate property
+
+ let to_string (x:fixedpoint) = Z3native.fixedpoint_to_string (gc x) x 0 []
+
+ let set_predicate_representation (x:fixedpoint) (f:func_decl) (kinds:Symbol.symbol list) =
+ Z3native.fixedpoint_set_predicate_representation (gc x) x f (List.length kinds) kinds
+
+ let to_string_q (x:fixedpoint) (queries:expr list) =
+ Z3native.fixedpoint_to_string (gc x) x (List.length queries) queries
+
+ let get_rules (x:fixedpoint) =
+ let av = Z3native.fixedpoint_get_rules (gc x) x in
+ AST.ASTVector.to_expr_list av
+
+ let get_assertions (x:fixedpoint) =
+ let av = Z3native.fixedpoint_get_assertions (gc x) x in
(AST.ASTVector.to_expr_list av)
- let get_assertions ( x : fixedpoint ) =
- let av = (AST.ASTVector.create (z3obj_gc x) (Z3native.fixedpoint_get_assertions (z3obj_gnc x) (z3obj_gno x))) in
- (AST.ASTVector.to_expr_list av)
+ let mk_fixedpoint (ctx:context) = Z3native.mk_fixedpoint ctx
+ let get_statistics (x:fixedpoint) = Z3native.fixedpoint_get_statistics (gc x) x
- let mk_fixedpoint ( ctx : context ) = create ctx
+ let parse_string (x:fixedpoint) (s:string) =
+ let av = Z3native.fixedpoint_from_string (gc x) x s in
+ AST.ASTVector.to_expr_list av
- let get_statistics ( x : fixedpoint ) =
- let s = Z3native.fixedpoint_get_statistics (z3obj_gnc x) (z3obj_gno x) in
- (Statistics.create (z3obj_gc x) s)
-
- let parse_string ( x : fixedpoint ) ( s : string ) =
- let av = (AST.ASTVector.create (z3obj_gc x) (Z3native.fixedpoint_from_string (z3obj_gnc x) (z3obj_gno x) s)) in
- (AST.ASTVector.to_expr_list av)
-
- let parse_file ( x : fixedpoint ) ( filename : string ) =
- let av = (AST.ASTVector.create (z3obj_gc x) (Z3native.fixedpoint_from_file (z3obj_gnc x) (z3obj_gno x) filename)) in
- (AST.ASTVector.to_expr_list av)
+ let parse_file (x:fixedpoint) (filename:string) =
+ let av = Z3native.fixedpoint_from_file (gc x) x filename in
+ AST.ASTVector.to_expr_list av
end
-module Optimize =
-struct
- type optimize = z3_native_object
- type opt = optimize
- type handle = { opt : opt; h : int }
-
-
- let mk_handle (x : opt) h = { opt = x; h = h }
+module Optimize =
+struct
+ type optimize = Z3native.optimize
+ type handle = { opt:optimize; h:int }
-
- let mk_opt (ctx : context) =
- let res : opt = { m_ctx = ctx;
- m_n_obj = null ;
- inc_ref = Z3native.optimize_inc_ref ;
- dec_ref = Z3native.optimize_dec_ref } in
- (z3obj_sno res ctx (Z3native.mk_optimize (context_gno ctx))) ;
- (z3obj_create res) ;
- res
-
- let get_help ( x : opt ) =
- Z3native.optimize_get_help (z3obj_gnc x) (z3obj_gno x)
-
-
- let set_parameters ( x : opt ) ( p : Params.params )=
- Z3native.optimize_set_params (z3obj_gnc x) (z3obj_gno x) (z3obj_gno p)
-
- let get_param_descrs ( x : opt ) =
- Params.ParamDescrs.param_descrs_of_ptr (z3obj_gc x) (Z3native.optimize_get_param_descrs (z3obj_gnc x) (z3obj_gno x))
-
- let add ( x : opt ) ( constraints : expr list ) =
- let f e = (Z3native.optimize_assert (z3obj_gnc x) (z3obj_gno x) (Expr.gno e)) in
- List.iter f constraints
-
-
- let add_soft ( x : opt ) ( e : Expr.expr) ( w : string ) ( s : Symbol.symbol ) =
- mk_handle x (Z3native.optimize_assert_soft (z3obj_gnc x) (z3obj_gno x) (Expr.gno e) w (Symbol.gno s))
-
-
- let maximize ( x : opt ) ( e : Expr.expr ) =
- mk_handle x (Z3native.optimize_maximize (z3obj_gnc x) (z3obj_gno x) (Expr.gno e))
-
-
- let minimize ( x : opt ) ( e : Expr.expr ) =
- mk_handle x (Z3native.optimize_minimize (z3obj_gnc x) (z3obj_gno x) (Expr.gno e))
-
- let check ( x : opt ) =
- let r = lbool_of_int (Z3native.optimize_check (z3obj_gnc x) (z3obj_gno x)) in
- match r with
- | L_TRUE -> Solver.SATISFIABLE
- | L_FALSE -> Solver.UNSATISFIABLE
- | _ -> Solver.UNKNOWN
-
-
- let get_model ( x : opt ) =
- let q = Z3native.optimize_get_model (z3obj_gnc x) (z3obj_gno x) in
- if (Z3native.is_null q) then
- None
- else
- Some (Model.create (z3obj_gc x) q)
-
- let get_lower ( x : handle ) ( idx : int ) =
- expr_of_ptr (z3obj_gc x.opt) (Z3native.optimize_get_lower (z3obj_gnc x.opt) (z3obj_gno x.opt) idx)
-
- let get_upper ( x : handle ) ( idx : int ) =
- expr_of_ptr (z3obj_gc x.opt) (Z3native.optimize_get_upper (z3obj_gnc x.opt) (z3obj_gno x.opt) idx)
-
- let push ( x : opt ) = Z3native.optimize_push (z3obj_gnc x) (z3obj_gno x)
-
- let pop ( x : opt ) = Z3native.optimize_pop (z3obj_gnc x) (z3obj_gno x)
-
- let get_reason_unknown ( x : opt ) =
- Z3native.optimize_get_reason_unknown (z3obj_gnc x) (z3obj_gno x)
+ let mk_handle opt h = { opt; h }
+
+ let mk_opt (ctx:context) = Z3native.mk_optimize ctx
+ let get_help (x:optimize) = Z3native.optimize_get_help (gc x) x
+ let set_parameters (x:optimize) (p:Params.params) = Z3native.optimize_set_params (gc x) x p
+ let get_param_descrs (x:optimize) = Z3native.optimize_get_param_descrs (gc x) x
+
+ let add x constraints =
+ List.iter (Z3native.optimize_assert (gc x) x) constraints
+
+ let add_soft (x:optimize) (e:Expr.expr) (w:string) (s:Symbol.symbol) =
+ mk_handle x (Z3native.optimize_assert_soft (gc x) x e w s)
+
+ let maximize (x:optimize) (e:Expr.expr) = mk_handle x (Z3native.optimize_maximize (gc x) x e)
+ let minimize (x:optimize) (e:Expr.expr) = mk_handle x (Z3native.optimize_minimize (gc x) x e)
+
+ let check (x:optimize) =
+ let r = lbool_of_int (Z3native.optimize_check (gc x) x) in
+ match r with
+ | L_TRUE -> Solver.SATISFIABLE
+ | L_FALSE -> Solver.UNSATISFIABLE
+ | _ -> Solver.UNKNOWN
+
+ let get_model (x:optimize) =
+ let q = Z3native.optimize_get_model (gc x) x in
+ if Z3native.is_null_model q then None else Some q
+
+ let get_lower (x:handle) (idx:int) = Z3native.optimize_get_lower (gc x.opt) x.opt idx
+ let get_upper (x:handle) (idx:int) = Z3native.optimize_get_upper (gc x.opt) x.opt idx
+ let push (x:optimize) = Z3native.optimize_push (gc x) x
+ let pop (x:optimize) = Z3native.optimize_pop (gc x) x
+ let get_reason_unknown (x:optimize) = Z3native.optimize_get_reason_unknown (gc x) x
+ let to_string (x:optimize) = Z3native.optimize_to_string (gc x) x
+ let get_statistics (x:optimize) = Z3native.optimize_get_statistics (gc x) x
+end
- let to_string ( x : opt ) = Z3native.optimize_to_string (z3obj_gnc x) (z3obj_gno x)
-
-
- let get_statistics ( x : opt ) =
- let s = Z3native.optimize_get_statistics (z3obj_gnc x) (z3obj_gno x) in
- (Statistics.create (z3obj_gc x) s)
-
-
-end
module SMT =
struct
- let benchmark_to_smtstring ( ctx : context ) ( name : string ) ( logic : string ) ( status : string ) ( attributes : string ) ( assumptions : expr list ) ( formula : expr ) =
- Z3native.benchmark_to_smtlib_string (context_gno ctx) name logic status attributes
- (List.length assumptions) (let f x = Expr.gno (x) in (Array.of_list (List.map f assumptions)))
- (Expr.gno formula)
+ let benchmark_to_smtstring (ctx:context) (name:string) (logic:string) (status:string) (attributes:string) (assumptions:expr list) (formula:expr) =
+ Z3native.benchmark_to_smtlib_string ctx name logic status attributes
+ (List.length assumptions) assumptions
+ formula
- let parse_smtlib_string ( ctx : context ) ( str : string ) ( sort_names : Symbol.symbol list ) ( sorts : Sort.sort list ) ( decl_names : Symbol.symbol list ) ( decls : func_decl list ) =
+ let parse_smtlib_string (ctx:context) (str:string) (sort_names:Symbol.symbol list) (sorts:Sort.sort list) (decl_names:Symbol.symbol list) (decls:func_decl list) =
+ let csn = List.length sort_names in
+ let cs = List.length sorts in
+ let cdn = List.length decl_names in
+ let cd = List.length decls in
+ if (csn <> cs || cdn <> cd) then
+ raise (Error "Argument size mismatch")
+ else
+ Z3native.parse_smtlib_string ctx str
+ cs sort_names sorts cd decl_names decls
+
+ let parse_smtlib_file (ctx:context) (file_name:string) (sort_names:Symbol.symbol list) (sorts:Sort.sort list) (decl_names:Symbol.symbol list) (decls:func_decl list) =
let csn = (List.length sort_names) in
let cs = (List.length sorts) in
let cdn = (List.length decl_names) in
let cd = (List.length decls) in
- if (csn != cs || cdn != cd) then
- raise (Z3native.Exception "Argument size mismatch")
+ if (csn <> cs || cdn <> cd) then
+ raise (Error "Argument size mismatch")
else
- Z3native.parse_smtlib_string (context_gno ctx) str
- cs
- (Symbol.symbol_lton sort_names)
- (Sort.sort_lton sorts)
- cd
- (Symbol.symbol_lton decl_names)
- (let f x = FuncDecl.gno x in (Array.of_list (List.map f decls)))
-
- let parse_smtlib_file ( ctx : context ) ( file_name : string ) ( sort_names : Symbol.symbol list ) ( sorts : Sort.sort list ) ( decl_names : Symbol.symbol list ) ( decls : func_decl list ) =
- let csn = (List.length sort_names) in
- let cs = (List.length sorts) in
- let cdn = (List.length decl_names) in
- let cd = (List.length decls) in
- if (csn != cs || cdn != cd) then
- raise (Z3native.Exception "Argument size mismatch")
- else
- Z3native.parse_smtlib_file (context_gno ctx) file_name
- cs
- (Symbol.symbol_lton sort_names)
- (Sort.sort_lton sorts)
- cd
- (Symbol.symbol_lton decl_names)
- (let f x = FuncDecl.gno x in (Array.of_list (List.map f decls)))
-
- let get_num_smtlib_formulas ( ctx : context ) = Z3native.get_smtlib_num_formulas (context_gno ctx)
+ Z3native.parse_smtlib_file ctx file_name
+ cs sort_names sorts cd decl_names decls
- let get_smtlib_formulas ( ctx : context ) =
- let n = (get_num_smtlib_formulas ctx ) in
- let f i =(expr_of_ptr ctx (Z3native.get_smtlib_formula (context_gno ctx) i)) in
- mk_list f n
+ let get_num_smtlib_formulas (ctx:context) = Z3native.get_smtlib_num_formulas ctx
- let get_num_smtlib_assumptions ( ctx : context ) = Z3native.get_smtlib_num_assumptions (context_gno ctx)
-
- let get_smtlib_assumptions ( ctx : context ) =
- let n = (get_num_smtlib_assumptions ctx ) in
- let f i = (expr_of_ptr ctx (Z3native.get_smtlib_assumption (context_gno ctx) i)) in
+ let get_smtlib_formulas (ctx:context) =
+ let n = get_num_smtlib_formulas ctx in
+ let f i = Z3native.get_smtlib_formula ctx i in
mk_list f n
- let get_num_smtlib_decls ( ctx : context ) = Z3native.get_smtlib_num_decls (context_gno ctx)
+ let get_num_smtlib_assumptions (ctx:context) = Z3native.get_smtlib_num_assumptions ctx
- let get_smtlib_decls ( ctx : context ) =
- let n = (get_num_smtlib_decls ctx) in
- let f i = func_decl_of_ptr ctx (Z3native.get_smtlib_decl (context_gno ctx) i) in
+ let get_smtlib_assumptions (ctx:context) =
+ let n = get_num_smtlib_assumptions ctx in
+ let f i = Z3native.get_smtlib_assumption ctx i in
mk_list f n
- let get_num_smtlib_sorts ( ctx : context ) = Z3native.get_smtlib_num_sorts (context_gno ctx)
-
- let get_smtlib_sorts ( ctx : context ) =
- let n = (get_num_smtlib_sorts ctx) in
- let f i = (Sort.sort_of_ptr ctx (Z3native.get_smtlib_sort (context_gno ctx) i)) in
+ let get_num_smtlib_decls (ctx:context) = Z3native.get_smtlib_num_decls ctx
+
+ let get_smtlib_decls (ctx:context) =
+ let n = get_num_smtlib_decls ctx in
+ let f i = Z3native.get_smtlib_decl ctx i in
mk_list f n
- let parse_smtlib2_string ( ctx : context ) ( str : string ) ( sort_names : Symbol.symbol list ) ( sorts : Sort.sort list ) ( decl_names : Symbol.symbol list ) ( decls : func_decl list ) =
- let csn = (List.length sort_names) in
- let cs = (List.length sorts) in
- let cdn = (List.length decl_names) in
- let cd = (List.length decls) in
- if (csn != cs || cdn != cd) then
- raise (Z3native.Exception "Argument size mismatch")
+ let get_num_smtlib_sorts (ctx:context) = Z3native.get_smtlib_num_sorts ctx
+
+ let get_smtlib_sorts (ctx:context) =
+ let n = get_num_smtlib_sorts ctx in
+ let f i = Z3native.get_smtlib_sort ctx i in
+ mk_list f n
+
+ let parse_smtlib2_string (ctx:context) (str:string) (sort_names:Symbol.symbol list) (sorts:Sort.sort list) (decl_names:Symbol.symbol list) (decls:func_decl list) =
+ let csn = List.length sort_names in
+ let cs = List.length sorts in
+ let cdn = List.length decl_names in
+ let cd = List.length decls in
+ if csn <> cs || cdn <> cd then
+ raise (Error "Argument size mismatch")
else
- (expr_of_ptr ctx (Z3native.parse_smtlib2_string (context_gno ctx) str
- cs
- (Symbol.symbol_lton sort_names)
- (Sort.sort_lton sorts)
- cd
- (Symbol.symbol_lton decl_names)
- (let f x = FuncDecl.gno x in (Array.of_list (List.map f decls)))))
-
- let parse_smtlib2_file ( ctx : context ) ( file_name : string ) ( sort_names : Symbol.symbol list ) ( sorts : Sort.sort list ) ( decl_names : Symbol.symbol list ) ( decls : func_decl list ) =
- let csn = (List.length sort_names) in
- let cs = (List.length sorts) in
- let cdn = (List.length decl_names) in
- let cd = (List.length decls) in
- if (csn != cs || cdn != cd) then
- raise (Z3native.Exception "Argument size mismatch")
+ Z3native.parse_smtlib2_string ctx str
+ cs sort_names sorts cd decl_names decls
+
+ let parse_smtlib2_file (ctx:context) (file_name:string) (sort_names:Symbol.symbol list) (sorts:Sort.sort list) (decl_names:Symbol.symbol list) (decls:func_decl list) =
+ let csn = List.length sort_names in
+ let cs = List.length sorts in
+ let cdn = List.length decl_names in
+ let cd = List.length decls in
+ if csn <> cs || cdn <> cd then
+ raise (Error "Argument size mismatch")
else
- (expr_of_ptr ctx (Z3native.parse_smtlib2_string (context_gno ctx) file_name
- cs
- (Symbol.symbol_lton sort_names)
- (Sort.sort_lton sorts)
- cd
- (Symbol.symbol_lton decl_names)
- (let f x = FuncDecl.gno x in (Array.of_list (List.map f decls)))))
+ Z3native.parse_smtlib2_string ctx file_name
+ cs sort_names sorts cd decl_names decls
end
-module Interpolation =
+module Interpolation =
struct
- let mk_interpolant ( ctx : context ) ( a : expr ) =
- (expr_of_ptr ctx (Z3native.mk_interpolant (context_gno ctx) (Expr.gno a)))
-
- let mk_interpolation_context ( settings : ( string * string ) list ) =
+ let mk_interpolant = Z3native.mk_interpolant
+
+ let mk_interpolation_context (settings:(string * string) list) =
let cfg = Z3native.mk_config () in
- let f e = (Z3native.set_param_value cfg (fst e) (snd e)) in
- (List.iter f settings) ;
- let v = Z3native.mk_interpolation_context cfg in
- Z3native.del_config(cfg) ;
- Z3native.set_ast_print_mode v (int_of_ast_print_mode PRINT_SMTLIB2_COMPLIANT) ;
- Z3native.set_internal_error_handler v ;
- let res = { m_n_ctx = v; m_n_obj_cnt = 0 } in
- let f = fun o -> dispose_context o in
- Gc.finalise f res;
+ let f e = Z3native.set_param_value cfg (fst e) (snd e) in
+ List.iter f settings;
+ let res = Z3native.mk_interpolation_context cfg in
+ Z3native.del_config cfg;
+ Z3native.set_ast_print_mode res (int_of_ast_print_mode PRINT_SMTLIB2_COMPLIANT);
+ Z3native.set_internal_error_handler res;
res
- let get_interpolant ( ctx : context ) ( pf : expr ) ( pat: expr ) ( p : Params.params ) =
- let av = (AST.ASTVector.create ctx (Z3native.get_interpolant (context_gno ctx) (Expr.gno pf) (Expr.gno pat) (z3obj_gno p))) in
+ let get_interpolant (ctx:context) (pf:expr) (pat:expr) (p:Params.params) =
+ let av = Z3native.get_interpolant ctx pf pat p in
AST.ASTVector.to_expr_list av
-
- let compute_interpolant ( ctx : context ) ( pat : expr ) ( p : Params.params ) =
- let (r, interp, model) = (Z3native.compute_interpolant (context_gno ctx) (Expr.gno pat) (z3obj_gno p)) in
- let res = (lbool_of_int r) in
- match res with
- | L_TRUE -> (res, None, Some(Model.create ctx model))
- | L_FALSE -> (res, Some((AST.ASTVector.to_expr_list (AST.ASTVector.create ctx interp))), None)
- | _ -> (res, None, None)
-
- let get_interpolation_profile ( ctx : context ) =
- (Z3native.interpolation_profile (context_gno ctx))
-
- let read_interpolation_problem ( ctx : context ) ( filename : string ) =
- let (r, num, cnsts, parents, error, num_theory, theory) = (Z3native.read_interpolation_problem (context_gno ctx) filename) in
- match r with
- | 0 -> raise (Z3native.Exception "Interpolation problem could not be read.")
- | _ ->
- let f1 i = (expr_of_ptr ctx (Array.get cnsts i)) in
- let f2 i = (Array.get parents i) in
- let f3 i = (expr_of_ptr ctx (Array.get theory i)) in
- ((mk_list f1 num),
- (mk_list f2 num),
- (mk_list f3 num_theory))
-
- let check_interpolant ( ctx : context ) ( num : int ) ( cnsts : Expr.expr list ) ( parents : int list ) ( interps : Expr.expr list ) ( num_theory : int ) ( theory : Expr.expr list ) =
- let (r, str) = (Z3native.check_interpolant (context_gno ctx)
- num
- (let f x = Expr.gno x in (Array.of_list (List.map f cnsts)))
- (Array.of_list parents)
- (let f x = Expr.gno x in (Array.of_list (List.map f interps)))
- num_theory
- (let f x = Expr.gno x in (Array.of_list (List.map f theory)))) in
- match (lbool_of_int r) with
- | L_UNDEF -> raise (Z3native.Exception "Interpolant could not be verified.")
- | L_FALSE -> raise (Z3native.Exception "Interpolant could not be verified.")
- | _ -> ()
- let write_interpolation_problem ( ctx : context ) ( num : int ) ( cnsts : Expr.expr list ) ( parents : int list ) ( filename : string ) ( num_theory : int ) ( theory : Expr.expr list ) =
- (Z3native.write_interpolation_problem (context_gno ctx) num (expr_lton cnsts) (Array.of_list parents) filename num_theory (expr_lton theory)) ;
- ()
+ let compute_interpolant (ctx:context) (pat:expr) (p:Params.params) =
+ let (r, interp, model) = Z3native.compute_interpolant ctx pat p in
+ let res = lbool_of_int r in
+ match res with
+ | L_TRUE -> (res, None, Some model)
+ | L_FALSE -> (res, Some (AST.ASTVector.to_expr_list interp), None)
+ | _ -> (res, None, None)
+
+ let get_interpolation_profile = Z3native.interpolation_profile
+
+ let read_interpolation_problem (ctx:context) (filename:string) =
+ let (r, num, cnsts, parents, error, num_theory, theory) =
+ Z3native.read_interpolation_problem ctx filename
+ in
+ match r with
+ | 0 -> raise (Error "Interpolation problem could not be read.")
+ | _ -> (cnsts, parents, theory)
+
+ let check_interpolant (ctx:context) (num:int) (cnsts:Expr.expr list) (parents:int list) (interps:Expr.expr list) (num_theory:int) (theory:Expr.expr list) =
+ let (r, str) = Z3native.check_interpolant ctx num cnsts parents interps num_theory theory in
+ match (lbool_of_int r) with
+ | L_UNDEF -> raise (Error "Interpolant could not be verified.")
+ | L_FALSE -> raise (Error "Interpolant could not be verified.")
+ | _ -> ()
+
+ let write_interpolation_problem (ctx:context) (num:int) (cnsts:Expr.expr list) (parents:int list) (filename:string) (num_theory:int) (theory:Expr.expr list) =
+ Z3native.write_interpolation_problem ctx num cnsts parents filename num_theory theory
end
-let set_global_param ( id : string ) ( value : string ) =
- (Z3native.global_param_set id value)
+let set_global_param = Z3native.global_param_set
-let get_global_param ( id : string ) =
- let (r, v) = (Z3native.global_param_get id) in
- if not r then
- None
- else
- Some v
+let get_global_param id =
+ match Z3native.global_param_get id with
+ | (false, _) -> None
+ | (true, v) -> Some v
-let global_param_reset_all =
- Z3native.global_param_reset_all
+let global_param_reset_all = Z3native.global_param_reset_all
-let toggle_warning_messages ( enabled : bool ) =
- Z3native.toggle_warning_messages enabled
-
-let enable_trace ( tag : string ) =
- (Z3native.enable_trace tag)
-
-let disable_trace ( tag : string ) =
- (Z3native.enable_trace tag)
+let toggle_warning_messages = Z3native.toggle_warning_messages
+let enable_trace = Z3native.enable_trace
+let disable_trace = Z3native.enable_trace
diff --git a/src/api/ml/z3.mli b/src/api/ml/z3.mli
index e69f7f576..9104b3080 100644
--- a/src/api/ml/z3.mli
+++ b/src/api/ml/z3.mli
@@ -5,19 +5,19 @@
@author CM Wintersteiger (cwinter) 2012-12-17
*)
-(** General Z3 exceptions
+(** General Z3 exceptions
Many functions in this API may throw an exception; if they do, it is this one.*)
exception Error of string
(** Context objects.
- Most interactions with Z3 are interpreted in some context; many users will only
- require one such object, but power users may require more than one. To start using
- Z3, do
+ Most interactions with Z3 are interpreted in some context; many users will only
+ require one such object, but power users may require more than one. To start using
+ Z3, do
<code>
- let ctx = (mk_context []) in
+ let ctx = (mk_context []) in
(...)
</code>
@@ -26,17 +26,17 @@ exception Error of string
<code>
let cfg = [("model", "true"); ("...", "...")] in
- let ctx = (mk_context cfg) in
+ let ctx = (mk_context cfg) in
(...)
</code>
*)
type context
-(** Create a context object
+(** Create a context object
The following parameters can be set:
-
+
- proof (Boolean) Enable proof generation
- - debug_ref_count (Boolean) Enable debug support for Z3_ast reference counting
+ - debug_ref_count (Boolean) Enable debug support for Z3_ast reference counting
- trace (Boolean) Tracing support for VCC
- trace_file_name (String) Trace out file for VCC traces
- timeout (unsigned) default timeout (in milliseconds) used for solvers
@@ -44,16 +44,16 @@ type context
- auto_config use heuristics to automatically select solver and configure it
- model model generation for solvers, this parameter can be overwritten when creating a solver
- model_validate validate models produced by solvers
- - unsat_core unsat-core generation for solvers, this parameter can be overwritten when creating a solver
+ - unsat_core unsat-core generation for solvers, this parameter can be overwritten when creating a solver
*)
val mk_context : (string * string) list -> context
(** Interaction logging for Z3
- Note that this is a global, static log and if multiple Context
+ Note that this is a global, static log and if multiple Context
objects are created, it logs the interaction with all of them. *)
module Log :
sig
- (** Open an interaction log file.
+ (** Open an interaction log file.
@return True if opening the log file succeeds, false otherwise. *)
(* CMW: "open" is a reserved keyword. *)
val open_ : string -> bool
@@ -107,7 +107,7 @@ sig
(** A string representation of the symbol. *)
val to_string : symbol -> string
- (** Creates a new symbol using an integer.
+ (** Creates a new symbol using an integer.
Not all integers can be passed to this function.
The legal range of unsigned integers is 0 to 2^30-1. *)
val mk_int : context -> int -> symbol
@@ -125,21 +125,21 @@ end
(** The abstract syntax tree (AST) module *)
module rec AST :
sig
- type ast
+ type ast
(** Vectors of ASTs *)
module ASTVector :
sig
- type ast_vector
+ type ast_vector
(** Create an empty AST vector *)
val mk_ast_vector : context -> ast_vector
-
+
(** The size of the vector *)
val get_size : ast_vector -> int
(** Retrieves the i-th object in the vector.
- @return An AST *)
+ @return An AST *)
val get : ast_vector -> int -> ast
(** Sets the i-th object in the vector. *)
@@ -149,11 +149,11 @@ sig
val resize : ast_vector -> int -> unit
(** Add an ast to the back of the vector. The size
- is increased by 1. *)
+ is increased by 1. *)
val push : ast_vector -> ast -> unit
(** Translates all ASTs in the vector to another context.
- @return A new ASTVector *)
+ @return A new ASTVector *)
val translate : ast_vector -> context -> ast_vector
(** Translates the ASTVector into an (Ast.ast list) *)
@@ -173,13 +173,13 @@ sig
(** Create an empty mapping from AST to AST *)
val mk_ast_map : context -> ast_map
-
+
(** Checks whether the map contains a key.
- @return True if the key in the map, false otherwise. *)
+ @return True if the key in the map, false otherwise. *)
val contains : ast_map -> ast -> bool
(** Finds the value associated with the key.
- This function signs an error when the key is not a key in the map. *)
+ This function signs an error when the key is not a key in the map. *)
val find : ast_map -> ast -> ast
(** Stores or replaces a new key/value pair in the map. *)
@@ -208,7 +208,7 @@ sig
(** A unique identifier for the AST (unique among all ASTs). *)
val get_id : ast -> int
- (** The kind of the AST. *)
+ (** The kind of the AST. *)
val get_ast_kind : ast -> Z3enums.ast_kind
(** Indicates whether the AST is an Expr *)
@@ -233,7 +233,7 @@ sig
val to_sexpr : ast -> string
(** Comparison operator.
- @return True if the two ast's are from the same context
+ @return True if the two ast's are from the same context
and represent the same sort; false otherwise. *)
val equal : ast -> ast -> bool
@@ -244,36 +244,15 @@ sig
(** Translates (copies) the AST to another context.
@return A copy of the AST which is associated with the other context. *)
val translate : ast -> context -> ast
-
- (** Unwraps an AST.
- This function is used for transitions between native and
- managed objects. It returns the native pointer to the AST. Note that
- AST objects are reference counted and unwrapping an AST disables automatic
- reference counting, i.e., all references to the IntPtr that is returned
- must be handled externally and through native calls (see e.g.,
- [Z3native.inc_ref]).
- {!wrap_ast} *)
- val unwrap_ast : ast -> Z3native.ptr
-
- (** Wraps an AST.
-
- This function is used for transitions between native and
- managed objects. Note that the native ast that is passed must be a
- native object obtained from Z3 (e.g., through {!unwrap_ast})
- and that it must have a correct reference count (see e.g.,
- [Z3native.inc_ref]). *)
- val wrap_ast : context -> Z3native.z3_ast -> ast
end
(** The Sort module implements type information for ASTs *)
and Sort :
sig
- type sort = Sort of AST.ast
-
- val ast_of_sort : sort -> AST.ast
+ type sort
(** Comparison operator.
- @return True if the two sorts are from the same context
+ @return True if the two sorts are from the same context
and represent the same sort; false otherwise. *)
val equal : sort -> sort -> bool
@@ -299,23 +278,21 @@ end
(** Function declarations *)
and FuncDecl :
sig
- type func_decl = FuncDecl of AST.ast
-
- val ast_of_func_decl : FuncDecl.func_decl -> AST.ast
+ type func_decl
(** Parameters of Func_Decls *)
module Parameter :
sig
(** Parameters of func_decls *)
type parameter =
- P_Int of int
+ P_Int of int
| P_Dbl of float
| P_Sym of Symbol.symbol
| P_Srt of Sort.sort
| P_Ast of AST.ast
| P_Fdl of func_decl
| P_Rat of string
-
+
(** The kind of the parameter. *)
val get_kind : parameter -> Z3enums.parameter_kind
@@ -377,10 +354,10 @@ sig
(** The size of the domain of the function declaration
{!get_arity} *)
val get_domain_size : func_decl -> int
-
+
(** The domain of the function declaration *)
val get_domain : func_decl -> Sort.sort list
-
+
(** The range of the function declaration *)
val get_range : func_decl -> Sort.sort
@@ -396,7 +373,7 @@ sig
(** The parameters of the function declaration *)
val get_parameters : func_decl -> Parameter.parameter list
- (** Create expression that applies function to arguments. *)
+ (** Create expression that applies function to arguments. *)
val apply : func_decl -> Expr.expr list -> Expr.expr
end
@@ -410,7 +387,7 @@ sig
(** ParamDescrs describe sets of parameters (of Solvers, Tactics, ...) *)
module ParamDescrs :
sig
- type param_descrs
+ type param_descrs
(** Validate a set of parameters. *)
val validate : param_descrs -> params -> unit
@@ -447,19 +424,19 @@ sig
val to_string : params -> string
(** Update a mutable configuration parameter.
-
+
The list of all configuration parameters can be obtained using the Z3 executable:
[z3.exe -p]
Only a few configuration parameters are mutable once the context is created.
An exception is thrown when trying to modify an immutable parameter. *)
val update_param_value : context -> string -> string -> unit
-
+
(** Selects the format used for pretty-printing expressions.
-
+
The default mode for pretty printing expressions is to produce
- SMT-LIB style output where common subexpressions are printed
+ SMT-LIB style output where common subexpressions are printed
at each occurrence. The mode is called PRINT_SMTLIB_FULL.
- To print shared common subexpressions only once,
+ To print shared common subexpressions only once,
use the PRINT_LOW_LEVEL mode.
To print in way that conforms to SMT-LIB standards and uses let
expressions to share common sub-expressions use PRINT_SMTLIB_COMPLIANT.
@@ -473,7 +450,7 @@ end
(** General Expressions (terms) *)
and Expr :
sig
- type expr = Expr of AST.ast
+ type expr
val ast_of_expr : Expr.expr -> AST.ast
val expr_of_ast : AST.ast -> Expr.expr
@@ -494,7 +471,7 @@ sig
(** The number of arguments of the expression. *)
val get_num_args : Expr.expr -> int
- (** The arguments of the expression. *)
+ (** The arguments of the expression. *)
val get_args : Expr.expr -> Expr.expr list
(** Update the arguments of the expression using an array of expressions.
@@ -502,9 +479,9 @@ sig
val update : Expr.expr -> Expr.expr list -> expr
(** Substitute every occurrence of [from[i]] in the expression with [to[i]], for [i] smaller than [num_exprs].
-
+
The result is the new expression. The arrays [from] and [to] must have size [num_exprs].
- For every [i] smaller than [num_exprs], we must have that
+ For every [i] smaller than [num_exprs], we must have that
sort of [from[i]] must be equal to sort of [to[i]]. *)
val substitute : Expr.expr -> Expr.expr list -> Expr.expr list -> expr
@@ -521,14 +498,14 @@ sig
@return A copy of the term which is associated with the other context *)
val translate : Expr.expr -> context -> expr
- (** Returns a string representation of the expression. *)
+ (** Returns a string representation of the expression. *)
val to_string : Expr.expr -> string
(** Indicates whether the term is a numeral *)
val is_numeral : Expr.expr -> bool
(** Indicates whether the term is well-sorted.
- @return True if the term is well-sorted, false otherwise. *)
+ @return True if the term is well-sorted, false otherwise. *)
val is_well_sorted : Expr.expr -> bool
(** The Sort of the term. *)
@@ -536,31 +513,31 @@ sig
(** Indicates whether the term represents a constant. *)
val is_const : Expr.expr -> bool
-
+
(** Creates a new constant. *)
val mk_const : context -> Symbol.symbol -> Sort.sort -> expr
-
+
(** Creates a new constant. *)
val mk_const_s : context -> string -> Sort.sort -> expr
-
+
(** Creates a constant from the func_decl. *)
val mk_const_f : context -> FuncDecl.func_decl -> expr
-
+
(** Creates a fresh constant with a name prefixed with a string. *)
val mk_fresh_const : context -> string -> Sort.sort -> expr
-
+
(** Create a new function application. *)
val mk_app : context -> FuncDecl.func_decl -> Expr.expr list -> expr
-
- (** Create a numeral of a given sort.
+
+ (** Create a numeral of a given sort.
@return A Term with the given value and sort *)
val mk_numeral_string : context -> string -> Sort.sort -> expr
-
+
(** Create a numeral of a given sort. This function can be use to create numerals that fit in a machine integer.
- It is slightly faster than [MakeNumeral] since it is not necessary to parse a string.
+ It is slightly faster than [MakeNumeral] since it is not necessary to parse a string.
@return A Term with the given value and sort *)
val mk_numeral_int : context -> int -> Sort.sort -> expr
-
+
(** Comparison operator.
@return True if the two expr's are equal; false otherwise. *)
val equal : expr -> expr -> bool
@@ -576,22 +553,22 @@ sig
(** Create a Boolean sort *)
val mk_sort : context -> Sort.sort
- (** Create a Boolean constant. *)
+ (** Create a Boolean constant. *)
val mk_const : context -> Symbol.symbol -> Expr.expr
- (** Create a Boolean constant. *)
+ (** Create a Boolean constant. *)
val mk_const_s : context -> string -> Expr.expr
- (** The true Term. *)
+ (** The true Term. *)
val mk_true : context -> Expr.expr
- (** The false Term. *)
+ (** The false Term. *)
val mk_false : context -> Expr.expr
- (** Creates a Boolean value. *)
+ (** Creates a Boolean value. *)
val mk_val : context -> bool -> Expr.expr
- (** Mk an expression representing [not(a)]. *)
+ (** Mk an expression representing [not(a)]. *)
val mk_not : context -> Expr.expr -> Expr.expr
(** Create an expression representing an if-then-else: [ite(t1, t2, t3)]. *)
@@ -662,7 +639,7 @@ end
(** Quantifier expressions *)
module Quantifier :
sig
- type quantifier = Quantifier of Expr.expr
+ type quantifier
val expr_of_quantifier : quantifier -> Expr.expr
val quantifier_of_expr : Expr.expr -> quantifier
@@ -674,10 +651,7 @@ sig
also called a multi-pattern. *)
module Pattern :
sig
- type pattern = Pattern of AST.ast
-
- val ast_of_pattern : pattern -> AST.ast
- val pattern_of_ast : AST.ast -> pattern
+ type pattern
(** The number of terms in the pattern. *)
val get_num_terms : pattern -> int
@@ -691,7 +665,7 @@ sig
(** The de-Burijn index of a bound variable.
-
+
Bound variables are indexed by de-Bruijn indices. It is perhaps easiest to explain
the meaning of de-Bruijn indices by indicating the compilation process from
non-de-Bruijn formulas to de-Bruijn format.
@@ -722,19 +696,19 @@ sig
(** The patterns. *)
val get_patterns : quantifier -> Pattern.pattern list
-
+
(** The number of no-patterns. *)
val get_num_no_patterns : quantifier -> int
-
+
(** The no-patterns. *)
val get_no_patterns : quantifier -> Pattern.pattern list
(** The number of bound variables. *)
val get_num_bound : quantifier -> int
-
+
(** The symbols for the bound variables. *)
val get_bound_variable_names : quantifier -> Symbol.symbol list
-
+
(** The sorts of the bound variables. *)
val get_bound_variable_sorts : quantifier -> Sort.sort list
@@ -761,7 +735,7 @@ sig
(** Create a Quantifier. *)
val mk_quantifier : context -> Sort.sort list -> Symbol.symbol list -> Expr.expr -> int option -> Pattern.pattern list -> Expr.expr list -> Symbol.symbol option -> Symbol.symbol option -> quantifier
-
+
(** Create a Quantifier. *)
val mk_quantifier : context -> bool -> Expr.expr list -> Expr.expr -> int option -> Pattern.pattern list -> Expr.expr list -> Symbol.symbol option -> Symbol.symbol option -> quantifier
@@ -775,28 +749,28 @@ sig
(** Create a new array sort. *)
val mk_sort : context -> Sort.sort -> Sort.sort -> Sort.sort
- (** Indicates whether the term is an array store.
- It satisfies select(store(a,i,v),j) = if i = j then v else select(a,j).
+ (** Indicates whether the term is an array store.
+ It satisfies select(store(a,i,v),j) = if i = j then v else select(a,j).
Array store takes at least 3 arguments. *)
val is_store : Expr.expr -> bool
(** Indicates whether the term is an array select. *)
val is_select : Expr.expr -> bool
- (** Indicates whether the term is a constant array.
+ (** Indicates whether the term is a constant array.
For example, select(const(v),i) = v holds for every v and i. The function is unary. *)
val is_constant_array : Expr.expr -> bool
- (** Indicates whether the term is a default array.
+ (** Indicates whether the term is a default array.
For example default(const(v)) = v. The function is unary. *)
val is_default_array : Expr.expr -> bool
- (** Indicates whether the term is an array map.
+ (** Indicates whether the term is an array map.
It satisfies map[f](a1,..,a_n)[i] = f(a1[i],...,a_n[i]) for every i. *)
val is_array_map : Expr.expr -> bool
- (** Indicates whether the term is an as-array term.
- An as-array term is n array value that behaves as the function graph of the
+ (** Indicates whether the term is an as-array term.
+ An as-array term is n array value that behaves as the function graph of the
function passed as parameter. *)
val is_as_array : Expr.expr -> bool
@@ -805,54 +779,54 @@ sig
(** The domain of the array sort. *)
val get_domain : Sort.sort -> Sort.sort
-
+
(** The range of the array sort. *)
val get_range : Sort.sort -> Sort.sort
-
- (** Create an array constant. *)
+
+ (** Create an array constant. *)
val mk_const : context -> Symbol.symbol -> Sort.sort -> Sort.sort -> Expr.expr
-
- (** Create an array constant. *)
+
+ (** Create an array constant. *)
val mk_const_s : context -> string -> Sort.sort -> Sort.sort -> Expr.expr
-
- (** Array read.
-
- The argument [a] is the array and [i] is the index
- of the array that gets read.
-
- The node [a] must have an array sort [[domain -> range]],
+
+ (** Array read.
+
+ The argument [a] is the array and [i] is the index
+ of the array that gets read.
+
+ The node [a] must have an array sort [[domain -> range]],
and [i] must have the sort [domain].
The sort of the result is [range].
{!Z3Array.mk_sort}
{!mk_store} *)
val mk_select : context -> Expr.expr -> Expr.expr -> Expr.expr
- (** Array update.
-
- The node [a] must have an array sort [[domain -> range]],
+ (** Array update.
+
+ The node [a] must have an array sort [[domain -> range]],
[i] must have sort [domain],
[v] must have sort range. The sort of the result is [[domain -> range]].
The semantics of this function is given by the theory of arrays described in the SMT-LIB
standard. See http://smtlib.org for more details.
- The result of this function is an array that is equal to [a]
+ The result of this function is an array that is equal to [a]
(with respect to [select])
- on all indices except for [i], where it maps to [v]
- (and the [select] of [a] with
+ on all indices except for [i], where it maps to [v]
+ (and the [select] of [a] with
respect to [i] may be a different value).
{!Z3Array.mk_sort}
{!mk_select} *)
val mk_store : context -> Expr.expr -> Expr.expr -> Expr.expr -> Expr.expr
(** Create a constant array.
-
- The resulting term is an array, such that a [select]on an arbitrary index
+
+ The resulting term is an array, such that a [select]on an arbitrary index
produces the value [v].
{!Z3Array.mk_sort}
{!mk_select} *)
val mk_const_array : context -> Sort.sort -> Expr.expr -> Expr.expr
(** Maps f on the argument arrays.
-
+
Eeach element of [args] must be of an array sort [[domain_i -> range_i]].
The function declaration [f] must have type [ range_1 .. range_n -> range].
[v] must have sort range. The sort of the result is [[domain_i -> range]].
@@ -862,12 +836,12 @@ sig
val mk_map : context -> FuncDecl.func_decl -> Expr.expr list -> Expr.expr
(** Access the array default value.
-
- Produces the default range value, for arrays that can be represented as
+
+ Produces the default range value, for arrays that can be represented as
finite maps with a default range value. *)
val mk_term_array : context -> Expr.expr -> Expr.expr
- (** Create array extensionality index given two arrays with the same sort.
+ (** Create array extensionality index given two arrays with the same sort.
The meaning is given by the axiom:
(=> (= (select A (array-ext A B)) (select B (array-ext A B))) (= A B)) *)
@@ -954,9 +928,9 @@ sig
val is_relation : Expr.expr -> bool
(** Indicates whether the term is an relation store
-
+
Insert a record into a relation.
- The function takes [n+1] arguments, where the first argument is the relation and the remaining [n] elements
+ The function takes [n+1] arguments, where the first argument is the relation and the remaining [n] elements
correspond to the [n] columns of the relation. *)
val is_store : Expr.expr -> bool
@@ -969,7 +943,7 @@ sig
(** Indicates whether the term is a relational join *)
val is_join : Expr.expr -> bool
- (** Indicates whether the term is the union or convex hull of two relations.
+ (** Indicates whether the term is the union or convex hull of two relations.
The function takes two arguments. *)
val is_union : Expr.expr -> bool
@@ -982,29 +956,29 @@ sig
val is_project : Expr.expr -> bool
(** Indicates whether the term is a relation filter
-
+
Filter (restrict) a relation with respect to a predicate.
- The first argument is a relation.
+ The first argument is a relation.
The second argument is a predicate with free de-Brujin indices
corresponding to the columns of the relation.
So the first column in the relation has index 0. *)
val is_filter : Expr.expr -> bool
(** Indicates whether the term is an intersection of a relation with the negation of another.
-
+
Intersect the first relation with respect to negation
of the second relation (the function takes two arguments).
Logically, the specification can be described by a function
-
+
target = filter_by_negation(pos, neg, columns)
-
+
where columns are pairs c1, d1, .., cN, dN of columns from pos and neg, such that
target are elements in ( x : expr ) in pos, such that there is no y in neg that agrees with
( x : expr ) on the columns c1, d1, .., cN, dN. *)
val is_negation_filter : Expr.expr -> bool
(** Indicates whether the term is the renaming of a column in a relation
-
+
The function takes one argument.
The parameters contain the renaming as a cycle. *)
val is_rename : Expr.expr -> bool
@@ -1013,18 +987,18 @@ sig
val is_complement : Expr.expr -> bool
(** Indicates whether the term is a relational select
-
+
Check if a record is an element of the relation.
The function takes [n+1] arguments, where the first argument is a relation,
and the remaining [n] arguments correspond to a record. *)
val is_select : Expr.expr -> bool
(** Indicates whether the term is a relational clone (copy)
-
- Create a fresh copy (clone) of a relation.
+
+ Create a fresh copy (clone) of a relation.
The function is logically the identity, but
- in the context of a register machine allows
- for terms of kind {!is_union}
+ in the context of a register machine allows
+ for terms of kind {!is_union}
to perform destructive updates to the first argument. *)
val is_clone : Expr.expr -> bool
@@ -1045,24 +1019,24 @@ sig
(** The number of fields of the constructor. *)
val get_num_fields : constructor -> int
-
+
(** The function declaration of the constructor. *)
val get_constructor_decl : constructor -> FuncDecl.func_decl
(** The function declaration of the tester. *)
val get_tester_decl : constructor -> FuncDecl.func_decl
-
+
(** The function declarations of the accessors *)
val get_accessor_decls : constructor -> FuncDecl.func_decl list
end
(** Create a datatype constructor.
- if the corresponding sort reference is 0, then the value in sort_refs should be an index
+ if the corresponding sort reference is 0, then the value in sort_refs should be an index
referring to one of the recursive datatypes that is declared. *)
val mk_constructor : context -> Symbol.symbol -> Symbol.symbol -> Symbol.symbol list -> Sort.sort option list -> int list -> Constructor.constructor
(** Create a datatype constructor.
- if the corresponding sort reference is 0, then the value in sort_refs should be an index
+ if the corresponding sort reference is 0, then the value in sort_refs should be an index
referring to one of the recursive datatypes that is declared. *)
val mk_constructor_s : context -> string -> Symbol.symbol -> Symbol.symbol list -> Sort.sort option list -> int list -> Constructor.constructor
@@ -1078,13 +1052,12 @@ sig
(** Create mutually recursive data-types. *)
val mk_sorts_s : context -> string list -> Constructor.constructor list list -> Sort.sort list
-
(** The number of constructors of the datatype sort. *)
val get_num_constructors : Sort.sort -> int
(** The constructors. *)
val get_constructors : Sort.sort -> FuncDecl.func_decl list
-
+
(** The recognizers. *)
val get_recognizers : Sort.sort -> FuncDecl.func_decl list
@@ -1154,7 +1127,7 @@ end
(** Functions to manipulate Tuple expressions *)
module Tuple :
sig
- (** Create a new tuple sort. *)
+ (** Create a new tuple sort. *)
val mk_sort : context -> Symbol.symbol -> Symbol.symbol list -> Sort.sort list -> Sort.sort
(** The constructor function of the tuple. *)
@@ -1173,7 +1146,7 @@ sig
(** Integer Arithmetic *)
module Integer :
sig
- (** Create a new integer sort. *)
+ (** Create a new integer sort. *)
val mk_sort : context -> Sort.sort
(** Retrieve the int value. *)
@@ -1185,7 +1158,7 @@ sig
(** Returns a string representation of a numeral. *)
val numeral_to_string : Expr.expr -> string
- (** Creates an integer constant. *)
+ (** Creates an integer constant. *)
val mk_const : context -> Symbol.symbol -> Expr.expr
(** Creates an integer constant. *)
@@ -1206,21 +1179,21 @@ sig
@return A Term with the given value and sort Integer *)
val mk_numeral_i : context -> int -> Expr.expr
- (** Coerce an integer to a real.
-
+ (** Coerce an integer to a real.
+
There is also a converse operation exposed. It follows the semantics prescribed by the SMT-LIB standard.
-
+
You can take the floor of a real by creating an auxiliary integer Term [k] and
and asserting [MakeInt2Real(k) <= t1 < MkInt2Real(k)+1].
The argument must be of integer sort. *)
val mk_int2real : context -> Expr.expr -> Expr.expr
- (** Create an n-bit bit-vector from an integer argument.
-
- NB. This function is essentially treated as uninterpreted.
+ (** Create an n-bit bit-vector from an integer argument.
+
+ NB. This function is essentially treated as uninterpreted.
So you cannot expect Z3 to precisely reflect the semantics of this function
when solving constraints with this function.
-
+
The argument must be of integer sort. *)
val mk_int2bv : context -> int -> Expr.expr -> Expr.expr
end
@@ -1228,7 +1201,7 @@ sig
(** Real Arithmetic *)
module Real :
sig
- (** Create a real sort. *)
+ (** Create a real sort. *)
val mk_sort : context -> Sort.sort
(** The numerator of a rational numeral. *)
@@ -1240,7 +1213,7 @@ sig
(** Get a ratio from a real numeral *)
val get_ratio : Expr.expr -> Ratio.ratio
- (** Returns a string representation in decimal notation.
+ (** Returns a string representation in decimal notation.
The result has at most as many decimal places as indicated by the int argument.*)
val to_decimal_string : Expr.expr-> int -> string
@@ -1253,7 +1226,7 @@ sig
(** Creates a real constant. *)
val mk_const_s : context -> string -> Expr.expr
- (** Create a real numeral from a fraction.
+ (** Create a real numeral from a fraction.
@return A Term with rational value and sort Real
{!mk_numeral_s} *)
val mk_numeral_nd : context -> int -> int -> Expr.expr
@@ -1274,26 +1247,26 @@ sig
The semantics of this function follows the SMT-LIB standard for the function to_int.
The argument must be of real sort. *)
val mk_real2int : context -> Expr.expr -> Expr.expr
-
+
(** Algebraic Numbers *)
module AlgebraicNumber :
sig
- (** Return a upper bound for a given real algebraic number.
+ (** Return a upper bound for a given real algebraic number.
The interval isolating the number is smaller than 1/10^precision.
- {!is_algebraic_number}
+ {!is_algebraic_number}
@return A numeral Expr of sort Real *)
val to_upper : Expr.expr -> int -> Expr.expr
-
- (** Return a lower bound for the given real algebraic number.
+
+ (** Return a lower bound for the given real algebraic number.
The interval isolating the number is smaller than 1/10^precision.
{!is_algebraic_number}
@return A numeral Expr of sort Real *)
val to_lower : Expr.expr -> int -> Expr.expr
-
- (** Returns a string representation in decimal notation.
+
+ (** Returns a string representation in decimal notation.
The result has at most as many decimal places as the int argument provided.*)
val to_decimal_string : Expr.expr -> int -> string
-
+
(** Returns a string representation of a numeral. *)
val numeral_to_string : Expr.expr -> string
end
@@ -1362,34 +1335,34 @@ sig
(** Indicates whether the term is an algebraic number *)
val is_algebraic_number : Expr.expr -> bool
- (** Create an expression representing [t[0] + t[1] + ...]. *)
+ (** Create an expression representing [t[0] + t[1] + ...]. *)
val mk_add : context -> Expr.expr list -> Expr.expr
- (** Create an expression representing [t[0] * t[1] * ...]. *)
+ (** Create an expression representing [t[0] * t[1] * ...]. *)
val mk_mul : context -> Expr.expr list -> Expr.expr
- (** Create an expression representing [t[0] - t[1] - ...]. *)
+ (** Create an expression representing [t[0] - t[1] - ...]. *)
val mk_sub : context -> Expr.expr list -> Expr.expr
- (** Create an expression representing [-t]. *)
+ (** Create an expression representing [-t]. *)
val mk_unary_minus : context -> Expr.expr -> Expr.expr
- (** Create an expression representing [t1 / t2]. *)
+ (** Create an expression representing [t1 / t2]. *)
val mk_div : context -> Expr.expr -> Expr.expr -> Expr.expr
- (** Create an expression representing [t1 ^ t2]. *)
+ (** Create an expression representing [t1 ^ t2]. *)
val mk_power : context -> Expr.expr -> Expr.expr -> Expr.expr
- (** Create an expression representing [t1 < t2] *)
+ (** Create an expression representing [t1 < t2] *)
val mk_lt : context -> Expr.expr -> Expr.expr -> Expr.expr
- (** Create an expression representing [t1 <= t2] *)
+ (** Create an expression representing [t1 <= t2] *)
val mk_le : context -> Expr.expr -> Expr.expr -> Expr.expr
- (** Create an expression representing [t1 > t2] *)
+ (** Create an expression representing [t1 > t2] *)
val mk_gt : context -> Expr.expr -> Expr.expr -> Expr.expr
- (** Create an expression representing [t1 >= t2] *)
+ (** Create an expression representing [t1 >= t2] *)
val mk_ge : context -> Expr.expr -> Expr.expr -> Expr.expr
end
@@ -1544,22 +1517,22 @@ sig
(** Indicates whether the term is a bit-vector rotate right (extended)
Similar to Z3_OP_ROTATE_RIGHT, but it is a binary operator instead of a parametric one. *)
val is_bv_rotaterightextended : Expr.expr -> bool
-
+
(** Indicates whether the term is a coercion from bit-vector to integer
- This function is not supported by the decision procedures. Only the most
+ This function is not supported by the decision procedures. Only the most
rudimentary simplification rules are applied to this function. *)
val is_int2bv : Expr.expr -> bool
(** Indicates whether the term is a coercion from integer to bit-vector
- This function is not supported by the decision procedures. Only the most
+ This function is not supported by the decision procedures. Only the most
rudimentary simplification rules are applied to this function. *)
val is_bv2int : Expr.expr -> bool
(** Indicates whether the term is a bit-vector carry
- Compute the carry bit in a full-adder. The meaning is given by the
+ Compute the carry bit in a full-adder. The meaning is given by the
equivalence (carry l1 l2 l3) <=> (or (and l1 l2) (and l1 l3) (and l2 l3))) *)
val is_bv_carry : Expr.expr -> bool
-
+
(** Indicates whether the term is a bit-vector ternary XOR
The meaning is given by the equivalence (xor3 l1 l2 l3) <=> (xor (xor l1 l2) l3) *)
val is_bv_xor3 : Expr.expr -> bool
@@ -1569,7 +1542,7 @@ sig
(** Retrieve the int value. *)
val get_int : Expr.expr -> int
-
+
(** Returns a string representation of a numeral. *)
val numeral_to_string : Expr.expr -> string
@@ -1632,7 +1605,7 @@ sig
val mk_mul : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Unsigned division.
-
+
It is defined as the floor of [t1/t2] if \c t2 is
different from zero. If [t2] is zero, then the result
is undefined.
@@ -1640,7 +1613,7 @@ sig
val mk_udiv : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Signed division.
-
+
It is defined in the following way:
- The \c floor of [t1/t2] if \c t2 is different from zero, and [t1*t2 >= 0].
@@ -1652,14 +1625,14 @@ sig
val mk_sdiv : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Unsigned remainder.
-
- It is defined as [t1 - (t1 /u t2) * t2], where [/u] represents unsigned division.
+
+ It is defined as [t1 - (t1 /u t2) * t2], where [/u] represents unsigned division.
If [t2] is zero, then the result is undefined.
The arguments must have the same bit-vector sort. *)
val mk_urem : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Signed remainder.
-
+
It is defined as [t1 - (t1 /s t2) * t2], where [/s] represents signed division.
The most significant bit (sign) of the result is equal to the most significant bit of \c t1.
@@ -1668,63 +1641,63 @@ sig
val mk_srem : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Two's complement signed remainder (sign follows divisor).
-
+
If [t2] is zero, then the result is undefined.
The arguments must have the same bit-vector sort. *)
val mk_smod : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Unsigned less-than
-
+
The arguments must have the same bit-vector sort. *)
val mk_ult : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Two's complement signed less-than
-
+
The arguments must have the same bit-vector sort. *)
val mk_slt : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Unsigned less-than or equal to.
-
+
The arguments must have the same bit-vector sort. *)
val mk_ule : context -> Expr.expr -> Expr.expr -> Expr.expr
-
+
(** Two's complement signed less-than or equal to.
-
+
The arguments must have the same bit-vector sort. *)
val mk_sle : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Unsigned greater than or equal to.
-
+
The arguments must have the same bit-vector sort. *)
val mk_uge : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Two's complement signed greater than or equal to.
-
+
The arguments must have the same bit-vector sort. *)
val mk_sge : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Unsigned greater-than.
-
+
The arguments must have the same bit-vector sort. *)
val mk_ugt : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Two's complement signed greater-than.
-
+
The arguments must have the same bit-vector sort. *)
val mk_sgt : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Bit-vector concatenation.
-
+
The arguments must have a bit-vector sort.
- @return
- The result is a bit-vector of size [n1+n2], where [n1] ([n2])
+ @return
+ The result is a bit-vector of size [n1+n2], where [n1] ([n2])
is the size of [t1] ([t2]). *)
val mk_concat : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Bit-vector extraction.
-
+
Extract the bits between two limits from a bitvector of
- size [m] to yield a new bitvector of size [n], where
+ size [m] to yield a new bitvector of size [n], where
[n = high - low + 1]. *)
val mk_extract : context -> int -> int -> Expr.expr -> Expr.expr
@@ -1740,38 +1713,38 @@ sig
bitvector of size [m+i], where \c m is the size of the
given bit-vector. *)
val mk_zero_ext : context -> int -> Expr.expr -> Expr.expr
-
+
(** Bit-vector repetition. *)
val mk_repeat : context -> int -> Expr.expr -> Expr.expr
(** Shift left.
It is equivalent to multiplication by [2^x] where \c x is the value of third argument.
-
- NB. The semantics of shift operations varies between environments. This
- definition does not necessarily capture directly the semantics of the
+
+ NB. The semantics of shift operations varies between environments. This
+ definition does not necessarily capture directly the semantics of the
programming language or assembly architecture you are modeling.*)
val mk_shl : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Logical shift right
-
+
It is equivalent to unsigned division by [2^x] where \c x is the value of the third argument.
- NB. The semantics of shift operations varies between environments. This
- definition does not necessarily capture directly the semantics of the
+ NB. The semantics of shift operations varies between environments. This
+ definition does not necessarily capture directly the semantics of the
programming language or assembly architecture you are modeling.
The arguments must have a bit-vector sort. *)
val mk_lshr : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Arithmetic shift right
-
+
It is like logical shift right except that the most significant
bits of the result always copy the most significant bit of the
second argument.
- NB. The semantics of shift operations varies between environments. This
- definition does not necessarily capture directly the semantics of the
+ NB. The semantics of shift operations varies between environments. This
+ definition does not necessarily capture directly the semantics of the
programming language or assembly architecture you are modeling.
The arguments must have a bit-vector sort. *)
@@ -1781,70 +1754,70 @@ sig
Rotate bits of \c t to the left \c i times. *)
val mk_rotate_left : context -> int -> Expr.expr -> Expr.expr
- (** Rotate Right.
+ (** Rotate Right.
Rotate bits of \c t to the right \c i times.*)
val mk_rotate_right : context -> int -> Expr.expr -> Expr.expr
- (** Rotate Left.
+ (** Rotate Left.
Rotate bits of the second argument to the left.*)
val mk_ext_rotate_left : context -> Expr.expr -> Expr.expr -> Expr.expr
- (** Rotate Right.
+ (** Rotate Right.
Rotate bits of the second argument to the right. *)
val mk_ext_rotate_right : context -> Expr.expr -> Expr.expr -> Expr.expr
- (** Create an integer from the bit-vector argument
-
- If \c is_signed is false, then the bit-vector \c t1 is treated as unsigned.
- So the result is non-negative and in the range [[0..2^N-1]], where
+ (** Create an integer from the bit-vector argument
+
+ If \c is_signed is false, then the bit-vector \c t1 is treated as unsigned.
+ So the result is non-negative and in the range [[0..2^N-1]], where
N are the number of bits in the argument.
If \c is_signed is true, \c t1 is treated as a signed bit-vector.
-
- NB. This function is essentially treated as uninterpreted.
+
+ NB. This function is essentially treated as uninterpreted.
So you cannot expect Z3 to precisely reflect the semantics of this function
when solving constraints with this function.*)
val mk_bv2int : context -> Expr.expr -> bool -> Expr.expr
-
+
(** Create a predicate that checks that the bit-wise addition does not overflow.
-
+
The arguments must be of bit-vector sort. *)
val mk_add_no_overflow : context -> Expr.expr -> Expr.expr -> bool -> Expr.expr
(** Create a predicate that checks that the bit-wise addition does not underflow.
-
+
The arguments must be of bit-vector sort. *)
val mk_add_no_underflow : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Create a predicate that checks that the bit-wise subtraction does not overflow.
-
+
The arguments must be of bit-vector sort. *)
val mk_sub_no_overflow : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Create a predicate that checks that the bit-wise subtraction does not underflow.
-
+
The arguments must be of bit-vector sort. *)
val mk_sub_no_underflow : context -> Expr.expr -> Expr.expr -> bool -> Expr.expr
(** Create a predicate that checks that the bit-wise signed division does not overflow.
-
+
The arguments must be of bit-vector sort. *)
val mk_sdiv_no_overflow : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Create a predicate that checks that the bit-wise negation does not overflow.
-
- The arguments must be of bit-vector sort. *)
+
+ The arguments must be of bit-vector sort. *)
val mk_neg_no_overflow : context -> Expr.expr -> Expr.expr
(** Create a predicate that checks that the bit-wise multiplication does not overflow.
-
+
The arguments must be of bit-vector sort. *)
val mk_mul_no_overflow : context -> Expr.expr -> Expr.expr -> bool -> Expr.expr
(** Create a predicate that checks that the bit-wise multiplication does not underflow.
-
+
The arguments must be of bit-vector sort. *)
val mk_mul_no_underflow : context -> Expr.expr -> Expr.expr -> Expr.expr
-
+
(** Create a bit-vector numeral. *)
val mk_numeral : context -> string -> int -> Expr.expr
end
@@ -1853,7 +1826,7 @@ end
module FloatingPoint :
sig
- (** Rounding Modes *)
+ (** Rounding Modes *)
module RoundingMode :
sig
(** Create the RoundingMode sort. *)
@@ -1864,47 +1837,47 @@ sig
(** Create a numeral of RoundingMode sort which represents the NearestTiesToEven rounding mode. *)
val mk_round_nearest_ties_to_even : context -> Expr.expr
-
+
(** Create a numeral of RoundingMode sort which represents the NearestTiesToEven rounding mode. *)
val mk_rne : context -> Expr.expr
(** Create a numeral of RoundingMode sort which represents the NearestTiesToAway rounding mode. *)
val mk_round_nearest_ties_to_away : context -> Expr.expr
-
+
(** Create a numeral of RoundingMode sort which represents the NearestTiesToAway rounding mode. *)
val mk_rna : context -> Expr.expr
-
+
(** Create a numeral of RoundingMode sort which represents the TowardPositive rounding mode. *)
val mk_round_toward_positive : context -> Expr.expr
-
+
(** Create a numeral of RoundingMode sort which represents the TowardPositive rounding mode. *)
val mk_rtp : context -> Expr.expr
-
+
(** Create a numeral of RoundingMode sort which represents the TowardNegative rounding mode. *)
val mk_round_toward_negative : context -> Expr.expr
-
+
(** Create a numeral of RoundingMode sort which represents the TowardNegative rounding mode. *)
val mk_rtn : context -> Expr.expr
-
+
(** Create a numeral of RoundingMode sort which represents the TowardZero rounding mode. *)
val mk_round_toward_zero : context -> Expr.expr
-
+
(** Create a numeral of RoundingMode sort which represents the TowardZero rounding mode. *)
val mk_rtz : context -> Expr.expr
end
(** Create a FloatingPoint sort. *)
val mk_sort : context -> int -> int -> Sort.sort
-
- (** Create the half-precision (16-bit) FloatingPoint sort.*)
+
+ (** Create the half-precision (16-bit) FloatingPoint sort.*)
val mk_sort_half : context -> Sort.sort
-
+
(** Create the half-precision (16-bit) FloatingPoint sort. *)
val mk_sort_16 : context -> Sort.sort
(** Create the single-precision (32-bit) FloatingPoint sort.*)
val mk_sort_single : context -> Sort.sort
-
+
(** Create the single-precision (32-bit) FloatingPoint sort. *)
val mk_sort_32 : context -> Sort.sort
@@ -1913,7 +1886,7 @@ sig
(** Create the double-precision (64-bit) FloatingPoint sort. *)
val mk_sort_64 : context -> Sort.sort
-
+
(** Create the quadruple-precision (128-bit) FloatingPoint sort. *)
val mk_sort_quadruple : context -> Sort.sort
@@ -1929,11 +1902,11 @@ sig
(** Create a floating-point zero of a given FloatingPoint sort. *)
val mk_zero : context -> Sort.sort -> bool -> Expr.expr
- (** Create an expression of FloatingPoint sort from three bit-vector expressions.
+ (** Create an expression of FloatingPoint sort from three bit-vector expressions.
This is the operator named `fp' in the SMT FP theory definition.
- Note that \c sign is required to be a bit-vector of size 1. Significand and exponent
- are required to be greater than 1 and 2 respectively. The FloatingPoint sort
+ Note that \c sign is required to be a bit-vector of size 1. Significand and exponent
+ are required to be greater than 1 and 2 respectively. The FloatingPoint sort
of the resulting expression is automatically determined from the bit-vector sizes
of the arguments. *)
val mk_fp : context -> Expr.expr -> Expr.expr -> Expr.expr -> Expr.expr
@@ -1946,16 +1919,16 @@ sig
(** Create a numeral of FloatingPoint sort from a signed integer. *)
val mk_numeral_i : context -> int -> Sort.sort -> Expr.expr
-
+
(** Create a numeral of FloatingPoint sort from a sign bit and two integers. *)
val mk_numeral_i_u : context -> bool -> int -> int -> Sort.sort -> Expr.expr
(** Create a numeral of FloatingPoint sort from a string *)
val mk_numeral_s : context -> string -> Sort.sort -> Expr.expr
-
+
(** Indicates whether the terms is of floating-point sort. *)
val is_fp : Expr.expr -> bool
-
+
(** Indicates whether an expression is a floating-point abs expression *)
val is_abs : Expr.expr -> bool
@@ -1965,7 +1938,7 @@ sig
(** Indicates whether an expression is a floating-point add expression *)
val is_add : Expr.expr -> bool
-
+
(** Indicates whether an expression is a floating-point sub expression *)
val is_sub : Expr.expr -> bool
@@ -2022,7 +1995,7 @@ sig
(** Indicates whether an expression is a floating-point is_nan expression *)
val is_is_nan : Expr.expr -> bool
-
+
(** Indicates whether an expression is a floating-point is_negative expression *)
val is_is_negative : Expr.expr -> bool
@@ -2077,16 +2050,16 @@ sig
(** Floating-point fused multiply-add. *)
val mk_fma : context -> Expr.expr -> Expr.expr -> Expr.expr -> Expr.expr -> Expr.expr
-
+
(** Floating-point square root *)
val mk_sqrt : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Floating-point remainder *)
val mk_rem : context -> Expr.expr -> Expr.expr -> Expr.expr
-
- (** Floating-point roundToIntegral.
- Rounds a floating-point number to the closest integer,
+ (** Floating-point roundToIntegral.
+
+ Rounds a floating-point number to the closest integer,
again represented as a floating-point number. *)
val mk_round_to_integral : context -> Expr.expr -> Expr.expr -> Expr.expr
@@ -2095,16 +2068,16 @@ sig
(** Maximum of floating-point numbers. *)
val mk_max : context -> Expr.expr -> Expr.expr -> Expr.expr
-
+
(** Floating-point less than or equal. *)
val mk_leq : context -> Expr.expr -> Expr.expr -> Expr.expr
-
+
(** Floating-point less than. *)
val mk_lt : context -> Expr.expr -> Expr.expr -> Expr.expr
(** Floating-point greater than or equal. *)
val mk_geq : context -> Expr.expr -> Expr.expr -> Expr.expr
-
+
(** Floating-point greater than. *)
val mk_gt : context -> Expr.expr -> Expr.expr -> Expr.expr
@@ -2149,27 +2122,27 @@ sig
(** C1onversion of a floating-point term into an unsigned bit-vector. *)
val mk_to_ubv : context -> Expr.expr -> Expr.expr -> int -> Expr.expr
-
+
(** Conversion of a floating-point term into a signed bit-vector. *)
val mk_to_sbv : context -> Expr.expr -> Expr.expr -> int -> Expr.expr
(** Conversion of a floating-point term into a real-numbered term. *)
val mk_to_real : context -> Expr.expr -> Expr.expr
-
+
(** Retrieves the number of bits reserved for the exponent in a FloatingPoint sort. *)
val get_ebits : context -> Sort.sort -> int
(** Retrieves the number of bits reserved for the significand in a FloatingPoint sort. *)
val get_sbits : context -> Sort.sort -> int
-
+
(** Retrieves the sign of a floating-point literal. *)
val get_numeral_sign : context -> Expr.expr -> bool * int
(** Return the significand value of a floating-point numeral as a string. *)
val get_numeral_significand_string : context -> Expr.expr -> string
- (** Return the significand value of a floating-point numeral as a uint64.
- Remark: This function extracts the significand bits, without the
+ (** Return the significand value of a floating-point numeral as a uint64.
+ Remark: This function extracts the significand bits, without the
hidden bit or normalization. Throws an exception if the
significand does not fit into a uint64. *)
val get_numeral_significand_uint : context -> Expr.expr -> bool * int
@@ -2179,7 +2152,7 @@ sig
(** Return the exponent value of a floating-point numeral as a signed integer *)
val get_numeral_exponent_int : context -> Expr.expr -> bool * int
-
+
(** Conversion of a floating-point term into a bit-vector term in IEEE 754-2008 format. *)
val mk_to_ieee_bv : context -> Expr.expr -> Expr.expr
@@ -2203,13 +2176,13 @@ sig
(** Indicates whether the term is a proof for a fact (tagged as goal) asserted by the user. *)
val is_goal : Expr.expr -> bool
- (** Indicates whether the term is a binary equivalence modulo namings.
+ (** Indicates whether the term is a binary equivalence modulo namings.
This binary predicate is used in proof terms.
It captures equisatisfiability and equivalence modulo renamings. *)
val is_oeq : Expr.expr -> bool
(** Indicates whether the term is proof via modus ponens
-
+
Given a proof for p and a proof for (implies p q), produces a proof for q.
T1: p
T2: (implies p q)
@@ -2218,14 +2191,14 @@ sig
val is_modus_ponens : Expr.expr -> bool
(** Indicates whether the term is a proof for (R t t), where R is a reflexive relation.
- This proof object has no antecedents.
- The only reflexive relations that are used are
+ This proof object has no antecedents.
+ The only reflexive relations that are used are
equivalence modulo namings, equality and equivalence.
That is, R is either '~', '=' or 'iff'. *)
val is_reflexivity : Expr.expr -> bool
(** Indicates whether the term is proof by symmetricity of a relation
-
+
Given an symmetric relation R and a proof for (R t s), produces a proof for (R s t).
T1: (R t s)
[symmetry T1]: (R s t)
@@ -2233,51 +2206,51 @@ sig
val is_symmetry : Expr.expr -> bool
(** Indicates whether the term is a proof by transitivity of a relation
-
- Given a transitive relation R, and proofs for (R t s) and (R s u), produces a proof
- for (R t u).
+
+ Given a transitive relation R, and proofs for (R t s) and (R s u), produces a proof
+ for (R t u).
T1: (R t s)
T2: (R s u)
[trans T1 T2]: (R t u) *)
val is_transitivity : Expr.expr -> bool
(** Indicates whether the term is a proof by condensed transitivity of a relation
-
+
Condensed transitivity proof. This proof object is only used if the parameter PROOF_MODE is 1.
- It combines several symmetry and transitivity proofs.
+ It combines several symmetry and transitivity proofs.
Example:
T1: (R a b)
T2: (R c b)
T3: (R c d)
- [trans* T1 T2 T3]: (R a d)
+ [trans* T1 T2 T3]: (R a d)
R must be a symmetric and transitive relation.
-
+
Assuming that this proof object is a proof for (R s t), then
a proof checker must check if it is possible to prove (R s t)
- using the antecedents, symmetry and transitivity. That is,
+ using the antecedents, symmetry and transitivity. That is,
if there is a path from s to t, if we view every
antecedent (R a b) as an edge between a and b. *)
val is_Transitivity_star : Expr.expr -> bool
(** Indicates whether the term is a monotonicity proof object.
-
+
T1: (R t_1 s_1)
...
Tn: (R t_n s_n)
- [monotonicity T1 ... Tn]: (R (f t_1 ... t_n) (f s_1 ... s_n))
+ [monotonicity T1 ... Tn]: (R (f t_1 ... t_n) (f s_1 ... s_n))
Remark: if t_i == s_i, then the antecedent Ti is suppressed.
That is, reflexivity proofs are supressed to save space. *)
val is_monotonicity : Expr.expr -> bool
- (** Indicates whether the term is a quant-intro proof
-
+ (** Indicates whether the term is a quant-intro proof
+
Given a proof for (~ p q), produces a proof for (~ (forall (x) p) (forall (x) q)).
T1: (~ p q)
[quant-intro T1]: (~ (forall (x) p) (forall (x) q)) *)
val is_quant_intro : Expr.expr -> bool
- (** Indicates whether the term is a distributivity proof object.
-
+ (** Indicates whether the term is a distributivity proof object.
+
Given that f (= or) distributes over g (= and), produces a proof for
(= (f a (g c d))
(g (f a c) (f a d)))
@@ -2285,36 +2258,36 @@ sig
(= (f (g a b) (g c d))
(g (f a c) (f a d) (f b c) (f b d)))
where each f and g can have arbitrary number of arguments.
-
+
This proof object has no antecedents.
- Remark. This rule is used by the CNF conversion pass and
+ Remark. This rule is used by the CNF conversion pass and
instantiated by f = or, and g = and. *)
val is_distributivity : Expr.expr -> bool
(** Indicates whether the term is a proof by elimination of AND
-
+
Given a proof for (and l_1 ... l_n), produces a proof for l_i
T1: (and l_1 ... l_n)
[and-elim T1]: l_i *)
val is_and_elimination : Expr.expr -> bool
(** Indicates whether the term is a proof by eliminiation of not-or
-
+
Given a proof for (not (or l_1 ... l_n)), produces a proof for (not l_i).
T1: (not (or l_1 ... l_n))
[not-or-elim T1]: (not l_i) *)
val is_or_elimination : Expr.expr -> bool
(** Indicates whether the term is a proof by rewriting
-
+
A proof for a local rewriting step (= t s).
The head function symbol of t is interpreted.
-
+
This proof object has no antecedents.
- The conclusion of a rewrite rule is either an equality (= t s),
+ The conclusion of a rewrite rule is either an equality (= t s),
an equivalence (iff t s), or equi-satisfiability (~ t s).
Remark: if f is bool, then = is iff.
-
+
Examples:
(= (+ ( x : expr ) 0) x)
(= (+ ( x : expr ) 1 2) (+ 3 x))
@@ -2322,7 +2295,7 @@ sig
val is_rewrite : Expr.expr -> bool
(** Indicates whether the term is a proof by rewriting
-
+
A proof for rewriting an expression t into an expression s.
This proof object is used if the parameter PROOF_MODE is 1.
This proof object can have n antecedents.
@@ -2335,49 +2308,49 @@ sig
val is_rewrite_star : Expr.expr -> bool
(** Indicates whether the term is a proof for pulling quantifiers out.
-
+
A proof for (iff (f (forall (x) q(x)) r) (forall (x) (f (q x) r))). This proof object has no antecedents. *)
val is_pull_quant : Expr.expr -> bool
(** Indicates whether the term is a proof for pulling quantifiers out.
-
- A proof for (iff P Q) where Q is in prenex normal form.
- This proof object is only used if the parameter PROOF_MODE is 1.
+
+ A proof for (iff P Q) where Q is in prenex normal form.
+ This proof object is only used if the parameter PROOF_MODE is 1.
This proof object has no antecedents *)
val is_pull_quant_star : Expr.expr -> bool
(** Indicates whether the term is a proof for pushing quantifiers in.
-
+
A proof for:
(iff (forall (x_1 ... x_m) (and p_1[x_1 ... x_m] ... p_n[x_1 ... x_m]))
(and (forall (x_1 ... x_m) p_1[x_1 ... x_m])
- ...
- (forall (x_1 ... x_m) p_n[x_1 ... x_m])))
+ ...
+ (forall (x_1 ... x_m) p_n[x_1 ... x_m])))
This proof object has no antecedents *)
val is_push_quant : Expr.expr -> bool
(** Indicates whether the term is a proof for elimination of unused variables.
-
+
A proof for (iff (forall (x_1 ... x_n y_1 ... y_m) p[x_1 ... x_n])
- (forall (x_1 ... x_n) p[x_1 ... x_n]))
-
+ (forall (x_1 ... x_n) p[x_1 ... x_n]))
+
It is used to justify the elimination of unused variables.
This proof object has no antecedents. *)
val is_elim_unused_vars : Expr.expr -> bool
(** Indicates whether the term is a proof for destructive equality resolution
-
+
A proof for destructive equality resolution:
(iff (forall (x) (or (not (= ( x : expr ) t)) P[x])) P[t])
if ( x : expr ) does not occur in t.
-
+
This proof object has no antecedents.
-
+
Several variables can be eliminated simultaneously. *)
val is_der : Expr.expr -> bool
-
+
(** Indicates whether the term is a proof for quantifier instantiation
-
+
A proof of (or (not (forall (x) (P x))) (P a)) *)
val is_quant_inst : Expr.expr -> bool
@@ -2386,17 +2359,17 @@ sig
val is_hypothesis : Expr.expr -> bool
(** Indicates whether the term is a proof by lemma
-
+
T1: false
[lemma T1]: (or (not l_1) ... (not l_n))
-
+
This proof object has one antecedent: a hypothetical proof for false.
It converts the proof in a proof for (or (not l_1) ... (not l_n)),
when T1 contains the hypotheses: l_1, ..., l_n. *)
val is_lemma : Expr.expr -> bool
(** Indicates whether the term is a proof by unit resolution
-
+
T1: (or l_1 ... l_n l_1' ... l_m')
T2: (not l_1)
...
@@ -2405,31 +2378,31 @@ sig
val is_unit_resolution : Expr.expr -> bool
(** Indicates whether the term is a proof by iff-true
-
+
T1: p
[iff-true T1]: (iff p true) *)
val is_iff_true : Expr.expr -> bool
(** Indicates whether the term is a proof by iff-false
-
+
T1: (not p)
[iff-false T1]: (iff p false) *)
val is_iff_false : Expr.expr -> bool
(** Indicates whether the term is a proof by commutativity
-
+
[comm]: (= (f a b) (f b a))
-
+
f is a commutative operator.
-
+
This proof object has no antecedents.
Remark: if f is bool, then = is iff. *)
val is_commutativity : Expr.expr -> bool
(** Indicates whether the term is a proof for Tseitin-like axioms
-
+
Proof object used to justify Tseitin's like axioms:
-
+
(or (not (and p q)) p)
(or (not (and p q)) q)
(or (not (and p q r)) p)
@@ -2450,7 +2423,7 @@ sig
(or (ite a b c) a (not c))
(or (not (not a)) (not a))
(or (not a) a)
-
+
This proof object has no antecedents.
Note: all axioms are propositional tautologies.
Note also that 'and' and 'or' can take multiple arguments.
@@ -2460,56 +2433,56 @@ sig
val is_def_axiom : Expr.expr -> bool
(** Indicates whether the term is a proof for introduction of a name
-
+
Introduces a name for a formula/term.
Suppose e is an expression with free variables x, and def-intro
introduces the name n(x). The possible cases are:
-
+
When e is of Boolean type:
[def-intro]: (and (or n (not e)) (or (not n) e))
-
+
or:
[def-intro]: (or (not n) e)
when e only occurs positively.
-
+
When e is of the form (ite cond th el):
[def-intro]: (and (or (not cond) (= n th)) (or cond (= n el)))
-
+
Otherwise:
[def-intro]: (= n e) *)
val is_def_intro : Expr.expr -> bool
(** Indicates whether the term is a proof for application of a definition
-
+
[apply-def T1]: F ~ n
F is 'equivalent' to n, given that T1 is a proof that
n is a name for F. *)
val is_apply_def : Expr.expr -> bool
(** Indicates whether the term is a proof iff-oeq
-
+
T1: (iff p q)
[iff~ T1]: (~ p q) *)
val is_iff_oeq : Expr.expr -> bool
(** Indicates whether the term is a proof for a positive NNF step
-
+
Proof for a (positive) NNF step. Example:
-
+
T1: (not s_1) ~ r_1
T2: (not s_2) ~ r_2
T3: s_1 ~ r_1'
T4: s_2 ~ r_2'
[nnf-pos T1 T2 T3 T4]: (~ (iff s_1 s_2)
(and (or r_1 r_2') (or r_1' r_2)))
-
+
The negation normal form steps NNF_POS and NNF_NEG are used in the following cases:
(a) When creating the NNF of a positive force quantifier.
The quantifier is retained (unless the bound variables are eliminated).
Example
- T1: q ~ q_new
+ T1: q ~ q_new
[nnf-pos T1]: (~ (forall (x T) q) (forall (x T) q_new))
-
+
(b) When recursively creating NNF over Boolean formulas, where the top-level
connective is changed during NNF conversion. The relevant Boolean connectives
for NNF_POS are 'implies', 'iff', 'xor', 'ite'.
@@ -2518,9 +2491,9 @@ sig
val is_nnf_pos : Expr.expr -> bool
(** Indicates whether the term is a proof for a negative NNF step
-
+
Proof for a (negative) NNF step. Examples:
-
+
T1: (not s_1) ~ r_1
...
Tn: (not s_n) ~ r_n
@@ -2540,33 +2513,33 @@ sig
val is_nnf_neg : Expr.expr -> bool
(** Indicates whether the term is a proof for (~ P Q) here Q is in negation normal form.
-
+
A proof for (~ P Q) where Q is in negation normal form.
-
- This proof object is only used if the parameter PROOF_MODE is 1.
-
+
+ This proof object is only used if the parameter PROOF_MODE is 1.
+
This proof object may have n antecedents. Each antecedent is a PR_DEF_INTRO. *)
val is_nnf_star : Expr.expr -> bool
(** Indicates whether the term is a proof for (~ P Q) where Q is in conjunctive normal form.
-
+
A proof for (~ P Q) where Q is in conjunctive normal form.
- This proof object is only used if the parameter PROOF_MODE is 1.
+ This proof object is only used if the parameter PROOF_MODE is 1.
This proof object may have n antecedents. Each antecedent is a PR_DEF_INTRO. *)
val is_cnf_star : Expr.expr -> bool
(** Indicates whether the term is a proof for a Skolemization step
-
- Proof for:
-
+
+ Proof for:
+
[sk]: (~ (not (forall ( x : expr ) (p ( x : expr ) y))) (not (p (sk y) y)))
[sk]: (~ (exists ( x : expr ) (p ( x : expr ) y)) (p (sk y) y))
-
+
This proof object has no antecedents. *)
val is_skolemize : Expr.expr -> bool
(** Indicates whether the term is a proof by modus ponens for equi-satisfiability.
-
+
Modus ponens style rule for equi-satisfiability.
T1: p
T2: (~ p q)
@@ -2574,32 +2547,32 @@ sig
val is_modus_ponens_oeq : Expr.expr -> bool
(** Indicates whether the term is a proof for theory lemma
-
+
Generic proof for theory lemmas.
-
+
The theory lemma function comes with one or more parameters.
The first parameter indicates the name of the theory.
For the theory of arithmetic, additional parameters provide hints for
- checking the theory lemma.
+ checking the theory lemma.
The hints for arithmetic are:
- farkas - followed by rational coefficients. Multiply the coefficients to the
inequalities in the lemma, add the (negated) inequalities and obtain a contradiction.
- - triangle-eq - Indicates a lemma related to the equivalence:
+ - triangle-eq - Indicates a lemma related to the equivalence:
(iff (= t1 t2) (and (<= t1 t2) (<= t2 t1)))
- gcd-test - Indicates an integer linear arithmetic lemma that uses a gcd test. *)
val is_theory_lemma : Expr.expr -> bool
end
-(** Goals
+(** Goals
- A goal (aka problem). A goal is essentially a
+ A goal (aka problem). A goal is essentially a
of formulas, that can be solved and/or transformed using
tactics and solvers. *)
module Goal :
sig
- type goal
+ type goal
- (** The precision of the goal.
+ (** The precision of the goal.
Goals can be transformed using over and under approximations.
An under approximation is applied when the objective is to find a model for a given goal.
@@ -2620,11 +2593,11 @@ sig
(** Adds the constraints to the given goal. *)
val add : goal -> Expr.expr list -> unit
-
+
(** Indicates whether the goal contains `false'. *)
val is_inconsistent : goal -> bool
-
- (** The depth of the goal.
+
+ (** The depth of the goal.
This tracks how many transformations were applied to it. *)
val get_depth : goal -> int
@@ -2653,8 +2626,8 @@ sig
val simplify : goal -> Params.params option -> goal
(** Creates a new Goal.
-
- Note that the Context must have been created with proof generation support if
+
+ Note that the Context must have been created with proof generation support if
the fourth argument is set to true here. *)
val mk_goal : context -> bool -> bool -> bool -> goal
@@ -2670,25 +2643,25 @@ end
A Model contains interpretations (assignments) of constants and functions. *)
module Model :
sig
- type model
+ type model
- (** Function interpretations
+ (** Function interpretations
A function interpretation is represented as a finite map and an 'else'.
- Each entry in the finite map represents the value of a function given a set of arguments. *)
+ Each entry in the finite map represents the value of a function given a set of arguments. *)
module FuncInterp :
sig
- type func_interp
-
- (** Function interpretations entries
+ type func_interp
- An Entry object represents an element in the finite map used to a function interpretation. *)
+ (** Function interpretations entries
+
+ An Entry object represents an element in the finite map used to a function interpretation. *)
module FuncEntry :
sig
- type func_entry
+ type func_entry
(** Return the (symbolic) value of this entry.
- *)
+ *)
val get_value : func_entry -> Expr.expr
(** The number of arguments of the entry.
@@ -2716,26 +2689,26 @@ sig
(** The arity of the function interpretation *)
val get_arity : func_interp -> int
- (** A string representation of the function interpretation. *)
+ (** A string representation of the function interpretation. *)
val to_string : func_interp -> string
end
- (** Retrieves the interpretation (the assignment) of a func_decl in the model.
+ (** Retrieves the interpretation (the assignment) of a func_decl in the model.
@return An expression if the function has an interpretation in the model, null otherwise. *)
val get_const_interp : model -> FuncDecl.func_decl -> Expr.expr option
- (** Retrieves the interpretation (the assignment) of an expression in the model.
+ (** Retrieves the interpretation (the assignment) of an expression in the model.
@return An expression if the constant has an interpretation in the model, null otherwise. *)
val get_const_interp_e : model -> Expr.expr -> Expr.expr option
- (** Retrieves the interpretation (the assignment) of a non-constant func_decl in the model.
+ (** Retrieves the interpretation (the assignment) of a non-constant func_decl in the model.
@return A FunctionInterpretation if the function has an interpretation in the model, null otherwise. *)
val get_func_interp : model -> FuncDecl.func_decl -> FuncInterp.func_interp option
(** The number of constant interpretations in the model. *)
val get_num_consts : model -> int
- (** The function declarations of the constants in the model. *)
+ (** The function declarations of the constants in the model. *)
val get_const_decls : model -> FuncDecl.func_decl list
(** The number of function interpretations in the model. *)
@@ -2748,8 +2721,8 @@ sig
val get_decls : model -> FuncDecl.func_decl list
(** Evaluates an expression in the current model.
-
- This function may fail if the argument contains quantifiers,
+
+ This function may fail if the argument contains quantifiers,
is partial (MODEL_PARTIAL enabled), or if it is not well-sorted.
In this case a [ModelEvaluationFailedException] is thrown.
*)
@@ -2761,8 +2734,8 @@ sig
(** The number of uninterpreted sorts that the model has an interpretation for. *)
val get_num_sorts : model -> int
- (** The uninterpreted sorts that the model has an interpretation for.
-
+ (** The uninterpreted sorts that the model has an interpretation for.
+
Z3 also provides an intepretation for uninterpreted sorts used in a formula.
The interpretation for a sort is a finite set of distinct values. We say this finite set is
the "universe" of the sort.
@@ -2770,17 +2743,17 @@ sig
{!sort_universe} *)
val get_sorts : model -> Sort.sort list
- (** The finite set of distinct values that represent the interpretation of a sort.
+ (** The finite set of distinct values that represent the interpretation of a sort.
{!get_sorts}
@return A list of expressions, where each is an element of the universe of the sort *)
val sort_universe : model -> Sort.sort -> Expr.expr list
-
- (** Conversion of models to strings.
+
+ (** Conversion of models to strings.
@return A string representation of the model. *)
val to_string : model -> string
end
-(** Probes
+(** Probes
Probes are used to inspect a goal (aka problem) and collect information that may be used to decide
which solver and/or preprocessing step will be used.
@@ -2790,9 +2763,9 @@ end
*)
module Probe :
sig
- type probe
+ type probe
- (** Execute the probe over the goal.
+ (** Execute the probe over the goal.
@return A probe always produce a float value.
"Boolean" probes return 0.0 for false, and a value different from 0.0 for true. *)
val apply : probe -> Goal.goal -> float
@@ -2806,7 +2779,7 @@ sig
(** Returns a string containing a description of the probe with the given name. *)
val get_probe_description : context -> string -> string
- (** Creates a new Probe. *)
+ (** Creates a new Probe. *)
val mk_probe : context -> string -> probe
(** Create a probe that always evaluates to a float value. *)
@@ -2846,21 +2819,21 @@ end
(** Tactics
Tactics are the basic building block for creating custom solvers for specific problem domains.
- The complete list of tactics may be obtained using [Context.get_num_tactics]
+ The complete list of tactics may be obtained using [Context.get_num_tactics]
and [Context.get_tactic_names].
It may also be obtained using the command [(help-tactic)] in the SMT 2.0 front-end.
*)
module Tactic :
sig
- type tactic
+ type tactic
- (** Tactic application results
-
- ApplyResult objects represent the result of an application of a
+ (** Tactic application results
+
+ ApplyResult objects represent the result of an application of a
tactic to a goal. It contains the subgoals that were produced. *)
module ApplyResult :
sig
- type apply_result
+ type apply_result
(** The number of Subgoals. *)
val get_num_subgoals : apply_result -> int
@@ -2871,8 +2844,8 @@ sig
(** Retrieves a subgoal from the apply_result. *)
val get_subgoal : apply_result -> int -> Goal.goal
- (** Convert a model for a subgoal into a model for the original
- goal [g], that the ApplyResult was obtained from.
+ (** Convert a model for a subgoal into a model for the original
+ goal [g], that the ApplyResult was obtained from.
#return A model for [g] *)
val convert_model : apply_result -> int -> Model.model -> Model.model
@@ -2898,7 +2871,7 @@ sig
(** Returns a string containing a description of the tactic with the given name. *)
val get_tactic_description : context -> string -> string
- (** Creates a new Tactic. *)
+ (** Creates a new Tactic. *)
val mk_tactic : context -> string -> tactic
(** Create a tactic that applies one tactic to a Goal and
@@ -2909,22 +2882,22 @@ sig
if it fails then returns the result of another tactic applied to the Goal. *)
val or_else : context -> tactic -> tactic -> tactic
- (** Create a tactic that applies one tactic to a goal for some time (in milliseconds).
-
+ (** Create a tactic that applies one tactic to a goal for some time (in milliseconds).
+
If the tactic does not terminate within the timeout, then it fails. *)
val try_for : context -> tactic -> int -> tactic
- (** Create a tactic that applies one tactic to a given goal if the probe
- evaluates to true.
-
+ (** Create a tactic that applies one tactic to a given goal if the probe
+ evaluates to true.
+
If the probe evaluates to false, then the new tactic behaves like the [skip] tactic. *)
val when_ : context -> Probe.probe -> tactic -> tactic
- (** Create a tactic that applies a tactic to a given goal if the probe
+ (** Create a tactic that applies a tactic to a given goal if the probe
evaluates to true and another tactic otherwise. *)
val cond : context -> Probe.probe -> tactic -> tactic -> tactic
- (** Create a tactic that keeps applying one tactic until the goal is not
+ (** Create a tactic that keeps applying one tactic until the goal is not
modified anymore or the maximum number of iterations is reached. *)
val repeat : context -> tactic -> int -> tactic
@@ -2955,7 +2928,7 @@ sig
to every subgoal produced by the first one. The subgoals are processed in parallel. *)
val par_and_then : context -> tactic -> tactic -> tactic
- (** Interrupt the execution of a Z3 procedure.
+ (** Interrupt the execution of a Z3 procedure.
This procedure can be used to interrupt: solvers, simplifiers and tactics. *)
val interrupt : context -> unit
end
@@ -2963,37 +2936,37 @@ end
(** Objects that track statistical information. *)
module Statistics :
sig
- type statistics
-
+ type statistics
+
(** Statistical data is organized into pairs of \[Key, Entry\], where every
Entry is either a floating point or integer value. *)
module Entry :
sig
type statistics_entry
-
+
(** The key of the entry. *)
val get_key : statistics_entry -> string
-
+
(** The int-value of the entry. *)
val get_int : statistics_entry -> int
-
+
(** The float-value of the entry. *)
val get_float : statistics_entry -> float
-
+
(** True if the entry is uint-valued. *)
val is_int : statistics_entry -> bool
-
+
(** True if the entry is float-valued. *)
val is_float : statistics_entry -> bool
-
+
(** The string representation of the the entry's value. *)
val to_string_value : statistics_entry -> string
-
+
(** The string representation of the entry (key and value) *)
val to_string : statistics_entry -> string
end
- (** A string representation of the statistical data. *)
+ (** A string representation of the statistical data. *)
val to_string : statistics -> string
(** The number of statistical data. *)
@@ -3005,16 +2978,16 @@ sig
(** The statistical counters. *)
val get_keys : statistics -> string list
- (** The value of a particular statistical counter. *)
+ (** The value of a particular statistical counter. *)
val get : statistics -> string -> Entry.statistics_entry option
end
(** Solvers *)
module Solver :
sig
- type solver
+ type solver
type status = UNSATISFIABLE | UNKNOWN | SATISFIABLE
-
+
val string_of_status : status -> string
(** A string that describes all available solver parameters. *)
@@ -3044,7 +3017,7 @@ sig
This removes all assertions from the solver. *)
val reset : solver -> unit
- (** Assert a constraint (or multiple) into the solver. *)
+ (** Assert a constraint (or multiple) into the solver. *)
val add : solver -> Expr.expr list -> unit
(** * Assert multiple constraints (cs) into the solver, and track them (in the
@@ -3062,7 +3035,7 @@ sig
(** * Assert a constraint (c) into the solver, and track it (in the unsat) core
* using the Boolean constant p.
- *
+ *
* This API is an alternative to {!check} with assumptions for
* extracting unsat cores.
* Both APIs can be used in the same solver. The unsat core will contain a
@@ -3079,26 +3052,26 @@ sig
val get_assertions : solver -> Expr.expr list
(** Checks whether the assertions in the solver are consistent or not.
-
+
{!Model}
{!get_unsat_core}
{!Proof} *)
val check : solver -> Expr.expr list -> status
(** The model of the last [Check].
-
+
The result is [None] if [Check] was not invoked before,
if its results was not [SATISFIABLE], or if model production is not enabled. *)
val get_model : solver -> Model.model option
(** The proof of the last [Check].
-
+
The result is [null] if [Check] was not invoked before,
if its results was not [UNSATISFIABLE], or if proof production is disabled. *)
val get_proof : solver -> Expr.expr option
(** The unsat core of the last [Check].
-
+
The unsat core is a subset of [Assertions]
The result is empty if [Check] was not invoked before,
if its results was not [UNSATISFIABLE], or if core production is disabled. *)
@@ -3110,26 +3083,26 @@ sig
(** Solver statistics. *)
val get_statistics : solver -> Statistics.statistics
- (** Creates a new (incremental) solver.
-
- This solver also uses a set of builtin tactics for handling the first
- check-sat command, and check-sat commands that take more than a given
- number of milliseconds to be solved. *)
+ (** Creates a new (incremental) solver.
+
+ This solver also uses a set of builtin tactics for handling the first
+ check-sat command, and check-sat commands that take more than a given
+ number of milliseconds to be solved. *)
val mk_solver : context -> Symbol.symbol option -> solver
(** Creates a new (incremental) solver.
- {!mk_solver} *)
+ {!mk_solver} *)
val mk_solver_s : context -> string -> solver
(** Creates a new (incremental) solver. *)
val mk_simple_solver : context -> solver
(** Creates a solver that is implemented using the given tactic.
-
+
The solver supports the commands [Push] and [Pop], but it
will always solve each check from scratch. *)
val mk_solver_t : context -> Tactic.tactic -> solver
-
+
(** Create a clone of the current solver with respect to a context. *)
val translate : solver -> context -> solver
@@ -3140,8 +3113,8 @@ end
(** Fixedpoint solving *)
module Fixedpoint :
sig
- type fixedpoint
-
+ type fixedpoint
+
(** A string that describes all available fixedpoint solver parameters. *)
val get_help : fixedpoint -> string
@@ -3151,28 +3124,28 @@ sig
(** Retrieves parameter descriptions for Fixedpoint solver. *)
val get_param_descrs : fixedpoint -> Params.ParamDescrs.param_descrs
- (** Assert a constraints into the fixedpoint solver. *)
+ (** Assert a constraints into the fixedpoint solver. *)
val add : fixedpoint -> Expr.expr list -> unit
- (** Register predicate as recursive relation. *)
+ (** Register predicate as recursive relation. *)
val register_relation : fixedpoint -> FuncDecl.func_decl -> unit
- (** Add rule into the fixedpoint solver. *)
+ (** Add rule into the fixedpoint solver. *)
val add_rule : fixedpoint -> Expr.expr -> Symbol.symbol option -> unit
- (** Add table fact to the fixedpoint solver. *)
+ (** Add table fact to the fixedpoint solver. *)
val add_fact : fixedpoint -> FuncDecl.func_decl -> int list -> unit
(** Query the fixedpoint solver.
A query is a conjunction of constraints. The constraints may include the recursively defined relations.
The query is satisfiable if there is an instance of the query variables and a derivation for it.
- The query is unsatisfiable if there are no derivations satisfying the query variables. *)
+ The query is unsatisfiable if there are no derivations satisfying the query variables. *)
val query : fixedpoint -> Expr.expr -> Solver.status
(** Query the fixedpoint solver.
A query is an array of relations.
The query is satisfiable if there is an instance of some relation that is non-empty.
- The query is unsatisfiable if there are no derivations satisfying any of the relations. *)
+ The query is unsatisfiable if there are no derivations satisfying any of the relations. *)
val query_r : fixedpoint -> FuncDecl.func_decl list -> Solver.status
(** Creates a backtracking point.
@@ -3185,39 +3158,39 @@ sig
{!push} *)
val pop : fixedpoint -> unit
- (** Update named rule into in the fixedpoint solver. *)
+ (** Update named rule into in the fixedpoint solver. *)
val update_rule : fixedpoint -> Expr.expr -> Symbol.symbol -> unit
- (** Retrieve satisfying instance or instances of solver,
- or definitions for the recursive predicates that show unsatisfiability. *)
+ (** Retrieve satisfying instance or instances of solver,
+ or definitions for the recursive predicates that show unsatisfiability. *)
val get_answer : fixedpoint -> Expr.expr option
- (** Retrieve explanation why fixedpoint engine returned status Unknown. *)
+ (** Retrieve explanation why fixedpoint engine returned status Unknown. *)
val get_reason_unknown : fixedpoint -> string
- (** Retrieve the number of levels explored for a given predicate. *)
+ (** Retrieve the number of levels explored for a given predicate. *)
val get_num_levels : fixedpoint -> FuncDecl.func_decl -> int
- (** Retrieve the cover of a predicate. *)
+ (** Retrieve the cover of a predicate. *)
val get_cover_delta : fixedpoint -> int -> FuncDecl.func_decl -> Expr.expr option
(** Add <tt>property</tt> about the <tt>predicate</tt>.
- The property is added at <tt>level</tt>. *)
+ The property is added at <tt>level</tt>. *)
val add_cover : fixedpoint -> int -> FuncDecl.func_decl -> Expr.expr -> unit
(** Retrieve internal string representation of fixedpoint object. *)
val to_string : fixedpoint -> string
- (** Instrument the Datalog engine on which table representation to use for recursive predicate. *)
+ (** Instrument the Datalog engine on which table representation to use for recursive predicate. *)
val set_predicate_representation : fixedpoint -> FuncDecl.func_decl -> Symbol.symbol list -> unit
- (** Convert benchmark given as set of axioms, rules and queries to a string. *)
+ (** Convert benchmark given as set of axioms, rules and queries to a string. *)
val to_string_q : fixedpoint -> Expr.expr list -> string
- (** Retrieve set of rules added to fixedpoint context. *)
+ (** Retrieve set of rules added to fixedpoint context. *)
val get_rules : fixedpoint -> Expr.expr list
- (** Retrieve set of assertions added to fixedpoint context. *)
+ (** Retrieve set of assertions added to fixedpoint context. *)
val get_assertions : fixedpoint -> Expr.expr list
(** Create a Fixedpoint context. *)
@@ -3226,98 +3199,83 @@ sig
(** Retrieve statistics information from the last call to #Z3_fixedpoint_query. *)
val get_statistics : fixedpoint -> Statistics.statistics
- (** Parse an SMT-LIB2 string with fixedpoint rules.
- Add the rules to the current fixedpoint context.
+ (** Parse an SMT-LIB2 string with fixedpoint rules.
+ Add the rules to the current fixedpoint context.
Return the set of queries in the string. *)
val parse_string : fixedpoint -> string -> Expr.expr list
- (** Parse an SMT-LIB2 file with fixedpoint rules.
- Add the rules to the current fixedpoint context.
+ (** Parse an SMT-LIB2 file with fixedpoint rules.
+ Add the rules to the current fixedpoint context.
Return the set of queries in the file. *)
val parse_file : fixedpoint -> string -> Expr.expr list
end
-(** Optimization *)
-module Optimize :
-sig
- type optimize
- type handle
-
-
- (** Create a Optimize context. *)
- val mk_opt : context -> optimize
-
- (** A string that describes all available optimize solver parameters. *)
- val get_help : optimize -> string
-
-
- (** Sets the optimize solver parameters. *)
- val set_parameters : optimize -> Params.params -> unit
-
-
- (** Retrieves parameter descriptions for Optimize solver. *)
- val get_param_descrs : optimize -> Params.ParamDescrs.param_descrs
-
-
- (** Assert a constraints into the optimize solver. *)
- val add : optimize -> Expr.expr list -> unit
-
-
- (** Asssert a soft constraint.
- Supply integer weight and string that identifies a group
- of soft constraints.
- *)
- val add_soft : optimize -> Expr.expr -> string -> Symbol.symbol -> handle
-
-
- (** Add maximization objective.
- *)
- val maximize : optimize -> Expr.expr -> handle
-
-
- (** Add minimization objective.
- *)
- val minimize : optimize -> Expr.expr -> handle
-
- (** Checks whether the assertions in the context are satisfiable and solves objectives.
- *)
- val check : optimize -> Solver.status
-
-
- (** Retrieve model from satisfiable context *)
+(** Optimization *)
+module Optimize :
+sig
+ type optimize
+ type handle
+
+ (** Create a Optimize context. *)
+ val mk_opt : context -> optimize
+
+ (** A string that describes all available optimize solver parameters. *)
+ val get_help : optimize -> string
+
+ (** Sets the optimize solver parameters. *)
+ val set_parameters : optimize -> Params.params -> unit
+
+ (** Retrieves parameter descriptions for Optimize solver. *)
+ val get_param_descrs : optimize -> Params.ParamDescrs.param_descrs
+
+ (** Assert a constraints into the optimize solver. *)
+ val add : optimize -> Expr.expr list -> unit
+
+ (** Asssert a soft constraint.
+ Supply integer weight and string that identifies a group
+ of soft constraints.
+ *)
+ val add_soft : optimize -> Expr.expr -> string -> Symbol.symbol -> handle
+
+ (** Add maximization objective.
+ *)
+ val maximize : optimize -> Expr.expr -> handle
+
+ (** Add minimization objective.
+ *)
+ val minimize : optimize -> Expr.expr -> handle
+
+ (** Checks whether the assertions in the context are satisfiable and solves objectives.
+ *)
+ val check : optimize -> Solver.status
+
+ (** Retrieve model from satisfiable context *)
val get_model : optimize -> Model.model option
-
-
- (** Retrieve lower bound in current model for handle *)
- val get_lower : handle -> int -> Expr.expr
-
-
- (** Retrieve upper bound in current model for handle *)
- val get_upper : handle -> int -> Expr.expr
-
- (** Creates a backtracking point.
- {!pop} *)
- val push : optimize -> unit
+ (** Retrieve lower bound in current model for handle *)
+ val get_lower : handle -> int -> Expr.expr
+ (** Retrieve upper bound in current model for handle *)
+ val get_upper : handle -> int -> Expr.expr
- (** Backtrack one backtracking point.
- Note that an exception is thrown if Pop is called without a corresponding [Push]
- {!push} *)
- val pop : optimize -> unit
+ (** Creates a backtracking point.
+ {!pop} *)
+ val push : optimize -> unit
-
- (** Retrieve explanation why optimize engine returned status Unknown. *)
- val get_reason_unknown : optimize -> string
+ (** Backtrack one backtracking point.
+ Note that an exception is thrown if Pop is called without a corresponding [Push]
+ {!push} *)
+ val pop : optimize -> unit
-
- (** Retrieve SMT-LIB string representation of optimize object. *)
- val to_string : optimize -> string
-
-
- (** Retrieve statistics information from the last call to check *)
- val get_statistics : optimize -> Statistics.statistics
-end
+ (** Retrieve explanation why optimize engine returned status Unknown. *)
+ val get_reason_unknown : optimize -> string
+
+ (** Retrieve SMT-LIB string representation of optimize object. *)
+ val to_string : optimize -> string
+
+ (** Retrieve statistics information from the last call to check *)
+ val get_statistics : optimize -> Statistics.statistics
+end
(** Functions for handling SMT and SMT2 expressions and files *)
@@ -3328,16 +3286,16 @@ sig
@return A string representation of the benchmark. *)
val benchmark_to_smtstring : context -> string -> string -> string -> string -> Expr.expr list -> Expr.expr -> string
- (** Parse the given string using the SMT-LIB parser.
-
- The symbol table of the parser can be initialized using the given sorts and declarations.
- The symbols in the arrays in the third and fifth argument
- don't need to match the names of the sorts and declarations in the arrays in the fourth
- and sixth argument. This is a useful feature since we can use arbitrary names to
+ (** Parse the given string using the SMT-LIB parser.
+
+ The symbol table of the parser can be initialized using the given sorts and declarations.
+ The symbols in the arrays in the third and fifth argument
+ don't need to match the names of the sorts and declarations in the arrays in the fourth
+ and sixth argument. This is a useful feature since we can use arbitrary names to
reference sorts and declarations. *)
val parse_smtlib_string : context -> string -> Symbol.symbol list -> Sort.sort list -> Symbol.symbol list -> FuncDecl.func_decl list -> unit
- (** Parse the given file using the SMT-LIB parser.
+ (** Parse the given file using the SMT-LIB parser.
{!parse_smtlib_string} *)
val parse_smtlib_file : context -> string -> Symbol.symbol list -> Sort.sort list -> Symbol.symbol list -> FuncDecl.func_decl list -> unit
@@ -3365,13 +3323,13 @@ sig
(** The sort declarations parsed by the last call to [ParseSMTLIBString] or [ParseSMTLIBFile]. *)
val get_smtlib_sorts : context -> Sort.sort list
- (** Parse the given string using the SMT-LIB2 parser.
+ (** Parse the given string using the SMT-LIB2 parser.
{!parse_smtlib_string}
@return A conjunction of assertions in the scope (up to push/pop) at the end of the string. *)
val parse_smtlib2_string : context -> string -> Symbol.symbol list -> Sort.sort list -> Symbol.symbol list -> FuncDecl.func_decl list -> Expr.expr
- (** Parse the given file using the SMT-LIB2 parser.
+ (** Parse the given file using the SMT-LIB2 parser.
{!parse_smtlib2_string} *)
val parse_smtlib2_file : context -> string -> Symbol.symbol list -> Sort.sort list -> Symbol.symbol list -> FuncDecl.func_decl list -> Expr.expr
end
@@ -3383,7 +3341,7 @@ sig
(** Create an AST node marking a formula position for interpolation.
The expression must have Boolean sort. *)
val mk_interpolant : context -> Expr.expr -> Expr.expr
-
+
(** The interpolation context is suitable for generation of interpolants.
For more information on interpolation please refer
too the C/C++ API, which is well documented. *)
@@ -3403,12 +3361,12 @@ sig
For more information on interpolation please refer
too the C/C++ API, which is well documented. *)
val get_interpolation_profile : context -> string
-
+
(** Read an interpolation problem from file.
For more information on interpolation please refer
too the C/C++ API, which is well documented. *)
val read_interpolation_problem : context -> string -> (Expr.expr list * int list * Expr.expr list)
-
+
(** Check the correctness of an interpolant.
For more information on interpolation please refer
too the C/C++ API, which is well documented. *)
@@ -3423,10 +3381,10 @@ sig
end
(** Set a global (or module) parameter, which is shared by all Z3 contexts.
-
+
When a Z3 module is initialized it will use the value of these parameters
when Z3_params objects are not provided.
- The name of parameter can be composed of characters [a-z][A-Z], digits [0-9], '-' and '_'.
+ The name of parameter can be composed of characters [a-z][A-Z], digits [0-9], '-' and '_'.
The character '.' is a delimiter (more later).
The parameter names are case-insensitive. The character '-' should be viewed as an "alias" for '_'.
Thus, the following parameter names are considered equivalent: "pp.decimal-precision" and "PP.DECIMAL_PRECISION".
@@ -3439,7 +3397,7 @@ end
val set_global_param : string -> string -> unit
(** Get a global (or module) parameter.
-
+
Returns None if the parameter does not exist.
The caller must invoke #Z3_global_param_del_value to delete the value returned at param_value.
This function cannot be invoked simultaneously from different threads without synchronization.
@@ -3448,32 +3406,29 @@ val set_global_param : string -> string -> unit
val get_global_param : string -> string option
(** Restore the value of all global (and module) parameters.
-
+
This command will not affect already created objects (such as tactics and solvers)
{!set_global_param}
*)
val global_param_reset_all : unit -> unit
-
+
(** Enable/disable printing of warning messages to the console.
-
- Note that this function is static and effects the behaviour of
+
+ Note that this function is static and effects the behaviour of
all contexts globally. *)
val toggle_warning_messages : bool -> unit
(**
Enable tracing messages tagged as `tag' when Z3 is compiled in debug mode.
-
- Remarks: It is a NOOP otherwise.
+
+ Remarks: It is a NOOP otherwise.
*)
val enable_trace : string -> unit
(**
- Disable tracing messages tagged as `tag' when Z3 is compiled in debug mode.
+ Disable tracing messages tagged as `tag' when Z3 is compiled in debug mode.
Remarks: It is a NOOP otherwise.
*)
val disable_trace : string -> unit
-
-
-
diff --git a/src/api/ml/z3native.ml.pre b/src/api/ml/z3native.ml.pre
new file mode 100644
index 000000000..87a069df9
--- /dev/null
+++ b/src/api/ml/z3native.ml.pre
@@ -0,0 +1,36 @@
+(** The native (raw) interface to the dynamic Z3 library. *)
+
+open Z3enums
+
+(**/**)
+type ptr
+and symbol = ptr
+and config = ptr
+and context = ptr
+and ast = ptr
+and app = ast
+and sort = ast
+and func_decl = ast
+and pattern = ast
+and model = ptr
+and literals = ptr
+and constructor = ptr
+and constructor_list = ptr
+and solver = ptr
+and goal = ptr
+and tactic = ptr
+and params = ptr
+and probe = ptr
+and stats = ptr
+and ast_vector = ptr
+and ast_map = ptr
+and apply_result = ptr
+and func_interp = ptr
+and func_entry = ptr
+and fixedpoint = ptr
+and optimize = ptr
+and param_descrs = ptr
+and rcf_num = ptr
+
+external set_internal_error_handler : ptr -> unit
+ = "n_set_internal_error_handler"
diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre
new file mode 100644
index 000000000..d6b2cdab4
--- /dev/null
+++ b/src/api/ml/z3native_stubs.c.pre
@@ -0,0 +1,445 @@
+#include <stddef.h>
+#include <string.h>
+#include <assert.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+
+#ifdef Custom_tag
+#include <caml/custom.h>
+#include <caml/bigarray.h>
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#include <z3.h>
+#include <z3native_stubs.h>
+
+#define CAMLlocal6(X1,X2,X3,X4,X5,X6) \
+ CAMLlocal5(X1,X2,X3,X4,X5); \
+ CAMLlocal1(X6)
+#define CAMLlocal7(X1,X2,X3,X4,X5,X6,X7) \
+ CAMLlocal5(X1,X2,X3,X4,X5); \
+ CAMLlocal2(X6,X7)
+#define CAMLlocal8(X1,X2,X3,X4,X5,X6,X7,X8) \
+ CAMLlocal5(X1,X2,X3,X4,X5); \
+ CAMLlocal3(X6,X7,X8)
+
+#define CAMLparam7(X1,X2,X3,X4,X5,X6,X7) \
+ CAMLparam5(X1,X2,X3,X4,X5); \
+ CAMLxparam2(X6,X7)
+#define CAMLparam8(X1,X2,X3,X4,X5,X6,X7,X8) \
+ CAMLparam5(X1,X2,X3,X4,X5); \
+ CAMLxparam3(X6,X7,X8)
+#define CAMLparam9(X1,X2,X3,X4,X5,X6,X7,X8,X9) \
+ CAMLparam5(X1,X2,X3,X4,X5); \
+ CAMLxparam4(X6,X7,X8,X9)
+#define CAMLparam12(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12) \
+ CAMLparam5(X1,X2,X3,X4,X5); \
+ CAMLxparam5(X6,X7,X8,X9,X10); \
+ CAMLxparam2(X11,X12)
+#define CAMLparam13(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13) \
+ CAMLparam5(X1,X2,X3,X4,X5); \
+ CAMLxparam5(X6,X7,X8,X9,X10); \
+ CAMLxparam3(X11,X12,X13)
+
+
+static struct custom_operations default_custom_ops = {
+ (char*) "default handling",
+ custom_finalize_default,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default,
+ custom_compare_ext_default,
+};
+
+int compare_pointers(void* pt1, void* pt2) {
+ if (pt1 == pt2)
+ return 0;
+ else if ((intnat)pt1 < (intnat)pt2)
+ return -1;
+ else
+ return +1;
+}
+
+#define MK_CTX_OF(X) \
+ CAMLprim DLL_PUBLIC value n_context_of_ ## X(value v) { \
+ CAMLparam1(v); \
+ CAMLlocal1(result); \
+ Z3_context_plus cp; \
+ 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, 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); \
+ }
+
+
+/* Context objects */
+
+/* The Z3context_plus_data exists exactly once for each context,
+ no matter how many custom blocks for that context exist.
+ Each custom block only stores a pointer to the corresponding
+ Z3_context_plus_data. This ensures that the reference counting
+ is performed at exactly one place and not within the custom
+ blocks that get copied. */
+typedef struct {
+ Z3_context ctx;
+ unsigned long obj_count;
+} Z3_context_plus_data;
+
+/* A context is wrapped to an OCaml value by storing a pointer
+ to its associated Z3_context_plus_data instance.
+ This instance gets created in mk_context and is deleted
+ together with the Z3 context instance in try_to_delete_context
+ whenever the obj_count field is zero. */
+typedef Z3_context_plus_data* Z3_context_plus;
+
+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.
+ 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;
+}
+
+Z3_context Z3_context_plus_raw(Z3_context_plus * cp) {
+ return (*cp)->ctx;
+}
+
+void try_to_delete_context(Z3_context_plus cp) {
+ 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);
+ 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) {
+ Z3_context_plus cp = *(Z3_context_plus*)Data_custom_val(v);
+ cp->obj_count--;
+ try_to_delete_context(cp);
+}
+
+int Z3_context_compare(value v1, value v2) {
+ /* As each context created within the OCaml bindings has a unique
+ Z3_context_plus_data allocated to store the handle and the ref counters,
+ we can just compare pointers here. This suffices to test for (in)equality
+ and induces an arbitrary (but fixed) ordering. */
+ Z3_context_plus cp1 = *(Z3_context_plus*)Data_custom_val(v1);
+ Z3_context_plus cp2 = *(Z3_context_plus*)Data_custom_val(v2);
+ return compare_pointers(cp1, cp2);
+}
+
+int Z3_context_compare_ext(value v1, value v2) {
+ Z3_context_plus cp = *(Z3_context_plus*)Data_custom_val(v1);
+ return compare_pointers(cp, (void*)Val_int(v2));
+}
+
+/* We use the pointer to the Z3_context_plus_data structure as
+ a hash value; it is unique, at least. */
+intnat Z3_context_hash(value v) {
+ /* We use the address of the context's Z3_context_plus_data structure
+ as a hash value */
+ Z3_context_plus cp = *(Z3_context_plus*)Data_custom_val(v);
+ return (intnat)cp;
+}
+
+static struct custom_operations Z3_context_plus_custom_ops = {
+ (char*) "Z3_context ops",
+ Z3_context_finalize,
+ Z3_context_compare,
+ Z3_context_hash,
+ custom_serialize_default,
+ custom_deserialize_default,
+ Z3_context_compare_ext
+};
+
+
+/* AST objects */
+
+typedef struct {
+ Z3_context_plus cp;
+ Z3_ast p;
+} Z3_ast_plus;
+
+Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus cp, Z3_ast p) {
+ Z3_ast_plus r;
+ r.cp = cp;
+ r.p = p;
+ /* printf("++\n"); */
+ cp->obj_count++;
+ if (p != NULL)
+ Z3_inc_ref(cp->ctx, p);
+ return r;
+}
+
+Z3_ast Z3_ast_plus_raw(Z3_ast_plus * ap) {
+ return ap->p;
+}
+
+void Z3_ast_finalize(value v) {
+ /* printf("--\n"); */
+ Z3_ast_plus * ap = (Z3_ast_plus*)(Data_custom_val(v));
+ if (ap->p != NULL)
+ Z3_dec_ref(ap->cp->ctx, ap->p);
+ ap->cp->obj_count--;
+ try_to_delete_context(ap->cp);
+}
+
+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);
+
+ /* if the two ASTs belong to different contexts, we take
+ their contexts' addresses to order them (arbitrarily, but fixed) */
+ if (a1->cp->ctx != a2->cp->ctx)
+ return compare_pointers(a1->cp->ctx, a2->cp->ctx);
+
+ /* handling of NULL pointers */
+ if (a1->p == NULL && a2->p == NULL)
+ return 0;
+ if (a1->p == NULL)
+ return -1;
+ if (a2->p == NULL)
+ return +1;
+
+ /* Comparison according to AST ids. */
+ 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)
+ return -1;
+ else
+ return +1;
+}
+
+int Z3_ast_compare_ext(value v1, value v2) {
+ Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1);
+ 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)
+ return -1;
+ else
+ return +1;
+}
+
+intnat Z3_ast_hash(value v) {
+ Z3_ast_plus * ap = (Z3_ast_plus*)Data_custom_val(v);
+ 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 = {
+ (char*) "Z3_ast ops",
+ Z3_ast_finalize,
+ Z3_ast_compare,
+ Z3_ast_hash,
+ custom_serialize_default,
+ custom_deserialize_default,
+ Z3_ast_compare_ext
+};
+
+MK_CTX_OF(ast)
+
+#define MK_PLUS_OBJ_NO_REF(X) \
+ typedef struct { \
+ Z3_context_plus cp; \
+ Z3_ ## X p; \
+ } Z3_ ## X ## _plus; \
+ \
+ Z3_ ## X ## _plus Z3_ ## X ## _plus_mk(Z3_context_plus cp, Z3_ ## X p) { \
+ Z3_ ## X ## _plus r; \
+ r.cp = cp; \
+ r.p = p; \
+ r.cp->obj_count++; \
+ return r; \
+ } \
+ \
+ Z3_ ## X Z3_ ## X ## _plus_raw(Z3_ ## X ## _plus * pp) { \
+ return pp->p; \
+ } \
+ \
+ void Z3_ ## X ## _finalize(value v) { \
+ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \
+ pp->cp->obj_count--; \
+ try_to_delete_context(pp->cp); \
+ } \
+ \
+ int Z3_ ## X ## _compare(value v1, value v2) { \
+ Z3_ ## X ## _plus * pp1 = (Z3_ ## X ## _plus*)Data_custom_val(v1); \
+ Z3_ ## X ## _plus * pp2 = (Z3_ ## X ## _plus*)Data_custom_val(v2); \
+ if (pp1->cp != pp2->cp) \
+ return compare_pointers(pp1->cp, pp2->cp); \
+ else \
+ return compare_pointers(pp1->p, pp2->p); \
+ } \
+ \
+ intnat Z3_ ## X ## _hash(value v) { \
+ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \
+ return (intnat)pp->p; \
+ } \
+ \
+ int Z3_ ## X ## _compare_ext(value v1, value v2) { \
+ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v1); \
+ return compare_pointers(pp->p, (void*)Val_int(v2)); \
+ } \
+ \
+ static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \
+ (char*) "Z3_" #X " ops", \
+ Z3_ ## X ## _finalize, \
+ Z3_ ## X ## _compare, \
+ Z3_ ## X ## _hash, \
+ custom_serialize_default, \
+ custom_deserialize_default, \
+ Z3_ ## X ## _compare_ext \
+ }; \
+ \
+ MK_CTX_OF(X)
+
+#define MK_PLUS_OBJ(X) \
+ typedef struct { \
+ Z3_context_plus cp; \
+ Z3_ ## X p; \
+ } Z3_ ## X ## _plus; \
+ \
+ Z3_ ## X ## _plus Z3_ ## X ## _plus_mk(Z3_context_plus cp, Z3_ ## X p) { \
+ Z3_ ## X ## _plus r; \
+ r.cp = cp; \
+ r.p = p; \
+ r.cp->obj_count++; \
+ if (p != NULL) \
+ Z3_ ## X ## _inc_ref(cp->ctx, p); \
+ return r; \
+ } \
+ \
+ Z3_ ## X Z3_ ## X ## _plus_raw(Z3_ ## X ## _plus * pp) { \
+ return pp->p; \
+ } \
+ \
+ void Z3_ ## X ## _finalize(value v) { \
+ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \
+ if (pp->p != NULL) \
+ Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \
+ pp->cp->obj_count--; \
+ try_to_delete_context(pp->cp); \
+ } \
+ \
+ int Z3_ ## X ## _compare(value v1, value v2) { \
+ Z3_ ## X ## _plus * pp1 = (Z3_ ## X ## _plus*)Data_custom_val(v1); \
+ Z3_ ## X ## _plus * pp2 = (Z3_ ## X ## _plus*)Data_custom_val(v2); \
+ if (pp1->cp != pp2->cp) \
+ return compare_pointers(pp1->cp, pp2->cp); \
+ else \
+ return compare_pointers(pp1->p, pp2->p); \
+ } \
+ \
+ intnat Z3_ ## X ## _hash(value v) { \
+ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \
+ return (intnat)pp->p; \
+ } \
+ \
+ int Z3_ ## X ## _compare_ext(value v1, value v2) { \
+ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v1); \
+ return compare_pointers(pp->p, (void*)Val_int(v2)); \
+ } \
+ \
+ static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \
+ (char*) "Z3_" #X " ops", \
+ Z3_ ## X ## _finalize, \
+ Z3_ ## X ## _compare, \
+ Z3_ ## X ## _hash, \
+ custom_serialize_default, \
+ custom_deserialize_default, \
+ Z3_ ## X ## _compare_ext \
+ }; \
+ \
+ MK_CTX_OF(X)
+
+MK_PLUS_OBJ_NO_REF(symbol)
+MK_PLUS_OBJ_NO_REF(constructor)
+MK_PLUS_OBJ_NO_REF(constructor_list)
+MK_PLUS_OBJ_NO_REF(rcf_num)
+MK_PLUS_OBJ(params)
+MK_PLUS_OBJ(param_descrs)
+MK_PLUS_OBJ(model)
+MK_PLUS_OBJ(func_interp)
+MK_PLUS_OBJ(func_entry)
+MK_PLUS_OBJ(goal)
+MK_PLUS_OBJ(tactic)
+MK_PLUS_OBJ(probe)
+MK_PLUS_OBJ(apply_result)
+MK_PLUS_OBJ(solver)
+MK_PLUS_OBJ(stats)
+MK_PLUS_OBJ(ast_map)
+MK_PLUS_OBJ(ast_vector)
+MK_PLUS_OBJ(fixedpoint)
+MK_PLUS_OBJ(optimize)
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+void MLErrorHandler(Z3_context c, Z3_error_code e)
+{
+ /* Internal do-nothing error handler. This is required to avoid that Z3 calls exit()
+ upon errors, but the actual error handling is done by throwing exceptions in the
+ n_* wrapper functions. */
+}
+
+CAMLprim value DLL_PUBLIC n_set_internal_error_handler(value ctx_v)
+{
+ CAMLparam1(ctx_v);
+ Z3_context_plus ctx_p = *(Z3_context_plus*) Data_custom_val(ctx_v);
+ Z3_set_error_handler(ctx_p->ctx, MLErrorHandler);
+ CAMLreturn(Val_unit);
+}