From 824169da0a68658b68e377697843696c3a788719 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Sat, 13 Feb 2016 22:09:45 +0000 Subject: [PATCH 01/25] New OCaml API --- scripts/mk_make.py | 12 +- scripts/mk_util.py | 180 +- scripts/update_api.py | 376 ++-- src/api/ml/z3.ml | 3558 ++++++++++++------------------- src/api/ml/z3.mli | 54 +- src/api/ml/z3native.ml.pre | 107 + src/api/ml/z3native_stubs.c.pre | 384 ++++ 7 files changed, 2134 insertions(+), 2537 deletions(-) create mode 100644 src/api/ml/z3native.ml.pre create mode 100644 src/api/ml/z3native_stubs.c.pre diff --git a/scripts/mk_make.py b/scripts/mk_make.py index 813cd3a66..0e2409b0f 100644 --- a/scripts/mk_make.py +++ b/scripts/mk_make.py @@ -13,11 +13,9 @@ parse_options() check_eol() API_files = init_project_def() -update_version() -mk_auto_src() +#update_version() +#mk_auto_src() mk_bindings(API_files) -mk_vs_proj('z3', ['shell']) -mk_vs_proj_dll('libz3', ['api_dll']) -mk_makefile() - - +#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 33f70c98d..5df823ae2 100644 --- a/scripts/mk_util.py +++ b/scripts/mk_util.py @@ -1793,6 +1793,10 @@ class MLComponent(Component): def mk_makefile(self, out): if is_ml_enabled(): + CP_CMD = 'cp' + if IS_WINDOWS: + CP_CMD='copy' + 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 @@ -1809,10 +1813,6 @@ 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)' @@ -1820,29 +1820,27 @@ class MLComponent(Component): 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 - 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' % (OCAMLC, self.sub_dir, ml, mli)) + out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLC, self.sub_dir, cmi, mli)) + out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLC, 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('%s: %s %s\n' % (ft, ff, cmos)) out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLOPT, self.sub_dir, ft, ff)) cmxs = cmxs + ' ' + ft @@ -1896,7 +1894,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(' %s' % ((os.path.join(self.sub_dir, 'libz3ml$(LIB_EXT)')))) out.write(' %s' % ((os.path.join(self.sub_dir, 'z3ml$(LIB_EXT)')))) @@ -3301,78 +3303,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 fc0f1c939..b3c7d7072 100644 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -219,7 +219,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) @@ -1125,6 +1129,110 @@ def arrayparams(params): 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' + 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 'Z3_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 + ')' @@ -1140,8 +1248,11 @@ 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: @@ -1158,78 +1269,43 @@ def ml_set_wrap(t, d, n): 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(ts) + return 'memcpy(Data_custom_val(' + d + '), &' + n + ', sizeof(' + pts + '));' -def mk_ml(): - global Type2Str - if not is_ml_enabled(): - return - ml_dir = get_component('ml').src_dir +def mk_z3native_ml(ml_dir): 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_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('module ML2C = struct\n\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)) 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)) @@ -1237,7 +1313,6 @@ def mk_ml(): 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: @@ -1284,91 +1359,22 @@ def mk_ml(): ml_native.write(' res\n') ml_native.write('\n') ml_native.write('(**/**)\n') + ml_native.close() - # C interface + if is_verbose(): + print ('Generated "%s"' % ml_nativef) + + +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 \n') - ml_wrapper.write('#include \n\n') - ml_wrapper.write('#ifdef __cplusplus\n') - ml_wrapper.write('extern "C" {\n') - ml_wrapper.write('#endif\n') - ml_wrapper.write('#include \n') - ml_wrapper.write('#include \n') - ml_wrapper.write('#include \n') - ml_wrapper.write('#include \n') - ml_wrapper.write('#include \n') - ml_wrapper.write('#ifdef Custom_tag\n') - ml_wrapper.write('#include \n') - ml_wrapper.write('#include \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 \n') - ml_wrapper.write('#include \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) @@ -1410,7 +1416,7 @@ def mk_ml(): 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)) + 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) @@ -1423,45 +1429,63 @@ def mk_ml(): # declare locals, preprocess arrays, strings, in/out arguments 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') + 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, 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(' for (_i = 0; _i < _a%s; _i++) {\n' % param_array_capacity_pos(param)) + ml_wrapper.write(' _a%s[_i] = %s;\n' % (i, ml_unwrap(t, ts, 'Field(a' + str(i) + ', _i)'))) + ml_wrapper.write(' }\n') i = i + 1 - # invoke procedure ml_wrapper.write(' ') + need_closing_paren = False if result != VOID: - ml_wrapper.write('z3_result = ') + ts = type2str(result) + if ml_has_plus_type(ts): + pts = ml_plus_type(ts) + ml_wrapper.write('result = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (ml_plus_ops_type(ts), pts)) + if ts == 'Z3_context': + ml_wrapper.write(' %s z3rv = %s_mk(' % (pts, pts)) + else: + ml_wrapper.write(' %s z3rv = %s_mk(ctx_p, (%s) ' % (pts, pts, ml_minus_type(ts))) + need_closing_paren = True + else: + ml_wrapper.write('result = caml_alloc(%s, 0);\n' % ret_size) + ml_wrapper.write(' %s z3rv = ' % ts) + elif len(op) != 0: + ml_wrapper.write('result = caml_alloc(%s, 0);\n ' % ret_size) + + # invoke procedure ml_wrapper.write('%s(' % name) i = 0 first = True @@ -1476,31 +1500,51 @@ def mk_ml(): else: ml_wrapper.write('_a%i' % i) i = i + 1 - ml_wrapper.write(');\n') + ml_wrapper.write(')') + if need_closing_paren: + ml_wrapper.write(')'); + ml_wrapper.write(';\n') # convert output params if len(op) > 0: - if result != VOID: - ml_wrapper.write(' %s\n' % ml_set_wrap(result, "res_val", "z3_result")) i = 0 for p in params: 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)) + ml_wrapper.write(' for (_i = 0; _i < _a%s; _i++) {\n' % param_array_capacity_pos(p)) + if ml_has_plus_type(ts): + pts = ml_plus_type(ts) + ml_wrapper.write(' value t;\n') + ml_wrapper.write(' t = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (ml_plus_ops_type(ts), pts)) + 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_set_wrap(param_type(p), 't', '_a%dp' % i)) + else: + ml_wrapper.write(' value t;\n') + ml_wrapper.write(' t = caml_alloc_custom(&default_custom_ops, sizeof(%s), 0, 1);\n' % (ts)) + ml_wrapper.write(' %s\n' % ml_set_wrap(param_type(p), 't', '_a%d[_i]' % i)) + ml_wrapper.write(' Store_field(_a%s_val, _i, t);\n' % i) + ml_wrapper.write(' }\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) )) + ml_wrapper.write(' %s\n' % ml_set_wrap(param_type(p), '_a%d_val' % i, '_a%d' % i)) elif is_out_param(p): - ml_wrapper.write(' %s\n' % ml_set_wrap(param_type(p), "_a" + str(i) + "_val", "_a" + str(i) )) + pt = param_type(p) + ts = type2str(pt) + 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_set_wrap(pt, '_a%d_val' % i, '_a%dp' % i)) + else: + ml_wrapper.write(' %s\n' % ml_set_wrap(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")) + ml_wrapper.write(' %s\n' % ml_set_wrap(result, "result", "z3rv")) else: - ml_wrapper.write(' result = caml_alloc(%s, 0);\n' % ret_size) i = j = 0 if result != VOID: - ml_wrapper.write(' Store_field(result, 0, res_val);\n') + ml_wrapper.write(' %s\n' % ml_set_wrap(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): @@ -1535,7 +1579,17 @@ def mk_ml(): ml_wrapper.write('}\n') ml_wrapper.write('#endif\n') if is_verbose(): - print ('Generated "%s"' % ml_nativef) + print ('Generated "%s"' % ml_wrapperf) + + +def mk_ml(): + global Type2Str + if not is_ml_enabled(): + return + + ml_dir = get_component('ml').src_dir + mk_z3native_ml(ml_dir) + mk_z3native_stubs_c(ml_dir) # Collect API(...) commands from def def_APIs(): diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml index ccf18a024..92155380c 100644 --- a/src/api/ml/z3.ml +++ b/src/api/ml/z3.ml @@ -13,85 +13,7 @@ exception Error = Z3native.Exception let null = Z3native.mk_null() let is_null o = (Z3native.is_null o) -(* 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 = -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 +type context = Z3native.context module Log = struct @@ -116,8 +38,8 @@ struct 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 = +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 else @@ -125,86 +47,53 @@ let mk_list ( f : int -> 'a ) ( n : int ) = 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 (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 -let mk_context ( cfg : ( string * string ) list ) = - create_context cfg module Symbol = struct - type symbol = z3_native_object - - 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 + type symbol = Z3native.symbol + let gc (o:symbol) = (Z3native.context_of_symbol o) - 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 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 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 ) = + let kind (o:symbol) = (symbol_kind_of_int (Z3native.get_symbol_kind (gc o) 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 (gc o) o) + let get_string (o:symbol ) = (Z3native.get_symbol_string (gc o) 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)) + | INT_SYMBOL -> (string_of_int (Z3native.get_symbol_int (gc o) o)) + | STRING_SYMBOL -> (Z3native.get_symbol_string (gc o) 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_int (ctx:context) (i:int) = (Z3native.mk_int_symbol ctx i) + let mk_string (ctx:context) (s:string) = (Z3native.mk_string_symbol ctx s) - let mk_ints ( ctx : context ) ( names : int list ) = - let f elem = mk_int ( ctx : context ) elem in + 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 + let mk_strings (ctx:context) (names:string list) = + let f elem = mk_string (ctx:context) elem in (List.map f 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 +107,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 +132,101 @@ 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 - - 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) + type ast = Z3native.ast + let gc (x:ast) = Z3native.context_of_ast 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 = 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 (x:ast_vector) = Z3native.context_of_ast_vector x - 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 (ctx:context) = Z3native.mk_ast_vector ctx + 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 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:ast_vector ) = Z3native.ast_vector_to_string (gc x) x end module ASTMap = struct - type ast_map = z3_native_object + type ast_map = Z3native.ast_map + let gc (x:ast_map) = Z3native.context_of_ast_map x - 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))) + let mk_ast_map (ctx:context) = Z3native.mk_ast_map ctx + 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 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 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_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 + let get_keys (x:ast_map) = + let av = (Z3native.ast_map_keys (gc x) 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 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 is_expr ( x : ast ) = - match get_ast_kind ( x : ast ) with - | APP_AST - | NUMERAL_AST - | QUANTIFIER_AST - | VAR_AST -> true - | _ -> false + 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 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 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 to_string (x:ast) = Z3native.ast_to_string (gc x) x + let to_sexpr (x:ast) = Z3native.ast_to_string (gc x) x - 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 equal (a:ast) (b:ast) = + (a == b) || + (if (gc a) != (gc b) then + false + else + Z3native.is_eq_ast (gc a) a 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 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 = Z3native.sort 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,71 +235,28 @@ sig val mk_uninterpreted : context -> Symbol.symbol -> sort val mk_uninterpreted_s : context -> string -> sort end = struct - type sort = Sort of AST.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 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 -> + type sort = Z3native.sort + let gc (x:sort) = Z3native.context_of_ast x + + 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) + (if (gc a) != (gc b) then + false + else + Z3native.is_eq_sort (gc a) a b) + + 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 (ctx:context) (s:Symbol.symbol) = Z3native.mk_uninterpreted_sort ctx s + 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 - val gc : func_decl -> context - val gnc : func_decl -> Z3native.ptr - val gno : func_decl -> Z3native.ptr + type func_decl = Z3native.func_decl +val gc : func_decl -> context module Parameter : sig type parameter = @@ -525,25 +296,8 @@ 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 = Z3native.func_decl + let gc (x:func_decl) = Z3native.context_of_ast x module Parameter = struct @@ -556,7 +310,7 @@ end = struct | P_Fdl of func_decl | P_Rat of string - let get_kind ( x : parameter ) = + let get_kind (x:parameter ) = (match x with | P_Int(_) -> PARAMETER_INT | P_Dbl(_) -> PARAMETER_DOUBLE @@ -566,113 +320,105 @@ end = struct | P_Fdl(_) -> PARAMETER_FUNC_DECL | P_Rat(_) -> PARAMETER_RATIONAL) - let get_int ( x : parameter ) = + 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 ) = + 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 ) = + 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 ) = + 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 ) = + let get_ast (x:parameter) = match x with | P_Ast(x) -> x | _ -> raise (Z3native.Exception "parameter is not an ast") - let get_func_decl ( x : parameter ) = + let get_func_decl (x:parameter) = match x with | P_Fdl(x) -> x | _ -> raise (Z3native.Exception "parameter is not a func_decl") - let get_rational ( x : parameter ) = + let get_rational (x:parameter) = match x with | P_Rat(x) -> x | _ -> raise (Z3native.Exception "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) (Array.of_list 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) (Array.of_list 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:func_decl ) (b:func_decl ) = + (a == b) || + (if (gc a) != (gc b) then + false + else + 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 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 + let f i = Z3native.get_domain (gc x) 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_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_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 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) + 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 + 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 @@ -685,81 +431,48 @@ sig val add_symbol : params -> Symbol.symbol -> Symbol.symbol -> unit val mk_params : context -> params val to_string : params -> string - + 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 (x:params) = Z3native.context_of_params x module ParamDescrs = struct - type param_descrs = z3_native_object + type param_descrs = Z3native.param_descrs + let gc (x:param_descrs) = Z3native.context_of_param_descrs x - 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 = Z3native.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 @@ -787,166 +500,83 @@ sig 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 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) - - 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) - 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) - - let expr_of_ast a = - let q = (Z3enums.ast_kind_of_int (Z3native.get_ast_kind (z3obj_gnc a) (z3obj_gno a))) in + type expr = Z3native.ast + let gc (e:expr) = Z3native.context_of_ast e + + let expr_of_ast (a:AST.ast) : expr = + 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 (Z3native.Exception "Invalid coercion") else - Expr(a) + a + + let ast_of_expr (e:expr) : AST.ast = e - let ast_of_expr e = match e with Expr(a) -> a + let expr_of_func_app:context -> FuncDecl.func_decl -> expr list -> expr = + fun ctx f args -> (Z3native.mk_app ctx f (List.length args) (Array.of_list args)) + + let apply1 ctx f t = f ctx t + let apply2 ctx f t1 t2 = f ctx t1 t2 + let apply3 ctx f t1 t2 t3 = f ctx t1 t2 t3 + let apply4 ctx f t1 t2 t3 t4 = f ctx t1 t2 t3 t4 - 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 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 (ctx:context) = Z3native.simplify_get_help ctx + let get_simplify_parameter_descrs (ctx:context) = Z3native.simplify_get_param_descrs ctx + 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 (ast_of_expr x)) && (List.length args <> (get_num_args x))) then + let update (x:expr) (args:expr list) = + if ((AST.is_app x) && (List.length args <> (get_num_args x))) then raise (Z3native.Exception "Number of arguments does 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) + Z3native.update_term (gc x) x (List.length args) (Array.of_list args) - let substitute ( x : expr ) from to_ = + let substitute (x:expr) (from:expr list) (to_:expr list) = 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_ ] + Z3native.substitute (gc x) x (List.length from) (Array.of_list from) (Array.of_list 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 substitute_one (x:expr) (from:expr) (to_:expr) = substitute (x:expr) [ from ] [ to_ ] + let substitute_vars (x:expr) (to_:expr list) = Z3native.substitute_vars (gc x) x (List.length to_) (Array.of_list to_) - let translate ( x : expr ) to_ctx = - if (Expr.gc x) == to_ctx then + 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 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)) && + 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 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 @@ -954,367 +584,277 @@ open Expr module Boolean = struct - let mk_sort ( ctx : context ) = - (Sort.sort_of_ptr ctx (Z3native.mk_bool_sort (context_gno ctx))) + let mk_sort (ctx:context) = Z3native.mk_bool_sort ctx + 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 (ctx:context) = Z3native.mk_true ctx + let mk_false (ctx:context) = Z3native.mk_false ctx + 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 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 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) = Z3native.mk_and ctx (List.length args) (Array.of_list args) + let mk_or (ctx:context) (args:expr list) = Z3native.mk_or ctx (List.length args) (Array.of_list 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) = Z3native.mk_distinct ctx (List.length args) (Array.of_list args) + let get_bool_value (x:expr) = lbool_of_int (Z3native.get_bool_value (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 is_bool (x:expr) = + (AST.is_expr x) && (Z3native.is_eq_sort (gc x) (Z3native.mk_bool_sort (gc x)) (Z3native.get_sort (gc x) x)) - let mk_true ( ctx : context ) = - expr_of_ptr ctx (Z3native.mk_true (context_gno ctx)) - - let mk_false ( ctx : context ) = - expr_of_ptr ctx (Z3native.mk_false (context_gno ctx)) - - 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 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 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:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_TRUE) + let is_false (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_FALSE) + let is_eq (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_EQ) + let is_distinct (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_DISTINCT) + let is_ite (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_ITE) + let is_and (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_AND) + let is_or (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_OR) + let is_iff (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_IFF) + let is_xor (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_XOR) + let is_not (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_NOT) + let is_implies (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_IMPLIES) end module Quantifier = struct - type quantifier = Quantifier of expr + type quantifier = Z3native.ast + let gc (x:quantifier) = Z3native.context_of_ast x + + let expr_of_quantifier (q:quantifier) : Expr.expr = q - let expr_of_quantifier e = match e with Quantifier(x) -> x + let quantifier_of_expr (e:Expr.expr) : quantifier = + let q = (Z3enums.ast_kind_of_int (Z3native.get_ast_kind (gc e) e)) in + if (q != Z3enums.QUANTIFIER_AST) then + raise (Z3native.Exception "Invalid coercion") + else + e - 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 = struct - type pattern = Pattern of AST.ast + type pattern = Z3native.pattern + let gc (x:pattern) = Z3native.context_of_ast x - 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:pattern) = 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 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 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:pattern) = 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 + let get_index (x:expr) = + if not (AST.is_var x) then raise (Z3native.Exception "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 is_universal (x:quantifier) = Z3native.is_quantifier_forall (gc x) x + let is_existential (x:quantifier) = not (is_universal x) + let get_weight (x:quantifier) = Z3native.get_quantifier_weight (gc x) x + let get_num_patterns (x:quantifier) = Z3native.get_quantifier_num_patterns (gc x) 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 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_num_no_patterns (x:quantifier) = Z3native.get_quantifier_num_no_patterns (gc x) x - let get_no_patterns ( x : quantifier ) = + 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 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_num_bound (x:quantifier) = Z3native.get_quantifier_num_bound (gc x) x - let get_bound_variable_names ( x : quantifier ) = + 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 f i = Z3native.get_quantifier_bound_name (gc x) x i in mk_list f n - let get_bound_variable_sorts ( x : quantifier ) = + 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 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 get_body (x:quantifier) = Z3native.get_quantifier_body (gc x) x + let mk_bound (ctx:context) (index:int) (ty:Sort.sort) = Z3native.mk_bound ctx index ty - 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 mk_pattern ( ctx : context ) ( terms : expr list ) = + let mk_pattern (ctx:context) (terms:expr list) = if (List.length terms) == 0 then raise (Z3native.Exception "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 (List.length terms) (Array.of_list 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 ) = + 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))) + Z3native.mk_quantifier ctx true + (match weight with | None -> 1 | Some(x) -> x) + (List.length patterns) (Array.of_list patterns) + (List.length sorts) (Array.of_list sorts) + (Array.of_list names) + body 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))) + Z3native.mk_quantifier_ex ctx true + (match weight with | None -> 1 | Some(x) -> x) + (match quantifier_id with | None -> null | Some(x) -> x) + (match skolem_id with | None -> null | Some(x) -> x) + (List.length patterns) (Array.of_list patterns) + (List.length nopatterns) (Array.of_list nopatterns) + (List.length sorts) (Array.of_list sorts) + (Array.of_list names) + 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 ) = + 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))) + Z3native.mk_quantifier_const ctx true + (match weight with | None -> 1 | Some(x) -> x) + (List.length bound_constants) (Array.of_list bound_constants) + (List.length patterns) (Array.of_list patterns) + 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))) + Z3native.mk_quantifier_const_ex ctx true + (match weight with | None -> 1 | Some(x) -> x) + (match quantifier_id with | None -> null | Some(x) -> x) + (match skolem_id with | None -> null | Some(x) -> x) + (List.length bound_constants) (Array.of_list bound_constants) + (List.length patterns) (Array.of_list patterns) + (List.length nopatterns) (Array.of_list nopatterns) + 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 ) = + 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))) + Z3native.mk_quantifier ctx false + (match weight with | None -> 1 | Some(x) -> x) + (List.length patterns) (Array.of_list patterns) + (List.length sorts) (Array.of_list sorts) + (Array.of_list names) + 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))) + Z3native.mk_quantifier_ex ctx false + (match weight with | None -> 1 | Some(x) -> x) + (match quantifier_id with | None -> null | Some(x) -> x) + (match skolem_id with | None -> null | Some(x) -> x) + (List.length patterns) (Array.of_list patterns) + (List.length nopatterns) (Array.of_list nopatterns) + (List.length sorts) (Array.of_list sorts) + (Array.of_list names) + 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 ) = + 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))) + Z3native.mk_quantifier_const ctx false + (match weight with | None -> 1 | Some(x) -> x) + (List.length bound_constants) (Array.of_list bound_constants) + (List.length patterns) (Array.of_list patterns) + body +else + Z3native.mk_quantifier_const_ex ctx false + (match weight with | None -> 1 | Some(x) -> x) + (match quantifier_id with | None -> null | Some(x) -> x) + (match skolem_id with | None -> null | Some(x) -> x) + (List.length bound_constants) (Array.of_list bound_constants) + (List.length patterns) (Array.of_list patterns) + (List.length nopatterns) (Array.of_list 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 ) = + 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) + 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) + 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 ) = + 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:quantifier) = Expr.to_string x end 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 (ctx:context) (domain:Sort.sort) (range:Sort.sort) = Z3native.mk_array_sort ctx domain range + let is_store (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_STORE) + let is_select (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SELECT) + let is_constant_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_CONST_ARRAY) + let is_default_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ARRAY_DEFAULT) + let is_array_map (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ARRAY_MAP) + let is_as_array (x:expr) = (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:expr) = + (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:Sort.sort) = Z3native.get_array_sort_domain (Sort.gc x) x + let get_range (x:Sort.sort) = 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 (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 ) = + 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_store ( ctx : context ) ( a : expr ) ( i : expr ) ( v : expr ) = - apply3 ctx Z3native.mk_store a i v - - 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_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_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_select (ctx:context) (a:expr) (i:expr) = apply2 ctx Z3native.mk_select a i + let mk_store (ctx:context) (a:expr) (i:expr) (v:expr) = apply3 ctx Z3native.mk_store a i v + let mk_const_array (ctx:context) (domain:Sort.sort) (v:expr) = Z3native.mk_const_array ctx domain v + let mk_map (ctx:context) (f:func_decl) (args:expr list) = Z3native.mk_map ctx f (List.length args) (Array.of_list 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 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 mk_sort (ctx:context) (ty:Sort.sort) = Z3native.mk_set_sort ctx ty + + 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 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) = Z3native.mk_empty_set ctx domain + let mk_full (ctx:context) (domain:Sort.sort) = Z3native.mk_full_set ctx 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) = Z3native.mk_set_union ctx (List.length args) (Array.of_list args) + let mk_intersection (ctx:context) (args:expr list) = + Z3native.mk_set_intersect ctx (List.length args) (Array.of_list args) - 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 - + 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 mk_sort (ctx:context) (name:Symbol.symbol) (size:int) = Z3native.mk_finite_domain_sort ctx 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_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 (Expr.ast_of_expr x)) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_FD_LT) + 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 : Sort.sort ) = - let (r, v) = (Z3native.get_finite_domain_sort_size (Sort.gnc x) (Sort.gno x)) in + let get_size (x:Sort.sort) = + let (r, v) = (Z3native.get_finite_domain_sort_size (Sort.gc x) x) in if r then v else raise (Z3native.Exception "Conversion failed.") end @@ -1322,30 +862,30 @@ end module Relation = 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 is_relation (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)) == RELATION_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_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.gnc x) (Sort.gno x) + let get_arity (x:Sort.sort) = Z3native.get_relation_arity (Sort.gc x) x - let get_column_sorts ( x : Sort.sort ) = + 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 @@ -1354,7 +894,7 @@ module Datatype = struct module Constructor = struct - type constructor = z3_native_object + type constructor = Z3native.constructor module FieldNumTable = Hashtbl.Make(struct type t = AST.ast @@ -1364,114 +904,96 @@ struct 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 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") + raise (Z3native.Exception "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 + if n != (List.length sort_refs) then + raise (Z3native.Exception "Number of field names does not match number of sort refs") + else + let no = Z3native.mk_constructor ctx name + recognizer + n + (Array.of_list field_names) + (let f x = match x with None -> null | Some(s) -> s in + Array.of_list (List.map f sorts)) + (Array.of_list sort_refs) in + FieldNumTable.add _field_nums no n ; + no - let get_num_fields ( x : constructor ) = FieldNumTable.find _field_nums x + let get_num_fields (x:constructor) = FieldNumTable.find _field_nums x - 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_constructor_decl (x:constructor ) = + let (a, _, _) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in + a - 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_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 (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 + let get_accessor_decls (x:constructor) = + let (_, _, c) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in + let f i = Array.get c i in mk_list f (Array.length 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) (Array.of_list 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) (Array.of_list 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 + 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 = Array.of_list (List.map f c) in + let (r, a) = Z3native.mk_datatypes ctx n (Array.of_list names) cla in + let g i = 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 ) = + 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 get_num_constructors ( x : Sort.sort ) = Z3native.get_datatype_sort_num_constructors (Sort.gnc x) (Sort.gno x) + 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 = func_decl_of_ptr (Sort.gc x) (Z3native.get_datatype_sort_constructor (Sort.gnc x) (Sort.gno x) i) in + 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 + 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 @@ -1480,392 +1002,286 @@ 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 + 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) (Array.of_list 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_sort (ctx:context) (name:Symbol.symbol) (elem_sort:Sort.sort) = + let (r, _, _, _, _, _, _) = Z3native.mk_list_sort ctx name elem_sort in + 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) [] + 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 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 (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) (field_names:Symbol.symbol list) (field_sorts:Sort.sort list) = + let (r, _, _) = (Z3native.mk_tuple_sort ctx name (List.length field_names) (Array.of_list field_names) (Array.of_list field_sorts)) 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 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_num_fields ( x : Sort.sort ) = Z3native.get_tuple_sort_num_fields (Sort.gnc x) (Sort.gno x) - - let get_field_decls ( x : Sort.sort ) = + 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_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_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_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)) + let mk_sort (ctx:context) = Z3native.mk_int_sort ctx - let get_int ( x : expr ) = - let (r, v) = Z3native.get_numeral_int (Expr.gnc x) (Expr.gno x) in + let get_int (x:expr) = + let (r, v) = Z3native.get_numeral_int (Expr.gc x) x in if r then v else raise (Z3native.Exception "Conversion failed.") - let get_big_int ( x : expr ) = + 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 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 s = (Z3native.get_numeral_string (Expr.gc x) 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.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 (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) = 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 (ctx:context) (t:expr) = apply1 ctx Z3native.mk_int2real t + let mk_int2bv (ctx:context) (n:int) (t:expr) = Z3native.mk_int2bv ctx n t end module Real = struct - let mk_sort ( ctx : context ) = - Sort.sort_of_ptr ctx (Z3native.mk_real_sort (context_gno ctx)) - - let get_numerator ( x : expr ) = - apply1 (Expr.gc x) Z3native.get_numerator x + let mk_sort (ctx:context) = Z3native.mk_real_sort ctx + 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_denominator ( x : expr ) = - apply1 (Expr.gc x) Z3native.get_denominator x - - let get_ratio ( x : expr ) = + 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 s = (Z3native.get_numeral_string (Expr.gc x) x) in + Ratio.ratio_of_string s + else + raise (Z3native.Exception "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 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 ) = + 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 (Z3native.Exception "Denominator is zero") + raise (Z3native.Exception "Denominator is zero") else - expr_of_ptr ctx (Z3native.mk_real (context_gno ctx) num den) + Z3native.mk_real 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 (ctx:context) (t:expr) = apply1 ctx Z3native.mk_is_int t + let mk_real2int (ctx:context) (t:expr) = apply1 ctx Z3native.mk_real2int t 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) + 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_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_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_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_add (ctx:context) (t:expr list) = Z3native.mk_add ctx (List.length t) (Array.of_list t) + let mk_mul (ctx:context) (t:expr list) = Z3native.mk_mul ctx (List.length t) (Array.of_list t) + let mk_sub (ctx:context) (t:expr list) = Z3native.mk_sub ctx (List.length t) (Array.of_list t) + let mk_unary_minus (ctx:context) (t:expr) = apply1 ctx Z3native.mk_unary_minus 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 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 + 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) = + let (r, v) = Z3native.get_numeral_int (Expr.gc x) 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 ) = + 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 ) = + 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 (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) = Z3native.mk_extract ctx high low t + let mk_sign_ext (ctx:context) (i:int) (t:expr) = Z3native.mk_sign_ext ctx i t + let mk_zero_ext (ctx:context) (i:int) (t:expr) = Z3native.mk_zero_ext ctx i t + let mk_repeat (ctx:context) (i:int) (t:expr) = Z3native.mk_repeat ctx i 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) = Z3native.mk_rotate_left ctx i t + let mk_rotate_right (ctx:context) (i:int) (t:expr) = Z3native.mk_rotate_right ctx i 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) = Z3native.mk_bv2int ctx t signed + let mk_add_no_overflow (ctx:context) (t1:expr) (t2:expr) (signed:bool) = Z3native.mk_bvadd_no_overflow ctx t1 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) = Z3native.mk_bvsub_no_underflow ctx t1 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) = Z3native.mk_bvmul_no_overflow ctx t1 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) = Z3native.mk_numeral ctx v (mk_sort ctx size) end @@ -1873,674 +1289,467 @@ module FloatingPoint = struct 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 (ctx:context) = Z3native.mk_fpa_rounding_mode_sort 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) = Z3native.mk_fpa_round_nearest_ties_to_even ctx + let mk_rne (ctx:context) = Z3native.mk_fpa_rne ctx + let mk_round_nearest_ties_to_away (ctx:context) = Z3native.mk_fpa_round_nearest_ties_to_away ctx + let mk_rna (ctx:context) = Z3native.mk_fpa_rna ctx + let mk_round_toward_positive (ctx:context) = Z3native.mk_fpa_round_toward_positive ctx + let mk_rtp (ctx:context) = Z3native.mk_fpa_rtp ctx + let mk_round_toward_negative (ctx:context) = Z3native.mk_fpa_round_toward_negative ctx + let mk_rtn (ctx:context) = Z3native.mk_fpa_rtn ctx + let mk_round_toward_zero (ctx:context) = Z3native.mk_fpa_round_toward_zero ctx + let mk_rtz (ctx:context) = Z3native.mk_fpa_rtz ctx 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_sort (ctx:context) (ebits:int) (sbits:int) = Z3native.mk_fpa_sort ctx ebits sbits + let mk_sort_half (ctx:context) = Z3native.mk_fpa_sort_half ctx + let mk_sort_16 (ctx:context) = Z3native.mk_fpa_sort_16 ctx + let mk_sort_single (ctx:context) = Z3native.mk_fpa_sort_single ctx + let mk_sort_32 (ctx:context) = Z3native.mk_fpa_sort_32 ctx + let mk_sort_double (ctx:context) = Z3native.mk_fpa_sort_double ctx + let mk_sort_64 (ctx:context) = Z3native.mk_fpa_sort_64 ctx + let mk_sort_quadruple (ctx:context) = Z3native.mk_fpa_sort_quadruple ctx + let mk_sort_128 (ctx:context) = Z3native.mk_fpa_sort_128 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_nan (ctx:context) (s:Sort.sort) = Z3native.mk_fpa_nan ctx s + let mk_inf (ctx:context) (s:Sort.sort) (negative:bool) = Z3native.mk_fpa_inf ctx s negative + let mk_zero (ctx:context) (s:Sort.sort) (negative:bool) = Z3native.mk_fpa_zero ctx s negative + 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) = Z3native.mk_fpa_numeral_double ctx value s + let mk_numeral_i (ctx:context) (value:int) (s:Sort.sort) = Z3native.mk_fpa_numeral_int ctx value s + let mk_numeral_i_u (ctx:context) (sign:bool) (exponent:int) (significand:int) (s:Sort.sort) = Z3native.mk_fpa_numeral_int64_uint64 ctx sign exponent significand s + let mk_numeral_s (ctx:context) (v:string) (s:Sort.sort) = Z3native.mk_numeral ctx v s - 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 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 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 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 ) = + let numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) 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 ) = + let mk_const_s (ctx:context) (name:string) (s:Sort.sort) = mk_const ctx (Symbol.mk_string ctx name) s - 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 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_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 (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) = Z3native.mk_fpa_to_fp_bv ctx t s + let mk_to_fp_float (ctx:context) (rm:expr) (t:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_float ctx rm t s + let mk_to_fp_real (ctx:context) (rm:expr) (t:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_real ctx rm t s + let mk_to_fp_signed (ctx:context) (rm:expr) (t:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_signed ctx rm t s + let mk_to_fp_unsigned (ctx:context) (rm:expr) (t:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_unsigned ctx rm t s + let mk_to_ubv (ctx:context) (rm:expr) (t:expr) (size:int) = Z3native.mk_fpa_to_ubv ctx rm t size + let mk_to_sbv (ctx:context) (rm:expr) (t:expr) (size:int) = Z3native.mk_fpa_to_sbv ctx rm t size + let mk_to_real (ctx:context) (t:expr) = apply1 ctx Z3native.mk_fpa_to_real t + let get_ebits (ctx:context) (s:Sort.sort) = Z3native.fpa_get_ebits ctx s + let get_sbits (ctx:context) (s:Sort.sort) = Z3native.fpa_get_sbits ctx s + let get_numeral_sign (ctx:context) (t:expr) = Z3native.fpa_get_numeral_sign ctx t + let get_numeral_significand_string (ctx:context) (t:expr) = Z3native.fpa_get_numeral_significand_string ctx t + let get_numeral_significand_uint (ctx:context) (t:expr) = Z3native.fpa_get_numeral_significand_uint64 ctx t + let get_numeral_exponent_string (ctx:context) (t:expr) = Z3native.fpa_get_numeral_exponent_string ctx t + let get_numeral_exponent_int (ctx:context) (t:expr) = Z3native.fpa_get_numeral_exponent_int64 ctx t + let mk_to_ieee_bv (ctx:context) (t:expr) = Z3native.mk_fpa_to_ieee_bv ctx t + let mk_to_fp_int_real (ctx:context) (rm:expr) (exponent:expr) (significand:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_int_real ctx rm exponent significand s + let numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) x end 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 + type goal = Z3native.goal + let gc (x:goal) = Z3native.context_of_goal x - 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 (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 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 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 + let add (x:goal) (constraints:expr list) = + let f e = Z3native.goal_assert (gc x) x e in ignore (List.map f constraints) ; () - let is_inconsistent ( x : goal ) = - Z3native.goal_inconsistent (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_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 get_formulas ( x : goal ) = + 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 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 + 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 (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 + raise (Z3native.Exception "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 (ctx:context) (models:bool) (unsat_cores:bool) (proofs:bool) = + Z3native.mk_goal ctx models unsat_cores proofs - 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 as_expr (x:goal) = let n = get_size x in if n = 0 then - (Boolean.mk_true (z3obj_gc x)) + Boolean.mk_true (gc x) else if n = 1 then - (List.hd (get_formulas x)) + List.hd (get_formulas x) else - (Boolean.mk_and (z3obj_gc x) (get_formulas x)) + Boolean.mk_and (gc x) (get_formulas x) end module Model = struct - type model = z3_native_object - - 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 - + type model = Z3native.model + let gc (x:model) = Z3native.context_of_model x + module FuncInterp = struct - type func_interp = z3_native_object - - 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 - + type func_interp = Z3native.func_interp + let gc (x:func_interp) = Z3native.context_of_func_interp x + 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)) + type func_entry = Z3native.func_entry + let gc (x:func_entry) = Z3native.context_of_func_entry x - 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 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)) ^ "]") + 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 ) = + 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 + (sort_kind_of_int (Z3native.get_sort_kind (FuncDecl.gc f) (Z3native.get_range (FuncDecl.gc f) f))) == ARRAY_SORT then raise (Z3native.Exception "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 + let np = Z3native.model_get_const_interp (gc x) x f in if (Z3native.is_null np) then - None + None else - Some (expr_of_ptr (z3obj_gc x) np) - - let get_const_interp_e ( x : model ) ( a : expr ) = get_const_interp x (Expr.get_func_decl a) + Some np + + 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 + 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 (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno f) in + let n = Z3native.model_get_const_interp (gc x) x f in if (Z3native.is_null n) then - None + 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"); + match sk with + | ARRAY_SORT -> + if not (Z3native.is_as_array (gc x) n) then + raise (Z3native.Exception "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 (Z3native.Exception "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 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_num_consts (x:model ) = Z3native.model_get_num_consts (gc x) x - let get_const_decls ( x : model ) = + 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_num_funcs (x:model ) = Z3native.model_get_num_funcs (gc x) x - let get_func_decls ( x : model ) = + 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 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 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 eval (x:model ) (t:expr) (completion:bool) = + let (r, v) = Z3native.model_eval (gc x) x t completion in + if not r then None else Some 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 evaluate (x:model) (t:expr) (completion:bool) = eval x t completion + 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 = (Sort.sort_of_ptr (z3obj_gc x) (Z3native.model_get_sort (z3obj_gnc x) (z3obj_gno x) i)) in + 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 (ctx:context) = Z3native.get_num_probes ctx - 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 (ctx:context) (name:string) = Z3native.probe_get_descr ctx name + let mk_probe (ctx:context) (name:string) = Z3native.mk_probe ctx name + let const (ctx:context) (v:float) = Z3native.probe_const ctx v + let lt (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_lt ctx p1 p2 + let gt (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_gt ctx p1 p2 + let le (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_le ctx p1 p2 + let ge (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_ge ctx p1 p2 + let eq (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_eq ctx p1 p2 + let and_ (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_and ctx p1 p2 + let or_ (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_or ctx p1 p2 + let not_ (ctx:context) (p:probe ) = Z3native.probe_not ctx p end module Tactic = struct - type tactic = z3_native_object - - 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 + type tactic = Z3native.tactic + let gc (x:tactic) = Z3native.context_of_tactic x module ApplyResult = struct - type apply_result = z3_native_object + type apply_result = Z3native.apply_result + let gc (x:apply_result) = Z3native.context_of_apply_result x + + let get_num_subgoals (x:apply_result) = Z3native.apply_result_get_num_subgoals (gc x) x - 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 + 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_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 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 apply ( x : tactic ) ( g : Goal.goal ) ( p : Params.params option ) = + 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))) + | 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 (ctx:context) = Z3native.get_num_tactics ctx - 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 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 get_tactic_description (ctx:context) (name:string) = Z3native.tactic_get_descr ctx name + let mk_tactic (ctx:context) (name:string) = Z3native.mk_tactic 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 + | 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) - - 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) + | 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) = Z3native.tactic_or_else ctx t1 t2 + let try_for (ctx:context) (t:tactic) (ms:int) = Z3native.tactic_try_for ctx t ms + let when_ (ctx:context) (p:Probe.probe) (t:tactic) = Z3native.tactic_when ctx p t + let cond (ctx:context) (p:Probe.probe) (t1:tactic) (t2:tactic) = Z3native.tactic_cond ctx p t1 t2 + let repeat (ctx:context) (t:tactic) (max:int) = Z3native.tactic_repeat ctx t max + let skip (ctx:context) = Z3native.tactic_skip ctx + let fail (ctx:context) = Z3native.tactic_fail ctx + let fail_if (ctx:context) (p:Probe.probe) = Z3native.tactic_fail_if ctx p + let fail_if_not_decided (ctx:context) = Z3native.tactic_fail_if_not_decided ctx + let using_params (ctx:context) (t:tactic) (p:Params.params) = Z3native.tactic_using_params ctx t p + let with_ (ctx:context) (t:tactic) (p:Params.params) = using_params ctx t p + let par_or (ctx:context) (t:tactic list) = Z3native.tactic_par_or ctx (List.length t) (Array.of_list t) + let par_and_then (ctx:context) (t1:tactic) (t2:tactic) = Z3native.tactic_par_and_then ctx t1 t2 + let interrupt (ctx:context) = Z3native.interrupt ctx 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 - + type statistics = Z3native.stats + let gc (x:statistics) = Z3native.context_of_stats x 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 } + 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 = { + let res:statistics_entry = { m_key = k ; m_is_int = true ; m_is_float = false ; @@ -2550,7 +1759,7 @@ struct res let create_sd k v = - let res : statistics_entry = { + let res:statistics_entry = { m_key = k ; m_is_int = false ; m_is_float = true ; @@ -2560,42 +1769,40 @@ struct res - 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 + 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 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 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 (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 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 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) end @@ -2603,326 +1810,220 @@ end module Solver = struct - type solver = z3_native_object + type solver = Z3native.solver type status = UNSATISFIABLE | UNKNOWN | SATISFIABLE + let gc (x:solver) = Z3native.context_of_solver x - 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" | _ -> "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 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 get_num_scopes ( x : solver ) = Z3native.solver_get_num_scopes (z3obj_gnc x) (z3obj_gno x) - - let push ( x : solver ) = Z3native.solver_push (z3obj_gnc x) (z3obj_gno x) - - let pop ( x : solver ) ( n : int ) = Z3native.solver_pop (z3obj_gnc x) (z3obj_gno x) n - - 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 + let add (x:solver) (constraints:expr list) = + let f e = (Z3native.solver_assert (gc x) x e) in ignore (List.map f constraints) - let assert_and_track_l ( x : solver ) ( cs : expr list ) ( ps : expr list ) = + 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 + let f a b = Z3native.solver_assert_and_track (gc x) x a 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 assert_and_track (x:solver) (c:expr) (p:expr) = + Z3native.solver_assert_and_track (gc x) x c 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_num_assertions (x:solver) = + let a = Z3native.solver_get_assertions (gc x) 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 get_assertions (x:solver) = + let av = Z3native.solver_get_assertions (gc x) x in + AST.ASTVector.to_expr_list av - let check ( x : solver ) ( assumptions : expr list ) = + 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)) + lbool_of_int (Z3native.solver_check (gc x) 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 f x = x in + lbool_of_int (Z3native.solver_check_assumptions (gc x) x (List.length assumptions) (Array.of_list (List.map f assumptions))) in match r with - | L_TRUE -> SATISFIABLE - | L_FALSE -> UNSATISFIABLE - | _ -> UNKNOWN + | 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_model (x:solver) = + let q = Z3native.solver_get_model (gc x) x in + if (Z3native.is_null q) then None else Some 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_proof (x:solver) = + let q = Z3native.solver_get_proof (gc x) x in + if (Z3native.is_null q) then None else Some 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) + let get_unsat_core (x:solver) = + let av = Z3native.solver_get_unsat_core (gc x) x in + AST.ASTVector.to_expr_list av - let get_reason_unknown ( x : solver ) = Z3native.solver_get_reason_unknown (z3obj_gnc x) (z3obj_gno x) - - let get_statistics ( x : solver ) = - (Statistics.create (z3obj_gc x) (Z3native.solver_get_statistics (z3obj_gnc x) (z3obj_gno x))) - - let mk_solver ( ctx : context ) ( logic : Symbol.symbol option ) = + let get_reason_unknown (x:solver) = Z3native.solver_get_reason_unknown (gc x) x + let get_statistics (x:solver) = Z3native.solver_get_statistics (gc x) x + + let mk_solver (ctx:context) (logic:Symbol.symbol option) = 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))) - - 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) + | 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) = Z3native.mk_simple_solver ctx + let mk_solver_t (ctx:context) (t:Tactic.tactic) = Z3native.mk_solver_from_tactic ctx t + let translate (x:solver) (to_ctx:context) = Z3native.solver_translate (gc x) x to_ctx + let to_string (x:solver) = 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 (x:fixedpoint) = Z3native.context_of_fixedpoint x + let get_help (x:fixedpoint) = Z3native.fixedpoint_get_help (gc x) x + let set_parameters (x:fixedpoint) (p:Params.params) = Z3native.fixedpoint_set_params (gc x) x p + let get_param_descrs (x:fixedpoint) = Z3native.fixedpoint_get_param_descrs (gc x) x - 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 + let add (x:fixedpoint) (constraints:expr list) = + let f e = Z3native.fixedpoint_assert (gc x) x e in ignore (List.map f constraints) ; () - let register_relation ( x : fixedpoint ) ( f : func_decl ) = - Z3native.fixedpoint_register_relation (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno f) + let register_relation (x:fixedpoint) (f:func_decl) = Z3native.fixedpoint_register_relation (gc x) x f - let add_rule ( x : fixedpoint ) ( rule : expr ) ( name : Symbol.symbol option ) = + 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_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 query ( x : fixedpoint ) ( query : expr ) = - match (lbool_of_int (Z3native.fixedpoint_query (z3obj_gnc x) (z3obj_gno x) (Expr.gno query))) with + | None -> Z3native.fixedpoint_add_rule (gc x) x rule null + | Some(y) -> Z3native.fixedpoint_add_rule (gc x) x rule y + + let add_fact (x:fixedpoint) (pred:func_decl) (args:int list) = + Z3native.fixedpoint_add_fact (gc x) x pred (List.length args) (Array.of_list args) + + 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 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 query_r (x:fixedpoint) (relations:func_decl list) = + match (lbool_of_int (Z3native.fixedpoint_query_relations (gc x) x (List.length relations) (Array.of_list relations))) with + | L_TRUE -> Solver.SATISFIABLE + | L_FALSE -> Solver.UNSATISFIABLE + | _ -> Solver.UNKNOWN + + let push (x:fixedpoint) = Z3native.fixedpoint_push (gc x) x + let pop (x:fixedpoint) = Z3native.fixedpoint_pop (gc x) x + let update_rule (x:fixedpoint) (rule:expr) (name:Symbol.symbol) = Z3native.fixedpoint_update_rule (gc x) x rule name + + let get_answer (x:fixedpoint) = + let q = (Z3native.fixedpoint_get_answer (gc x) x) in + if (Z3native.is_null q) then None else Some q + + let get_reason_unknown (x:fixedpoint) = Z3native.fixedpoint_get_reason_unknown (gc x) x + let get_num_levels (x:fixedpoint) (predicate:func_decl) = Z3native.fixedpoint_get_num_levels (gc x) x predicate + + 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 q) then None else Some q - let push ( x : fixedpoint ) = - Z3native.fixedpoint_push (z3obj_gnc x) (z3obj_gno x) + let add_cover (x:fixedpoint) (level:int) (predicate:func_decl) (property:expr) = + Z3native.fixedpoint_add_cover (gc x) x level predicate property - let pop ( x : fixedpoint ) = - Z3native.fixedpoint_pop (z3obj_gnc x) (z3obj_gno x) - - 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 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 get_reason_unknown ( x : fixedpoint ) = - Z3native.fixedpoint_get_reason_unknown (z3obj_gnc x) (z3obj_gno 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_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 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 (z3obj_gnc x) (z3obj_gno x) (FuncDecl.gno f) (List.length kinds) (Symbol.symbol_lton kinds) + 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) (Array.of_list kinds) - 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 to_string_q (x:fixedpoint) (queries:expr list) = + Z3native.fixedpoint_to_string (gc x) x (List.length queries) (Array.of_list queries) - 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 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 } + type optimize = Z3native.optimize + type handle = { opt:optimize; h:int } - - let mk_handle (x : opt) h = { opt = x; h = h } + let mk_handle (x:optimize) h = { opt = x; h = h } - - 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 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 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 + let add (x:optimize) (constraints:expr list) = + let f e = Z3native.optimize_assert (gc x) x e in List.iter f 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 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 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) - + 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 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 - + + 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 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 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) (Array.of_list 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 csn = (List.length sort_names) in let cs = (List.length sorts) in let cdn = (List.length decl_names) in @@ -2930,15 +2031,15 @@ struct if (csn != cs || cdn != cd) then raise (Z3native.Exception "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 ) = + Z3native.parse_smtlib_string ctx str + cs + (Array.of_list sort_names) + (Array.of_list sorts) + cd + (Array.of_list decl_names) + (Array.of_list 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 @@ -2946,43 +2047,59 @@ struct 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) - - 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 + Z3native.parse_smtlib_file ctx file_name + cs + (Array.of_list sort_names) + (Array.of_list sorts) + cd + (Array.of_list decl_names) + (Array.of_list decls) + + let get_num_smtlib_formulas (ctx:context) = Z3native.get_smtlib_num_formulas ctx + + 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_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_num_smtlib_assumptions (ctx:context) = Z3native.get_smtlib_num_assumptions ctx + + 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_decls ( ctx : context ) = Z3native.get_smtlib_num_decls (context_gno 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_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 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_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 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") + else + Z3native.parse_smtlib2_string ctx str + cs + (Array.of_list sort_names) + (Array.of_list sorts) + cd + (Array.of_list decl_names) + (Array.of_list 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 @@ -2990,98 +2107,77 @@ struct if (csn != cs || cdn != cd) then raise (Z3native.Exception "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") - 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 + (Array.of_list sort_names) + (Array.of_list sorts) + cd + (Array.of_list decl_names) + (Array.of_list decls) end - + 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 (ctx:context) (a:expr) = Z3native.mk_interpolant ctx a + + 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 + 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 + let res = 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; + 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 - 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 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 ctx pat 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 + | L_TRUE -> (res, None, Some(model)) + | L_FALSE -> (res, Some(AST.ASTVector.to_expr_list interp), None) + | _ -> (res, None, None) + + let get_interpolation_profile (ctx:context) = Z3native.interpolation_profile ctx + + 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 (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 + | 0 -> raise (Z3native.Exception "Interpolation problem could not be read.") + | _ -> + let f1 i = Array.get cnsts i in + let f2 i = Array.get parents i in + let f3 i = 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 ctx + num + (Array.of_list cnsts) + (Array.of_list parents) + (Array.of_list interps) + num_theory + (Array.of_list 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)) ; + | 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 ctx num (Array.of_list cnsts) (Array.of_list parents) filename num_theory (Array.of_list theory)) ; () end - -let set_global_param ( id : string ) ( value : string ) = + +let set_global_param (id:string) (value:string) = (Z3native.global_param_set id value) -let get_global_param ( id : string ) = +let get_global_param (id:string) = let (r, v) = (Z3native.global_param_get id) in if not r then None @@ -3091,13 +2187,11 @@ let get_global_param ( id : string ) = let global_param_reset_all = Z3native.global_param_reset_all -let toggle_warning_messages ( enabled : bool ) = +let toggle_warning_messages (enabled:bool) = Z3native.toggle_warning_messages enabled -let enable_trace ( tag : string ) = +let enable_trace (tag:string) = (Z3native.enable_trace tag) -let disable_trace ( tag : string ) = +let disable_trace (tag:string) = (Z3native.enable_trace tag) - - diff --git a/src/api/ml/z3.mli b/src/api/ml/z3.mli index e69f7f576..555e25bc0 100644 --- a/src/api/ml/z3.mli +++ b/src/api/ml/z3.mli @@ -244,33 +244,12 @@ 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 @@ -299,9 +278,7 @@ 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 : @@ -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 @@ -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 @@ -1078,7 +1052,6 @@ 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 @@ -3241,8 +3214,7 @@ end module Optimize : sig type optimize - type handle - + type handle (** Create a Optimize context. *) val mk_opt : context -> optimize @@ -3250,31 +3222,25 @@ sig (** 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 @@ -3283,38 +3249,30 @@ sig *) 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 - (** Backtrack one backtracking point. Note that an exception is thrown if Pop is called without a corresponding [Push] {!push} *) val pop : optimize -> unit - (** 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 diff --git a/src/api/ml/z3native.ml.pre b/src/api/ml/z3native.ml.pre new file mode 100644 index 000000000..60afeea84 --- /dev/null +++ b/src/api/ml/z3native.ml.pre @@ -0,0 +1,107 @@ +(** 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 is_null : ptr -> bool + = "n_is_null" + +external mk_null : unit -> ptr + = "n_mk_null" + +external set_internal_error_handler : ptr -> unit + = "n_set_internal_error_handler" + + +external context_of_symbol : symbol -> context + = "n_context_of_symbol" + +external context_of_constructor : constructor -> context + = "n_context_of_constructor" + +external context_of_constructor_list : constructor_list -> context + = "n_context_of_constructor_list" + +external context_of_rcf_num : rcf_num -> context + = "n_context_of_rcf_num" + + +external context_of_ast : ast -> context + = "n_context_of_ast" + +external context_of_params : params -> context + = "n_context_of_params" + +external context_of_param_descrs : param_descrs -> context + = "n_context_of_param_descrs" + +external context_of_model : model -> context + = "n_context_of_model" + +external context_of_func_interp : func_interp -> context + = "n_context_of_func_interp" + +external context_of_func_entry : func_entry -> context + = "n_context_of_func_entry" + +external context_of_goal : goal -> context + = "n_context_of_goal" + +external context_of_tactic : tactic -> context + = "n_context_of_tactic" + +external context_of_probe : probe -> context + = "n_context_of_probe" + +external context_of_apply_result : apply_result -> context + = "n_context_of_apply_result" + +external context_of_solver : solver -> context + = "n_context_of_solver" + +external context_of_stats : stats -> context + = "n_context_of_stats" + +external context_of_ast_vector : ast_vector -> context + = "n_context_of_ast_vector" + +external context_of_ast_map : ast_map -> context + = "n_context_of_ast_map" + +external context_of_fixedpoint : fixedpoint -> context + = "n_context_of_fixedpoint" + +external context_of_optimize : optimize -> context + = "n_context_of_optimize" + +exception Exception of string + diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre new file mode 100644 index 000000000..1f9ea2aff --- /dev/null +++ b/src/api/ml/z3native_stubs.c.pre @@ -0,0 +1,384 @@ +#include +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + +#include +#include +#include +#include +#include + +#ifdef Custom_tag +#include +#include +#endif + +#ifdef __cplusplus +} +#endif + +#include +#include + +#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, +}; + + +#define MK_CTX_OF(X) \ + Z3_context_plus * n_context_of_ ## X(Z3_ ## X ## _plus * p) { return p->cp; } + + +// Context objects + +typedef struct { + Z3_context ctx; + unsigned long ast_count; +} Z3_context_plus; + +Z3_context_plus Z3_context_plus_mk(Z3_context c) { + Z3_context_plus r; + r.ctx = c; + r.ast_count = 0; + printf("ctx++\n"); + return r; +} + +Z3_context Z3_context_plus_raw(Z3_context_plus * cp) { + return cp->ctx; +} + +void Z3_context_finalize(value v) { + Z3_context_plus * cp = (Z3_context_plus*)Data_custom_val(v); + printf("ctx--; cnt=%lu\n", cp->ast_count); + Z3_del_context(cp->ctx); +} + +static struct custom_operations Z3_context_plus_custom_ops = { + (char*) "Z3_context ops", + Z3_context_finalize, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default, +}; + + +// Symbol objects + +typedef struct { + Z3_context_plus * cp; + Z3_symbol s; +} Z3_symbol_plus; + +Z3_symbol_plus Z3_symbol_plus_mk(Z3_context_plus * cp, Z3_symbol s) { + Z3_symbol_plus r; + r.cp = cp; + r.s = s; + return r; +} + +Z3_symbol Z3_symbol_plus_raw(Z3_symbol_plus * sp) { + return sp->s; +} + +static struct custom_operations Z3_symbol_plus_custom_ops = { + (char*) "Z3_symbol ops", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default, +}; + +MK_CTX_OF(symbol) + + +// AST objects + +typedef struct { + Z3_context_plus * cp; + Z3_ast a; +} Z3_ast_plus; + +Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus * cp, Z3_ast a) { + Z3_ast_plus r; + r.cp = cp; + r.a = a; + printf("++\n"); + Z3_inc_ref(cp->ctx, a); + cp->ast_count++; + return r; +} + +Z3_ast Z3_ast_plus_raw(Z3_ast_plus * ap) { + return ap->a; +} + +void Z3_ast_finalize(value v) { + printf("--\n"); + Z3_ast_plus * ap = (Z3_ast_plus*)(Data_custom_val(v)); + Z3_dec_ref(ap->cp->ctx, ap->a); + ap->cp->ast_count--; +} + +int Z3_ast_compare(value v1, value v2) { + Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1); + Z3_ast_plus * a2 = (Z3_ast_plus*)Data_custom_val(v2); + assert(a1->cp->ctx == a2->cp->ctx); + unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->a); + unsigned id2 = Z3_get_ast_id(a2->cp->ctx, a2->a); + if (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 = Z3_get_ast_id(a1->cp->ctx, a1->a); + int id2 = Val_int(v2); + 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); + return Z3_get_ast_hash(ap->cp->ctx, ap->a); +} + +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) + + +// Constructor objects + +typedef struct { + Z3_context_plus * cp; + Z3_constructor c; +} Z3_constructor_plus; + +Z3_constructor_plus Z3_constructor_plus_mk(Z3_context_plus * cp, Z3_constructor c) { + Z3_constructor_plus r; + r.cp = cp; + r.c = c; + return r; +} + +Z3_constructor Z3_constructor_plus_raw(Z3_constructor_plus * cp) { + return cp->c; +} + +static struct custom_operations Z3_constructor_plus_custom_ops = { + (char*) "Z3_constructor ops", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default, +}; + +MK_CTX_OF(constructor) + + +// constructor_list objects + +typedef struct { + Z3_context_plus * cp; + Z3_constructor_list c; +} Z3_constructor_list_plus; + +Z3_constructor_list_plus Z3_constructor_list_plus_mk(Z3_context_plus * cp, Z3_constructor_list c) { + Z3_constructor_list_plus r; + r.cp = cp; + r.c = c; + return r; +} + +Z3_constructor_list Z3_constructor_list_plus_raw(Z3_constructor_list_plus * cp) { + return cp->c; +} + +static struct custom_operations Z3_constructor_list_plus_custom_ops = { + (char*) "Z3_constructor_list ops", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default, +}; + +MK_CTX_OF(constructor_list) + + +// rcf_num objects + +typedef struct { + Z3_context_plus * cp; + Z3_rcf_num c; +} Z3_rcf_num_plus; + +Z3_rcf_num_plus Z3_rcf_num_plus_mk(Z3_context_plus * cp, Z3_rcf_num c) { + Z3_rcf_num_plus r; + r.cp = cp; + r.c = c; + return r; +} + +Z3_rcf_num Z3_rcf_num_plus_raw(Z3_rcf_num_plus * cp) { + return cp->c; +} + +static struct custom_operations Z3_rcf_num_plus_custom_ops = { + (char*) "Z3_rcf_num ops", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default, +}; + +MK_CTX_OF(rcf_num) + + +#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; \ + 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); \ + Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \ + } \ + \ + static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \ + (char*) "Z3_" #X " ops", \ + Z3_ ## X ## _finalize, \ + custom_compare_default, \ + custom_hash_default, \ + custom_serialize_default, \ + custom_deserialize_default, \ + custom_compare_ext_default, \ + }; \ + \ + MK_CTX_OF(X) + +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 + +CAMLprim DLL_PUBLIC value n_is_null(value p) { + void * t = * (void**) Data_custom_val(p); + return Val_bool(t == 0); +} + +CAMLprim DLL_PUBLIC value n_mk_null( void ) { + CAMLparam0(); + CAMLlocal1(result); + void * z3_result = 0; + result = caml_alloc_custom(&default_custom_ops, sizeof(void*), 0, 1); + memcpy( Data_custom_val(result), &z3_result, sizeof(void*)); + CAMLreturn (result); +} + +void MLErrorHandler(Z3_context c, Z3_error_code e) +{ + // Internal do-nothing error handler. This is required to avoid that Z3 calls exit() + // upon errors, but the actual error handling is done by throwing exceptions in the + // wrappers below. +} + +void DLL_PUBLIC n_set_internal_error_handler(value a0) +{ + Z3_context _a0 = * (Z3_context*) Data_custom_val(a0); + Z3_set_error_handler(_a0, MLErrorHandler); +} From b99fcb9c8abd343ca31fea8b2bb24e777e7ddce5 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Sun, 14 Feb 2016 19:56:22 +0000 Subject: [PATCH 02/25] More new OCaml API --- examples/ml/ml_example.ml | 7 ++- scripts/mk_util.py | 25 +++++--- scripts/update_api.py | 88 +++++++++++++------------- src/api/ml/z3.ml | 87 +++++++++++++------------- src/api/ml/z3native.ml.pre | 1 - src/api/ml/z3native_stubs.c.pre | 106 +++++++++++++++++--------------- 6 files changed, 165 insertions(+), 149 deletions(-) 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_util.py b/scripts/mk_util.py index 5df823ae2..4b724705c 100644 --- a/scripts/mk_util.py +++ b/scripts/mk_util.py @@ -1797,6 +1797,12 @@ class MLComponent(Component): 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 @@ -1818,7 +1824,7 @@ class MLComponent(Component): 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)) + (OCAMLCF, OCAML_LIB, api_src, src_dir, stubso, stubsc)) cmos = '' for m in self.modules: @@ -1831,9 +1837,9 @@ class MLComponent(Component): 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' % (OCAMLC, self.sub_dir, ml, mli)) - out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLC, self.sub_dir, cmi, mli)) - out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLC, self.sub_dir, cmo, ml)) + 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 = '' @@ -1841,17 +1847,20 @@ class MLComponent(Component): ff = os.path.join(src_dir, m + '.ml') ft = os.path.join(self.sub_dir, m + '.cmx') out.write('%s: %s %s\n' % (ft, ff, cmos)) - out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLOPT, self.sub_dir, ft, ff)) + out.write('\t%s -I %s -o %s -c %s\n' % (OCAMLOPTF, self.sub_dir, ft, ff)) cmxs = cmxs + ' ' + ft + OCAMLMKLIB = 'ocamlmklib' + if 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 -L. -lz3\n' % (OCAMLMKLIB, z3mls, self.sub_dir, stubso, cmos)) 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 -L. -lz3\n' % (OCAMLMKLIB, z3mls, self.sub_dir, stubso, cmxs)) 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)) diff --git a/scripts/update_api.py b/scripts/update_api.py index b3c7d7072..05489c1d1 100644 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -469,7 +469,7 @@ def mk_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(): @@ -1228,7 +1228,7 @@ def ml_plus_ops_type(ts): if ml_has_plus_type(ts): return ml_plus_type(ts) + '_custom_ops' else: - return 'Z3_default_custom_ops' + return 'default_custom_ops' def ml_has_plus_type(ts): return ts != ml_plus_type(ts) @@ -1268,9 +1268,8 @@ def ml_set_wrap(t, d, n): elif t == STRING: return d + ' = caml_copy_string((const char*) ' + n + ');' else: - ts = type2str(t) - pts = ml_plus_type(ts) - return 'memcpy(Data_custom_val(' + d + '), &' + n + ', sizeof(' + pts + '));' + pts = ml_plus_type(type2str(t)) + return '*(' + pts + '*)Data_custom_val(' + d + ') = ' + n + ';' def mk_z3native_ml(ml_dir): ml_nativef = os.path.join(ml_dir, 'z3native.ml') @@ -1332,13 +1331,8 @@ def mk_z3native_ml(ml_dir): 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))) + ml_native.write(' = ') + ml_native.write('ML2C.n_%s' % (ml_method_name(name))) if len(ip) == 0: ml_native.write(' ()') first = True @@ -1347,16 +1341,6 @@ def mk_z3native_ml(ml_dir): 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() @@ -1427,11 +1411,13 @@ def mk_z3native_stubs_c(ml_dir): # C interface ml_wrapper.write(' unsigned _i;\n') # declare locals, preprocess arrays, strings, in/out arguments + have_context = False i = 0 for param in params: 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: @@ -1468,20 +1454,14 @@ def mk_z3native_stubs_c(ml_dir): # C interface i = i + 1 ml_wrapper.write(' ') - need_closing_paren = False if result != VOID: ts = type2str(result) + ml_wrapper.write('result = caml_alloc(%s, 0);\n' % ret_size) if ml_has_plus_type(ts): - pts = ml_plus_type(ts) - ml_wrapper.write('result = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (ml_plus_ops_type(ts), pts)) - if ts == 'Z3_context': - ml_wrapper.write(' %s z3rv = %s_mk(' % (pts, pts)) - else: - ml_wrapper.write(' %s z3rv = %s_mk(ctx_p, (%s) ' % (pts, pts, ml_minus_type(ts))) - need_closing_paren = True + ml_wrapper.write(' %s z3rv_m = ' % ts) else: - ml_wrapper.write('result = caml_alloc(%s, 0);\n' % ret_size) ml_wrapper.write(' %s z3rv = ' % ts) + elif len(op) != 0: ml_wrapper.write('result = caml_alloc(%s, 0);\n ' % ret_size) @@ -1500,35 +1480,51 @@ def mk_z3native_stubs_c(ml_dir): # C interface else: ml_wrapper.write('_a%i' % i) i = i + 1 - ml_wrapper.write(')') - if need_closing_paren: - ml_wrapper.write(')'); - ml_wrapper.write(';\n') + 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) + ml_wrapper.write(' result = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (ml_plus_ops_type(ts), pts)) + 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: 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++) {\n' % param_array_capacity_pos(p)) - if ml_has_plus_type(ts): - pts = ml_plus_type(ts) - ml_wrapper.write(' value t;\n') - ml_wrapper.write(' t = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (ml_plus_ops_type(ts), pts)) + pts = ml_plus_type(ts) + pops = ml_plus_ops_type(ts) + ml_wrapper.write(' value t;\n') + ml_wrapper.write(' t = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (pops, pts)) + 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_set_wrap(param_type(p), 't', '_a%dp' % i)) + ml_wrapper.write(' %s\n' % ml_set_wrap(pt, 't', '_a%dp' % i)) else: - ml_wrapper.write(' value t;\n') - ml_wrapper.write(' t = caml_alloc_custom(&default_custom_ops, sizeof(%s), 0, 1);\n' % (ts)) - ml_wrapper.write(' %s\n' % ml_set_wrap(param_type(p), 't', '_a%d[_i]' % i)) + ml_wrapper.write(' %s\n' % ml_set_wrap(pt, 't', '_a%d[_i]' % i)) ml_wrapper.write(' Store_field(_a%s_val, _i, t);\n' % i) ml_wrapper.write(' }\n') elif param_kind(p) == OUT_MANAGED_ARRAY: - ml_wrapper.write(' %s\n' % ml_set_wrap(param_type(p), '_a%d_val' % i, '_a%d' % 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): - pt = param_type(p) - ts = type2str(pt) 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)) diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml index 92155380c..b9af37faa 100644 --- a/src/api/ml/z3.ml +++ b/src/api/ml/z3.ml @@ -7,7 +7,8 @@ open Z3enums -exception Error = Z3native.Exception +exception Error of string +let _ = Callback.register_exception "Z3EXCEPTION" (Error "") (* Some helpers. *) let null = Z3native.mk_null() @@ -90,7 +91,7 @@ end module rec AST : sig type ast = Z3native.ast - val gc:ast -> context + val gc : ast -> context module ASTVector : sig type ast_vector = Z3native.ast_vector @@ -225,7 +226,7 @@ end and Sort : sig - type sort = Z3native.sort + type sort = AST.ast val gc : sort -> context val equal : sort -> sort -> bool val get_id : sort -> int @@ -296,7 +297,7 @@ val gc : func_decl -> context val get_parameters : func_decl -> Parameter.parameter list val apply : func_decl -> Expr.expr list -> Expr.expr end = struct - type func_decl = Z3native.func_decl + type func_decl = AST.ast let gc (x:func_decl) = Z3native.context_of_ast x module Parameter = @@ -323,37 +324,37 @@ end = struct let get_int (x:parameter) = match x with | P_Int(x) -> x - | _ -> raise (Z3native.Exception "parameter is not an int") + | _ -> raise (Error "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") + | _ -> raise (Error "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") + | _ -> raise (Error "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") + | _ -> raise (Error "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") + | _ -> raise (Error "parameter is not an ast") let get_func_decl (x:parameter) = match x with | P_Fdl(x) -> x - | _ -> raise (Z3native.Exception "parameter is not a func_decl") + | _ -> raise (Error "parameter is not a func_decl") let get_rational (x:parameter) = match x with | P_Rat(x) -> x - | _ -> raise (Z3native.Exception "parameter is not a rational string") + | _ -> 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) = @@ -469,7 +470,7 @@ end (** General expressions (terms) *) and Expr : sig - type expr = Z3native.ast + type expr = AST.ast val gc : expr -> context val ast_of_expr : expr -> AST.ast val expr_of_ast : AST.ast -> expr @@ -504,13 +505,13 @@ sig 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 = Z3native.ast + type expr = AST.ast let gc (e:expr) = Z3native.context_of_ast e let expr_of_ast (a:AST.ast) : expr = 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 (Z3native.Exception "Invalid coercion") + raise (Error "Invalid coercion") else a @@ -540,13 +541,13 @@ end = struct let update (x:expr) (args:expr list) = if ((AST.is_app x) && (List.length args <> (get_num_args x))) then - raise (Z3native.Exception "Number of arguments does not match") + raise (Error "Number of arguments does not match") else Z3native.update_term (gc x) x (List.length args) (Array.of_list args) let substitute (x:expr) (from:expr list) (to_:expr list) = if (List.length from) <> (List.length to_) then - raise (Z3native.Exception "Argument sizes do not match") + raise (Error "Argument sizes do not match") else Z3native.substitute (gc x) x (List.length from) (Array.of_list from) (Array.of_list to_) @@ -620,7 +621,7 @@ end module Quantifier = struct - type quantifier = Z3native.ast + type quantifier = AST.ast let gc (x:quantifier) = Z3native.context_of_ast x let expr_of_quantifier (q:quantifier) : Expr.expr = q @@ -628,7 +629,7 @@ struct let quantifier_of_expr (e:Expr.expr) : quantifier = let q = (Z3enums.ast_kind_of_int (Z3native.get_ast_kind (gc e) e)) in if (q != Z3enums.QUANTIFIER_AST) then - raise (Z3native.Exception "Invalid coercion") + raise (Error "Invalid coercion") else e @@ -650,7 +651,7 @@ struct let get_index (x:expr) = if not (AST.is_var x) then - raise (Z3native.Exception "Term is not a bound variable.") + raise (Error "Term is not a bound variable.") else Z3native.get_index_value (gc x) x @@ -687,13 +688,13 @@ struct let mk_pattern (ctx:context) (terms:expr list) = if (List.length terms) == 0 then - raise (Z3native.Exception "Cannot create a pattern from zero terms") + raise (Error "Cannot create a pattern from zero terms") else Z3native.mk_pattern ctx (List.length terms) (Array.of_list 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") + raise (Error "Number of sorts does not match number of names") else if ((List.length nopatterns) == 0 && quantifier_id == None && skolem_id == None) then Z3native.mk_quantifier ctx true (match weight with | None -> 1 | Some(x) -> x) @@ -731,7 +732,7 @@ struct 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") + raise (Error "Number of sorts does not match number of names") else if ((List.length nopatterns) == 0 && quantifier_id == None && skolem_id == None) then Z3native.mk_quantifier ctx false (match weight with | None -> 1 | Some(x) -> x) @@ -856,7 +857,7 @@ struct let get_size (x:Sort.sort) = let (r, v) = (Z3native.get_finite_domain_sort_size (Sort.gc x) x) in if r then v - else raise (Z3native.Exception "Conversion failed.") + else raise (Error "Conversion failed.") end @@ -907,10 +908,10 @@ struct 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") + 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") + raise (Error "Number of field names does not match number of sort refs") else let no = Z3native.mk_constructor ctx name recognizer @@ -1098,14 +1099,14 @@ struct let get_int (x:expr) = let (r, v) = Z3native.get_numeral_int (Expr.gc x) x in if r then v - else raise (Z3native.Exception "Conversion failed.") + else raise (Error "Conversion failed.") 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 (Z3native.Exception "Conversion failed.") + 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) = Expr.mk_const ctx name (mk_sort ctx) @@ -1129,7 +1130,7 @@ struct let s = (Z3native.get_numeral_string (Expr.gc x) x) in Ratio.ratio_of_string s else - raise (Z3native.Exception "Conversion failed.") + raise (Error "Conversion failed.") 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 @@ -1137,7 +1138,7 @@ struct 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") + raise (Error "Denominator is zero") else Z3native.mk_real ctx num den @@ -1228,7 +1229,7 @@ struct let get_int (x:expr) = let (r, v) = Z3native.get_numeral_int (Expr.gc x) x in if r then v - else raise (Z3native.Exception "Conversion failed.") + else 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) @@ -1490,7 +1491,7 @@ struct 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 (Z3native.Exception "No subgoals") + raise (Error "No subgoals") else Z3native.apply_result_get_subgoal (gc x) arn 0 in Z3native.apply_result_dec_ref (gc x) arn ; @@ -1570,7 +1571,7 @@ struct 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 (Z3native.Exception "Non-zero arity functions and arrays have FunctionInterpretations as a model. Use FuncInterp.") + raise (Error "Non-zero arity functions and arrays have FunctionInterpretations as a model. Use FuncInterp.") else let np = Z3native.model_get_const_interp (gc x) x f in if (Z3native.is_null np) then @@ -1591,11 +1592,11 @@ struct match sk with | ARRAY_SORT -> if not (Z3native.is_as_array (gc x) n) then - raise (Z3native.Exception "Argument was not an array constant") + 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 (Z3native.Exception "Constant functions do not have a function interpretation; use ConstInterp"); + | _ -> raise (Error "Constant functions do not have a function interpretation; use ConstInterp"); else let n = Z3native.model_get_func_interp (gc x) x f in if (Z3native.is_null n) then None else Some n @@ -1780,7 +1781,7 @@ struct else if (is_float x) then string_of_float (get_float x) else - raise (Z3native.Exception "Unknown statistical entry type") + raise (Error "Unknown statistical entry type") let to_string (x:statistics_entry) = (get_key x) ^ ": " ^ (to_string_value x) end @@ -1833,7 +1834,7 @@ struct 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") + raise (Error "Argument size mismatch") else let f a b = Z3native.solver_assert_and_track (gc x) x a b in ignore (List.iter2 f cs ps) @@ -2029,7 +2030,7 @@ struct 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") + raise (Error "Argument size mismatch") else Z3native.parse_smtlib_string ctx str cs @@ -2045,7 +2046,7 @@ struct 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") + raise (Error "Argument size mismatch") else Z3native.parse_smtlib_file ctx file_name cs @@ -2089,7 +2090,7 @@ struct 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") + raise (Error "Argument size mismatch") else Z3native.parse_smtlib2_string ctx str cs @@ -2105,7 +2106,7 @@ struct 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") + raise (Error "Argument size mismatch") else Z3native.parse_smtlib2_string ctx file_name cs @@ -2147,7 +2148,7 @@ struct 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 (Z3native.Exception "Interpolation problem could not be read.") + | 0 -> raise (Error "Interpolation problem could not be read.") | _ -> let f1 i = Array.get cnsts i in let f2 i = Array.get parents i in @@ -2165,8 +2166,8 @@ struct num_theory (Array.of_list 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.") + | 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) = diff --git a/src/api/ml/z3native.ml.pre b/src/api/ml/z3native.ml.pre index 60afeea84..28c6c7d91 100644 --- a/src/api/ml/z3native.ml.pre +++ b/src/api/ml/z3native.ml.pre @@ -103,5 +103,4 @@ external context_of_fixedpoint : fixedpoint -> context external context_of_optimize : optimize -> context = "n_context_of_optimize" -exception Exception of string diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index 1f9ea2aff..6755e9be9 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -42,14 +42,14 @@ extern "C" { 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); \ + 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); \ +#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) @@ -64,8 +64,15 @@ static struct custom_operations default_custom_ops = { }; -#define MK_CTX_OF(X) \ - Z3_context_plus * n_context_of_ ## X(Z3_ ## X ## _plus * p) { return p->cp; } +#define MK_CTX_OF(X) \ + CAMLprim DLL_PUBLIC value n_context_of_ ## X(value v) { \ + CAMLparam1(v); \ + CAMLlocal1(result); \ + Z3_ ## X ## _plus * p = (Z3_ ## X ## _plus *) Data_custom_val(v); \ + result = caml_alloc(sizeof(Z3_context_plus), 0); \ + *(Z3_context_plus*)Data_custom_val(result) = *p->cp; \ + CAMLreturn(result); \ + } // Context objects @@ -90,7 +97,10 @@ Z3_context Z3_context_plus_raw(Z3_context_plus * cp) { void Z3_context_finalize(value v) { Z3_context_plus * cp = (Z3_context_plus*)Data_custom_val(v); printf("ctx--; cnt=%lu\n", cp->ast_count); - Z3_del_context(cp->ctx); + if (cp->ast_count == 0) + Z3_del_context(cp->ctx); + else + printf("Leaking the context; context_plus pointers now invalid. \n"); } static struct custom_operations Z3_context_plus_custom_ops = { @@ -112,7 +122,7 @@ typedef struct { } Z3_symbol_plus; Z3_symbol_plus Z3_symbol_plus_mk(Z3_context_plus * cp, Z3_symbol s) { - Z3_symbol_plus r; + Z3_symbol_plus r; r.cp = cp; r.s = s; return r; @@ -145,7 +155,7 @@ typedef struct { Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus * cp, Z3_ast a) { Z3_ast_plus r; r.cp = cp; - r.a = a; + r.a = a; printf("++\n"); Z3_inc_ref(cp->ctx, a); cp->ast_count++; @@ -207,6 +217,7 @@ static struct custom_operations Z3_ast_plus_custom_ops = { MK_CTX_OF(ast) + // Constructor objects typedef struct { @@ -300,39 +311,39 @@ static struct custom_operations Z3_rcf_num_plus_custom_ops = { MK_CTX_OF(rcf_num) -#define MK_PLUS_OBJ(X) \ - typedef struct { \ - Z3_context_plus * cp; \ - Z3_ ## X p; \ - } Z3_ ## X ## _plus; \ - \ +#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; \ - 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); \ - Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \ - } \ - \ - static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \ - (char*) "Z3_" #X " ops", \ - Z3_ ## X ## _finalize, \ - custom_compare_default, \ - custom_hash_default, \ - custom_serialize_default, \ - custom_deserialize_default, \ - custom_compare_ext_default, \ - }; \ - \ + Z3_ ## X ## _plus r; \ + r.cp = cp; \ + r.p = p; \ + 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); \ + Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \ + } \ + \ + static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \ + (char*) "Z3_" #X " ops", \ + Z3_ ## X ## _finalize, \ + custom_compare_default, \ + custom_hash_default, \ + custom_serialize_default, \ + custom_deserialize_default, \ + custom_compare_ext_default, \ + }; \ + \ MK_CTX_OF(X) MK_PLUS_OBJ(params) @@ -363,10 +374,9 @@ CAMLprim DLL_PUBLIC value n_is_null(value p) { CAMLprim DLL_PUBLIC value n_mk_null( void ) { CAMLparam0(); - CAMLlocal1(result); - void * z3_result = 0; - result = caml_alloc_custom(&default_custom_ops, sizeof(void*), 0, 1); - memcpy( Data_custom_val(result), &z3_result, sizeof(void*)); + CAMLlocal1(result); + result = caml_alloc(1, 0); + result = Val_int(0); CAMLreturn (result); } From 18c0a3bfafc3ed9746572ab81f190b5e39a40442 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Sun, 14 Feb 2016 19:57:21 +0000 Subject: [PATCH 03/25] removed comments --- scripts/mk_make.py | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/scripts/mk_make.py b/scripts/mk_make.py index 0e2409b0f..8cd9f3a7d 100644 --- a/scripts/mk_make.py +++ b/scripts/mk_make.py @@ -13,9 +13,9 @@ parse_options() check_eol() API_files = init_project_def() -#update_version() -#mk_auto_src() +update_version() +mk_auto_src() mk_bindings(API_files) -#mk_vs_proj('z3', ['shell']) -#mk_vs_proj_dll('libz3', ['api_dll']) -#mk_makefile() +mk_vs_proj('z3', ['shell']) +mk_vs_proj_dll('libz3', ['api_dll']) +mk_makefile() From 62cae4186b270508501db852f11bf8e14a6453a6 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 15 Feb 2016 12:54:05 +0000 Subject: [PATCH 04/25] ML API bug fixes --- scripts/update_api.py | 6 +++--- src/api/ml/z3native_stubs.c.pre | 22 ++++++++++++---------- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index 05489c1d1..776acce8b 100644 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -1456,11 +1456,11 @@ def mk_z3native_stubs_c(ml_dir): # C interface ml_wrapper.write(' ') if result != VOID: ts = type2str(result) - ml_wrapper.write('result = caml_alloc(%s, 0);\n' % ret_size) if ml_has_plus_type(ts): - ml_wrapper.write(' %s z3rv_m = ' % ts) + ml_wrapper.write('%s z3rv_m = ' % ts) else: - ml_wrapper.write(' %s z3rv = ' % ts) + ml_wrapper.write('result = caml_alloc(%s, 0);\n ' % ret_size) + ml_wrapper.write('%s z3rv = ' % ts) elif len(op) != 0: ml_wrapper.write('result = caml_alloc(%s, 0);\n ' % ret_size) diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index 6755e9be9..be330fc0a 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -79,14 +79,14 @@ static struct custom_operations default_custom_ops = { typedef struct { Z3_context ctx; - unsigned long ast_count; + unsigned long obj_count; } Z3_context_plus; Z3_context_plus Z3_context_plus_mk(Z3_context c) { Z3_context_plus r; r.ctx = c; - r.ast_count = 0; - printf("ctx++\n"); + r.obj_count = 0; + //printf("ctx++\n"); return r; } @@ -96,8 +96,8 @@ Z3_context Z3_context_plus_raw(Z3_context_plus * cp) { void Z3_context_finalize(value v) { Z3_context_plus * cp = (Z3_context_plus*)Data_custom_val(v); - printf("ctx--; cnt=%lu\n", cp->ast_count); - if (cp->ast_count == 0) + // printf("ctx--; cnt=%lu\n", cp->obj_count); + if (cp->obj_count == 0) Z3_del_context(cp->ctx); else printf("Leaking the context; context_plus pointers now invalid. \n"); @@ -122,7 +122,7 @@ typedef struct { } Z3_symbol_plus; Z3_symbol_plus Z3_symbol_plus_mk(Z3_context_plus * cp, Z3_symbol s) { - Z3_symbol_plus r; + Z3_symbol_plus r; r.cp = cp; r.s = s; return r; @@ -156,9 +156,9 @@ Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus * cp, Z3_ast a) { Z3_ast_plus r; r.cp = cp; r.a = a; - printf("++\n"); + //printf("++\n"); + cp->obj_count++; Z3_inc_ref(cp->ctx, a); - cp->ast_count++; return r; } @@ -167,10 +167,10 @@ Z3_ast Z3_ast_plus_raw(Z3_ast_plus * ap) { } void Z3_ast_finalize(value v) { - printf("--\n"); + //printf("--\n"); Z3_ast_plus * ap = (Z3_ast_plus*)(Data_custom_val(v)); Z3_dec_ref(ap->cp->ctx, ap->a); - ap->cp->ast_count--; + ap->cp->obj_count--; } int Z3_ast_compare(value v1, value v2) { @@ -321,6 +321,7 @@ MK_CTX_OF(rcf_num) Z3_ ## X ## _plus r; \ r.cp = cp; \ r.p = p; \ + r.cp->obj_count++; \ Z3_ ## X ## _inc_ref(cp->ctx, p); \ return r; \ } \ @@ -332,6 +333,7 @@ MK_CTX_OF(rcf_num) void Z3_ ## X ## _finalize(value v) { \ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \ Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \ + pp->cp->obj_count--; \ } \ \ static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \ From 0dc85620aa8fb7319bab36b1d55db8f7a27cfbe1 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 15 Feb 2016 13:01:00 +0000 Subject: [PATCH 05/25] ML API bug fix --- src/api/ml/z3native_stubs.c.pre | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index be330fc0a..1ba32efe4 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -69,7 +69,7 @@ static struct custom_operations default_custom_ops = { CAMLparam1(v); \ CAMLlocal1(result); \ Z3_ ## X ## _plus * p = (Z3_ ## X ## _plus *) Data_custom_val(v); \ - result = caml_alloc(sizeof(Z3_context_plus), 0); \ + result = caml_alloc_custom(&Z3_context_plus_custom_ops, sizeof(Z3_context_plus), 0, 1); \ *(Z3_context_plus*)Data_custom_val(result) = *p->cp; \ CAMLreturn(result); \ } From 0254b1f7fff678c31f7083aae313e00d72d933ad Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 15 Feb 2016 13:28:22 +0000 Subject: [PATCH 06/25] ML API bug fixes --- src/api/ml/z3native_stubs.c.pre | 205 +++++++++++--------------------- 1 file changed, 69 insertions(+), 136 deletions(-) diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index 1ba32efe4..e4ed85373 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -75,18 +75,20 @@ static struct custom_operations default_custom_ops = { } -// Context objects +/* Context objects */ typedef struct { Z3_context ctx; - unsigned long obj_count; + unsigned long obj_count:sizeof(unsigned long)-1; + unsigned ok_to_delete:1; } Z3_context_plus; Z3_context_plus Z3_context_plus_mk(Z3_context c) { Z3_context_plus r; r.ctx = c; r.obj_count = 0; - //printf("ctx++\n"); + r.ok_to_delete = 0; + /* printf("ctx++ %p\n", c); */ return r; } @@ -94,13 +96,23 @@ Z3_context Z3_context_plus_raw(Z3_context_plus * cp) { return cp->ctx; } +void try_to_delete_context(Z3_context_plus * cp) { + if (!cp->ok_to_delete || cp->obj_count != 0) + /* printf("Trying to delete context %p.\n", cp->ctx) */ ; + else { + /* printf("Actually deleting context %p.\n", cp->ctx); */ + Z3_del_context(cp->ctx); + cp->ctx = 0; + cp->obj_count = 0; + cp->ok_to_delete = 0; + } +} + void Z3_context_finalize(value v) { Z3_context_plus * cp = (Z3_context_plus*)Data_custom_val(v); - // printf("ctx--; cnt=%lu\n", cp->obj_count); - if (cp->obj_count == 0) - Z3_del_context(cp->ctx); - else - printf("Leaking the context; context_plus pointers now invalid. \n"); + /* printf("ctx--; cnt=%lu\n", cp->obj_count); */ + cp->ok_to_delete = 1; + try_to_delete_context(cp); } static struct custom_operations Z3_context_plus_custom_ops = { @@ -114,38 +126,7 @@ static struct custom_operations Z3_context_plus_custom_ops = { }; -// Symbol objects - -typedef struct { - Z3_context_plus * cp; - Z3_symbol s; -} Z3_symbol_plus; - -Z3_symbol_plus Z3_symbol_plus_mk(Z3_context_plus * cp, Z3_symbol s) { - Z3_symbol_plus r; - r.cp = cp; - r.s = s; - return r; -} - -Z3_symbol Z3_symbol_plus_raw(Z3_symbol_plus * sp) { - return sp->s; -} - -static struct custom_operations Z3_symbol_plus_custom_ops = { - (char*) "Z3_symbol ops", - custom_finalize_default, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default, - custom_compare_ext_default, -}; - -MK_CTX_OF(symbol) - - -// AST objects +/* AST objects */ typedef struct { Z3_context_plus * cp; @@ -156,7 +137,7 @@ Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus * cp, Z3_ast a) { Z3_ast_plus r; r.cp = cp; r.a = a; - //printf("++\n"); + /* printf("++\n"); */ cp->obj_count++; Z3_inc_ref(cp->ctx, a); return r; @@ -167,10 +148,11 @@ Z3_ast Z3_ast_plus_raw(Z3_ast_plus * ap) { } void Z3_ast_finalize(value v) { - //printf("--\n"); + /* printf("--\n"); */ Z3_ast_plus * ap = (Z3_ast_plus*)(Data_custom_val(v)); Z3_dec_ref(ap->cp->ctx, ap->a); ap->cp->obj_count--; + try_to_delete_context(ap->cp); } int Z3_ast_compare(value v1, value v2) { @@ -218,98 +200,42 @@ MK_CTX_OF(ast) -// Constructor objects - -typedef struct { - Z3_context_plus * cp; - Z3_constructor c; -} Z3_constructor_plus; - -Z3_constructor_plus Z3_constructor_plus_mk(Z3_context_plus * cp, Z3_constructor c) { - Z3_constructor_plus r; - r.cp = cp; - r.c = c; - return r; -} - -Z3_constructor Z3_constructor_plus_raw(Z3_constructor_plus * cp) { - return cp->c; -} - -static struct custom_operations Z3_constructor_plus_custom_ops = { - (char*) "Z3_constructor ops", - custom_finalize_default, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default, - custom_compare_ext_default, -}; - -MK_CTX_OF(constructor) - - -// constructor_list objects - -typedef struct { - Z3_context_plus * cp; - Z3_constructor_list c; -} Z3_constructor_list_plus; - -Z3_constructor_list_plus Z3_constructor_list_plus_mk(Z3_context_plus * cp, Z3_constructor_list c) { - Z3_constructor_list_plus r; - r.cp = cp; - r.c = c; - return r; -} - -Z3_constructor_list Z3_constructor_list_plus_raw(Z3_constructor_list_plus * cp) { - return cp->c; -} - -static struct custom_operations Z3_constructor_list_plus_custom_ops = { - (char*) "Z3_constructor_list ops", - custom_finalize_default, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default, - custom_compare_ext_default, -}; - -MK_CTX_OF(constructor_list) - - -// rcf_num objects - -typedef struct { - Z3_context_plus * cp; - Z3_rcf_num c; -} Z3_rcf_num_plus; - -Z3_rcf_num_plus Z3_rcf_num_plus_mk(Z3_context_plus * cp, Z3_rcf_num c) { - Z3_rcf_num_plus r; - r.cp = cp; - r.c = c; - return r; -} - -Z3_rcf_num Z3_rcf_num_plus_raw(Z3_rcf_num_plus * cp) { - return cp->c; -} - -static struct custom_operations Z3_rcf_num_plus_custom_ops = { - (char*) "Z3_rcf_num ops", - custom_finalize_default, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default, - custom_compare_ext_default, -}; - -MK_CTX_OF(rcf_num) +#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); \ + } \ + \ + static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \ + (char*) "Z3_" #X " ops", \ + Z3_ ## X ## _finalize, \ + custom_compare_default, \ + custom_hash_default, \ + custom_serialize_default, \ + custom_deserialize_default, \ + custom_compare_ext_default, \ + }; \ + \ + MK_CTX_OF(X) #define MK_PLUS_OBJ(X) \ typedef struct { \ @@ -334,6 +260,7 @@ MK_CTX_OF(rcf_num) Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \ Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \ pp->cp->obj_count--; \ + try_to_delete_context(pp->cp); \ } \ \ static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \ @@ -348,6 +275,12 @@ MK_CTX_OF(rcf_num) \ 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) @@ -384,9 +317,9 @@ CAMLprim DLL_PUBLIC value n_mk_null( void ) { 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 - // wrappers below. + /* 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. */ } void DLL_PUBLIC n_set_internal_error_handler(value a0) From 0930cfc53f76ac54637f88c16e4520ada361f428 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 15 Feb 2016 15:44:46 +0000 Subject: [PATCH 07/25] ML API build fixes for cygwin --- scripts/mk_util.py | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/scripts/mk_util.py b/scripts/mk_util.py index 4b724705c..723f1cef1 100644 --- a/scripts/mk_util.py +++ b/scripts/mk_util.py @@ -67,6 +67,7 @@ IS_LINUX=False IS_OSX=False IS_FREEBSD=False IS_OPENBSD=False +IS_CYGWIN=False VERBOSE=True DEBUG_MODE=False SHOW_CPPS = True @@ -134,6 +135,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('/'))) @@ -583,6 +587,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") @@ -1676,6 +1682,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) @@ -1852,13 +1860,17 @@ class MLComponent(Component): OCAMLMKLIB = 'ocamlmklib' - if DEBUG_MODE: + 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('\t%s -o %s -I %s %s %s -L. -lz3\n' % (OCAMLMKLIB, 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('\t%s -o %s -I %s %s %s -L. -lz3\n' % (OCAMLMKLIB, 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' % (OCAMLOPTF, z3mls, self.sub_dir, z3mls)) From 61525b9f5e3f8c80029ddf744cfc5f2a113c56d7 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Fri, 4 Mar 2016 17:07:20 +0000 Subject: [PATCH 08/25] style --- src/api/ml/z3.ml | 246 ++++++++++++++++++++++------------------------- 1 file changed, 116 insertions(+), 130 deletions(-) diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml index b9af37faa..a5beac6ec 100644 --- a/src/api/ml/z3.ml +++ b/src/api/ml/z3.ml @@ -40,7 +40,7 @@ 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 = + let rec mk_list' (f:int -> 'a) (i:int) (n:int) (tail:'a list):'a list = if (i >= n) then tail else @@ -69,8 +69,8 @@ struct 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 (gc o) o) - let get_string (o:symbol ) = (Z3native.get_symbol_string (gc o) o) - let to_string (o:symbol ) = + let get_string (o:symbol) = (Z3native.get_symbol_string (gc o) o) + let to_string (o:symbol) = 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) @@ -79,12 +79,10 @@ struct let mk_string (ctx:context) (s:string) = (Z3native.mk_string_symbol ctx s) let mk_ints (ctx:context) (names:int list) = - let f elem = mk_int (ctx:context ) elem in - (List.map f names) + List.map (fun x -> mk_int ctx x) names let mk_strings (ctx:context) (names:string list) = - let f elem = mk_string (ctx:context) elem in - (List.map f names) + List.map (fun x -> mk_string ctx x) names end @@ -148,19 +146,19 @@ end = struct 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 translate (x:ast_vector) (to_ctx:context) = Z3native.ast_vector_translate (gc x) x to_ctx - let to_list (x:ast_vector ) = + 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 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 (gc x) x + let to_string (x:ast_vector) = Z3native.ast_vector_to_string (gc x) x end module ASTMap = @@ -205,7 +203,7 @@ end = struct let to_sexpr (x:ast) = Z3native.ast_to_string (gc x) x - let equal (a:ast) (b:ast) = + let equal (a:ast) (b:ast) = (a == b) || (if (gc a) != (gc b) then false @@ -217,7 +215,7 @@ end = struct if (get_id a) > (get_id b) then 1 else 0 - let translate (x:ast) (to_ctx:context ) = + let translate (x:ast) (to_ctx:context) = if (gc x) == to_ctx then x else @@ -311,7 +309,7 @@ end = struct | P_Fdl of func_decl | P_Rat of string - let get_kind (x:parameter ) = + let get_kind (x:parameter) = (match x with | P_Int(_) -> PARAMETER_INT | P_Dbl(_) -> PARAMETER_DOUBLE @@ -375,7 +373,7 @@ end = struct let mk_fresh_const_decl (ctx:context) (prefix:string) (range:Sort.sort) = Z3native.mk_fresh_func_decl ctx prefix 0 [||] range - let equal (a:func_decl ) (b:func_decl ) = + let equal (a:func_decl) (b:func_decl) = (a == b) || (if (gc a) != (gc b) then false @@ -406,8 +404,7 @@ end = struct | 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 + | 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 @@ -898,10 +895,10 @@ struct 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) + type t = AST.ast + let equal x y = AST.compare x y = 0 + let hash = AST.hash + end) let _field_nums = FieldNumTable.create 0 @@ -925,7 +922,7 @@ struct let get_num_fields (x:constructor) = FieldNumTable.find _field_nums x - let get_constructor_decl (x:constructor ) = + let get_constructor_decl (x:constructor) = let (a, _, _) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in a @@ -937,7 +934,6 @@ struct let (_, _, c) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in let f i = Array.get c i in mk_list f (Array.length c) - end module ConstructorList = @@ -970,12 +966,7 @@ struct 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 + mk_sorts ctx (List.map (fun x -> Symbol.mk_string ctx x) names) c let get_num_constructors (x:Sort.sort) = Z3native.get_datatype_sort_num_constructors (Sort.gc x) x @@ -995,8 +986,7 @@ struct 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 g ds) in mk_list f n end @@ -1318,7 +1308,7 @@ struct let mk_inf (ctx:context) (s:Sort.sort) (negative:bool) = Z3native.mk_fpa_inf ctx s negative let mk_zero (ctx:context) (s:Sort.sort) (negative:bool) = Z3native.mk_fpa_zero ctx s negative 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) = Z3native.mk_fpa_numeral_double ctx value s + let mk_numeral_f (ctx:context) (value:float) (s:Sort.sort) = Z3native.mk_fpa_numeral_double ctx value s let mk_numeral_i (ctx:context) (value:int) (s:Sort.sort) = Z3native.mk_fpa_numeral_int ctx value s let mk_numeral_i_u (ctx:context) (sign:bool) (exponent:int) (significand:int) (s:Sort.sort) = Z3native.mk_fpa_numeral_int64_uint64 ctx sign exponent significand s let mk_numeral_s (ctx:context) (v:string) (s:Sort.sort) = Z3native.mk_numeral ctx v s @@ -1518,25 +1508,25 @@ module Model = struct type model = Z3native.model let gc (x:model) = Z3native.context_of_model x - + module FuncInterp = struct type func_interp = Z3native.func_interp let gc (x:func_interp) = Z3native.context_of_func_interp x - + module FuncEntry = - struct + struct type func_entry = Z3native.func_entry let gc (x:func_entry) = Z3native.context_of_func_entry 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_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 @@ -1554,20 +1544,19 @@ struct 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.gc f) (Z3native.get_range (FuncDecl.gc f) f))) == ARRAY_SORT then @@ -1578,19 +1567,18 @@ struct None else 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 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 + let n = Z3native.model_get_const_interp (gc x) x f in if (Z3native.is_null n) then - None - else + None + else match sk with - | ARRAY_SORT -> + | ARRAY_SORT -> if not (Z3native.is_as_array (gc x) n) then raise (Error "Argument was not an array constant") else @@ -1600,36 +1588,36 @@ struct else let n = Z3native.model_get_func_interp (gc x) x f in if (Z3native.is_null 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 (gc x) 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 = 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 (gc x) 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 = Z3native.model_get_func_decl (gc x) x i in mk_list f n - - let get_decls (x:model ) = + + let get_decls (x:model) = let n_funcs = (get_num_funcs x) in - let n_consts = (get_num_consts 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 eval (x:model) (t:expr) (completion:bool) = let (r, v) = Z3native.model_eval (gc x) x t completion in if not r then None else Some v - let evaluate (x:model) (t:expr) (completion:bool) = eval x t completion + let evaluate (x:model) (t:expr) (completion:bool) = eval x t completion 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 @@ -1639,7 +1627,7 @@ struct 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 (gc x) x + let to_string (x:model) = Z3native.model_to_string (gc x) x end @@ -1647,10 +1635,10 @@ module Probe = struct type probe = Z3native.probe - let apply (x:probe ) (g:Goal.goal) = Z3native.probe_apply (gc x) x g + let apply (x:probe) (g:Goal.goal) = Z3native.probe_apply (gc x) x g let get_num_probes (ctx:context) = Z3native.get_num_probes ctx - let get_probe_names (ctx:context) = + 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 @@ -1664,40 +1652,40 @@ struct let ge (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_ge ctx p1 p2 let eq (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_eq ctx p1 p2 let and_ (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_and ctx p1 p2 - let or_ (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_or ctx p1 p2 - let not_ (ctx:context) (p:probe ) = Z3native.probe_not ctx p + let or_ (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_or ctx p1 p2 + let not_ (ctx:context) (p:probe) = Z3native.probe_not ctx p end module Tactic = -struct +struct type tactic = Z3native.tactic let gc (x:tactic) = Z3native.context_of_tactic x - + module ApplyResult = - struct + struct type apply_result = Z3native.apply_result let gc (x:apply_result) = Z3native.context_of_apply_result x let get_num_subgoals (x:apply_result) = Z3native.apply_result_get_num_subgoals (gc x) x - - let get_subgoals (x:apply_result ) = + + 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) = Z3native.apply_result_get_subgoal (gc x) x i + + 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 (gc x) x let get_param_descrs (x:tactic) = Z3native.tactic_get_param_descrs (gc x) x - + 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 + 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 ctx @@ -1708,16 +1696,16 @@ struct let get_tactic_description (ctx:context) (name:string) = Z3native.tactic_get_descr ctx name let mk_tactic (ctx:context) (name:string) = Z3native.mk_tactic ctx name - + 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 + | Some(x) -> Some (Z3native.tactic_and_then ctx c x)) in match (List.fold_left f None ts) with | 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) = Z3native.tactic_or_else ctx t1 t2 let try_for (ctx:context) (t:tactic) (ms:int) = Z3native.tactic_try_for ctx t ms let when_ (ctx:context) (p:Probe.probe) (t:tactic) = Z3native.tactic_when ctx p t @@ -1736,39 +1724,38 @@ end module Statistics = -struct +struct type statistics = Z3native.stats let gc (x:statistics) = Z3native.context_of_stats x 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 = { + 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 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 res:statistics_entry = { + m_key = k ; + m_is_int = false ; + m_is_float = true ; + m_int = 0 ; + m_float = v + } in + res let get_key (x:statistics_entry) = x.m_key let get_int (x:statistics_entry) = x.m_int @@ -1784,26 +1771,26 @@ struct 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 (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 + 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 (gc x) x i in mk_list f n - - let get (x:statistics) (key:string ) = + + 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) end @@ -1855,8 +1842,7 @@ struct if ((List.length assumptions) == 0) then lbool_of_int (Z3native.solver_check (gc x) x) else - let f x = x in - lbool_of_int (Z3native.solver_check_assumptions (gc x) x (List.length assumptions) (Array.of_list (List.map f assumptions))) + lbool_of_int (Z3native.solver_check_assumptions (gc x) x (List.length assumptions) (Array.of_list assumptions)) in match r with | L_TRUE -> SATISFIABLE @@ -1964,11 +1950,11 @@ struct let mk_fixedpoint (ctx:context) = Z3native.mk_fixedpoint ctx let get_statistics (x:fixedpoint) = Z3native.fixedpoint_get_statistics (gc x) x - let parse_string (x:fixedpoint) (s:string ) = + 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 parse_file (x:fixedpoint) (filename:string ) = + 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 @@ -2121,7 +2107,7 @@ module Interpolation = struct let mk_interpolant (ctx:context) (a:expr) = Z3native.mk_interpolant ctx a - let mk_interpolation_context (settings:(string * string ) list) = + 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) ; @@ -2135,7 +2121,7 @@ struct 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 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 From 0ea2ac3f28882d1eebac702265e873356f41fe56 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 7 Mar 2016 14:21:33 +0000 Subject: [PATCH 09/25] API script fix --- scripts/update_api.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index bf3f90151..6687d4517 100755 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -1261,7 +1261,7 @@ def mk_ml(ml_dir): ml_native.write('(**/**)\n') ml_native.close() - if is_verbose(): + if mk_util.is_verbose(): print ('Generated "%s"' % ml_nativef) From 3968423c266bdc58b91d94c3b951a9650aa53737 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Mon, 7 Mar 2016 15:35:25 +0000 Subject: [PATCH 10/25] build fix for ML API --- scripts/update_api.py | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index 6687d4517..eaf651087 100755 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -1264,6 +1264,8 @@ def mk_ml(ml_dir): 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') @@ -1492,7 +1494,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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): @@ -1668,6 +1670,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) From feae0e827719e70b3144597ef6565f188620f91d Mon Sep 17 00:00:00 2001 From: "Martin R. Neuhaeusser" Date: Thu, 31 Mar 2016 18:31:59 +0200 Subject: [PATCH 11/25] Use a custom block for storing a Z3_config in the ML bindings. --- scripts/update_api.py | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index 56740923f..a4bad305e 100755 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -1376,8 +1376,10 @@ def mk_z3native_stubs_c(ml_dir): # C interface ts = type2str(result) if ml_has_plus_type(ts): ml_wrapper.write('%s z3rv_m = ' % ts) + elif (result == BOOL or result == INT or result == UINT or result == PRINT_MODE or result == ERROR_CODE or result ==INT64 or result == UINT64 or result == DOUBLE or result == STRING): + ml_wrapper.write('%s z3rv = ' % ts) else: - ml_wrapper.write('result = caml_alloc(%s, 0);\n ' % ret_size) + ml_wrapper.write('result = caml_alloc_custom(&default_custom_ops, sizeof(%s), 0, 1);\n ' % ts) ml_wrapper.write('%s z3rv = ' % ts) elif len(op) != 0: From b85516c27145761270f3bfb855a8189b2f40c3dd Mon Sep 17 00:00:00 2001 From: martin-neuhaeusser Date: Sun, 3 Apr 2016 09:41:06 +0200 Subject: [PATCH 12/25] Fix reference counting in the C layer of the OCaml bindings The Z3 context and its reference counters are stored in a structure which is allocated by the C layer outside the OCaml heap, whenever a Z3 context is created. The structure and its Z3 context are disposed, once the last reference counter reaches zero. Reference counters are decremented by C-level finalizers. The OCaml representations for a Z3 context wrap only a pointer to the corresponding structure. --- scripts/update_api.py | 46 ++++++++--------- src/api/ml/z3native_stubs.c.pre | 89 ++++++++++++++++++++------------- 2 files changed, 76 insertions(+), 59 deletions(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index a4bad305e..cd6895544 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 @@ -637,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: @@ -679,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) @@ -715,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') @@ -945,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: @@ -1284,16 +1284,16 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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 @@ -1333,7 +1333,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface i = 0 for param in params: 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_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: @@ -1341,7 +1341,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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))) @@ -1350,14 +1350,14 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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))) + 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)) + ml_wrapper.write(' %s _a%s = a%s;\n' % (type2str(param_type(param)), i, i)) i = i + 1 i = 0 @@ -1412,7 +1412,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface if result != VOID: ts = type2str(result) if ml_has_plus_type(ts): - pts = ml_plus_type(ts) + pts = ml_plus_type(ts) ml_wrapper.write(' result = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (ml_plus_ops_type(ts), pts)) if name in NULLWrapped: ml_wrapper.write(' %s z3rv = %s_mk(z3rv_m);\n' % (pts, pts)) @@ -1429,10 +1429,10 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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++) {\n' % param_array_capacity_pos(p)) pts = ml_plus_type(ts) - pops = ml_plus_ops_type(ts) + pops = ml_plus_ops_type(ts) ml_wrapper.write(' value t;\n') ml_wrapper.write(' t = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (pops, pts)) - if ml_has_plus_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_set_wrap(pt, 't', '_a%dp' % i)) else: @@ -1453,7 +1453,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface ml_wrapper.write(' %s\n' % ml_set_wrap(pt, '_a%d_val' % i, '_a%d' % i)) i = i + 1 - # return tuples + # return tuples if len(op) == 0: ml_wrapper.write(' %s\n' % ml_set_wrap(result, "result", "z3rv")) else: @@ -1480,7 +1480,7 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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): diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index e4ed85373..de8ba62e6 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -26,31 +26,31 @@ extern "C" { #define CAMLlocal6(X1,X2,X3,X4,X5,X6) \ CAMLlocal5(X1,X2,X3,X4,X5); \ - CAMLlocal1(X6) + CAMLlocal1(X6) #define CAMLlocal7(X1,X2,X3,X4,X5,X6,X7) \ CAMLlocal5(X1,X2,X3,X4,X5); \ - CAMLlocal2(X6,X7) + CAMLlocal2(X6,X7) #define CAMLlocal8(X1,X2,X3,X4,X5,X6,X7,X8) \ CAMLlocal5(X1,X2,X3,X4,X5); \ - CAMLlocal3(X6,X7,X8) + CAMLlocal3(X6,X7,X8) #define CAMLparam7(X1,X2,X3,X4,X5,X6,X7) \ CAMLparam5(X1,X2,X3,X4,X5); \ - CAMLxparam2(X6,X7) + CAMLxparam2(X6,X7) #define CAMLparam8(X1,X2,X3,X4,X5,X6,X7,X8) \ CAMLparam5(X1,X2,X3,X4,X5); \ - CAMLxparam3(X6,X7,X8) + 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) + 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) + CAMLxparam3(X11,X12,X13) static struct custom_operations default_custom_ops = { @@ -68,51 +68,68 @@ static struct custom_operations default_custom_ops = { 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) = *p->cp; \ + *(Z3_context_plus*)Data_custom_val(result) = cp; \ + /* We increment the usage counter of the context */ \ + cp->obj_count++; \ 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:sizeof(unsigned long)-1; - unsigned ok_to_delete:1; -} Z3_context_plus; + 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; - r.ctx = c; - r.obj_count = 0; - r.ok_to_delete = 0; - /* printf("ctx++ %p\n", c); */ + Z3_context_plus r = (Z3_context_plus)malloc(sizeof(Z3_context_plus_data)); + r->ctx = c; + /* The context created here will be wrapped into a custom block. + Hence, we assign it a counter of one. */ + r->obj_count = 1; return r; } Z3_context Z3_context_plus_raw(Z3_context_plus * cp) { - return cp->ctx; + return (*cp)->ctx; } -void try_to_delete_context(Z3_context_plus * cp) { - if (!cp->ok_to_delete || cp->obj_count != 0) - /* printf("Trying to delete context %p.\n", cp->ctx) */ ; +inline void try_to_delete_context(Z3_context_plus cp) { + if (cp->obj_count > 0) + /* printf("try_to_delete_context: Not deleting context %p(%p) with cnt=%lu.\n", cp, cp->ctx, cp->obj_count) */ ; + else if (cp->obj_count < 0) + printf("try_to_delete_context: ERROR, found context %p(%p) with negative cnt=%lu.\n", cp, cp->ctx, cp->obj_count); else { - /* printf("Actually deleting context %p.\n", cp->ctx); */ + printf("try_to_delete_context: Deleting context %p(%p) with cnt=%lu.\n", cp, cp->ctx, cp->obj_count); Z3_del_context(cp->ctx); - cp->ctx = 0; + cp->ctx = NULL; cp->obj_count = 0; - cp->ok_to_delete = 0; + free(cp); } } void Z3_context_finalize(value v) { - Z3_context_plus * cp = (Z3_context_plus*)Data_custom_val(v); - /* printf("ctx--; cnt=%lu\n", cp->obj_count); */ - cp->ok_to_delete = 1; - try_to_delete_context(cp); + Z3_context_plus cp = *(Z3_context_plus*)Data_custom_val(v); + cp->obj_count--; + try_to_delete_context(cp); } static struct custom_operations Z3_context_plus_custom_ops = { @@ -129,14 +146,14 @@ static struct custom_operations Z3_context_plus_custom_ops = { /* AST objects */ typedef struct { - Z3_context_plus * cp; + Z3_context_plus cp; Z3_ast a; } Z3_ast_plus; -Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus * cp, Z3_ast a) { +Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus cp, Z3_ast a) { Z3_ast_plus r; r.cp = cp; - r.a = a; + r.a = a; /* printf("++\n"); */ cp->obj_count++; Z3_inc_ref(cp->ctx, a); @@ -148,7 +165,7 @@ Z3_ast Z3_ast_plus_raw(Z3_ast_plus * ap) { } void Z3_ast_finalize(value v) { - /* printf("--\n"); */ + /* printf("--\n"); */ Z3_ast_plus * ap = (Z3_ast_plus*)(Data_custom_val(v)); Z3_dec_ref(ap->cp->ctx, ap->a); ap->cp->obj_count--; @@ -203,11 +220,11 @@ MK_CTX_OF(ast) #define MK_PLUS_OBJ_NO_REF(X) \ typedef struct { \ - Z3_context_plus * cp; \ + 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 Z3_ ## X ## _plus_mk(Z3_context_plus cp, Z3_ ## X p) { \ Z3_ ## X ## _plus r; \ r.cp = cp; \ r.p = p; \ @@ -239,11 +256,11 @@ MK_CTX_OF(ast) #define MK_PLUS_OBJ(X) \ typedef struct { \ - Z3_context_plus * cp; \ + 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 Z3_ ## X ## _plus_mk(Z3_context_plus cp, Z3_ ## X p) { \ Z3_ ## X ## _plus r; \ r.cp = cp; \ r.p = p; \ @@ -309,7 +326,7 @@ CAMLprim DLL_PUBLIC value n_is_null(value p) { CAMLprim DLL_PUBLIC value n_mk_null( void ) { CAMLparam0(); - CAMLlocal1(result); + CAMLlocal1(result); result = caml_alloc(1, 0); result = Val_int(0); CAMLreturn (result); From f133f478c81d21124bce8214fae66caffb01d80a Mon Sep 17 00:00:00 2001 From: martin-neuhaeusser Date: Mon, 4 Apr 2016 17:16:15 +0200 Subject: [PATCH 13/25] Translate correctly between OCaml option values and NULL pointers This patch refactors the update_api script and the z3.ml implementation to properly translate between OCaml options and NULL pointers. Some unifications and simplifications (avoidance of unnecessary value allocation) in the script that creates the native bindings. --- scripts/update_api.py | 78 ++-- src/api/ml/z3.ml | 674 ++++++++++++++++---------------- src/api/ml/z3native.ml.pre | 70 ---- src/api/ml/z3native_stubs.c.pre | 104 +++-- 4 files changed, 451 insertions(+), 475 deletions(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index cd6895544..f1a06a63d 100755 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -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 @@ -1094,6 +1094,8 @@ def ml_plus_type(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': @@ -1151,7 +1153,7 @@ def ml_has_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 + ')' @@ -1172,7 +1174,7 @@ def ml_unwrap(t, ts, 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 + ');' @@ -1186,6 +1188,15 @@ def ml_set_wrap(t, d, n): 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') @@ -1258,6 +1269,18 @@ def mk_ml(ml_dir): ml_native.write(' a%d' % i) i = i + 1 ml_native.write('\n') + + ml_native.write('\n') + + # 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)) + ml_native.write('(**/**)\n') ml_native.close() @@ -1266,7 +1289,6 @@ def mk_ml(ml_dir): 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') @@ -1315,14 +1337,21 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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 + 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 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') + ml_wrapper.write(');\n') if len(ap) != 0: @@ -1371,20 +1400,14 @@ def mk_z3native_stubs_c(ml_dir): # C interface ml_wrapper.write(' }\n') i = i + 1 - ml_wrapper.write(' ') + ml_wrapper.write('\n /* invoke Z3 function */\n ') if result != VOID: ts = type2str(result) if ml_has_plus_type(ts): ml_wrapper.write('%s z3rv_m = ' % ts) - elif (result == BOOL or result == INT or result == UINT or result == PRINT_MODE or result == ERROR_CODE or result ==INT64 or result == UINT64 or result == DOUBLE or result == STRING): - ml_wrapper.write('%s z3rv = ' % ts) else: - ml_wrapper.write('result = caml_alloc_custom(&default_custom_ops, sizeof(%s), 0, 1);\n ' % ts) ml_wrapper.write('%s z3rv = ' % ts) - elif len(op) != 0: - ml_wrapper.write('result = caml_alloc(%s, 0);\n ' % ret_size) - # invoke procedure ml_wrapper.write('%s(' % name) i = 0 @@ -1413,7 +1436,6 @@ def mk_z3native_stubs_c(ml_dir): # C interface ts = type2str(result) if ml_has_plus_type(ts): pts = ml_plus_type(ts) - ml_wrapper.write(' result = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (ml_plus_ops_type(ts), pts)) if name in NULLWrapped: ml_wrapper.write(' %s z3rv = %s_mk(z3rv_m);\n' % (pts, pts)) else: @@ -1421,6 +1443,14 @@ def mk_z3native_stubs_c(ml_dir): # C interface # convert output params if len(op) > 0: + # 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) @@ -1430,14 +1460,12 @@ def mk_z3native_stubs_c(ml_dir): # C interface ml_wrapper.write(' for (_i = 0; _i < _a%s; _i++) {\n' % param_array_capacity_pos(p)) pts = ml_plus_type(ts) pops = ml_plus_ops_type(ts) - ml_wrapper.write(' value t;\n') - ml_wrapper.write(' t = caml_alloc_custom(&%s, sizeof(%s), 0, 1);\n' % (pops, pts)) 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_set_wrap(pt, 't', '_a%dp' % i)) + ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, 'tmp_val', '_a%dp' % i)) else: - ml_wrapper.write(' %s\n' % ml_set_wrap(pt, 't', '_a%d[_i]' % i)) - ml_wrapper.write(' Store_field(_a%s_val, _i, t);\n' % i) + ml_wrapper.write(' %s\n' % ml_alloc_and_store(pt, 'tmp_val', '_a%d[_i]' % i)) + ml_wrapper.write(' Store_field(_a%s_val, _i, tmp_val);\n' % i) ml_wrapper.write(' }\n') elif param_kind(p) == OUT_MANAGED_ARRAY: wrp = ml_set_wrap(pt, '_a%d_val' % i, '_a%d' % i) @@ -1448,18 +1476,15 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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_set_wrap(pt, '_a%d_val' % i, '_a%dp' % 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_set_wrap(pt, '_a%d_val' % i, '_a%d' % i)) + 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", "z3rv")) - else: + # return tuples i = j = 0 if result != VOID: - ml_wrapper.write(' %s\n' % ml_set_wrap(result, "z3rv_val", "z3rv")) + 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: @@ -1467,8 +1492,13 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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) diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml index a5beac6ec..e6e832572 100644 --- a/src/api/ml/z3.ml +++ b/src/api/ml/z3.ml @@ -10,13 +10,9 @@ open Z3enums 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 -module Log = +module Log = struct let open_ filename = ((lbool_of_int (Z3native.open_log filename)) == L_TRUE) let close = Z3native.close_log @@ -30,7 +26,7 @@ struct 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 to_string = let (mj, mn, bld, rev) = Z3native.get_version () in string_of_int mj ^ "." ^ string_of_int mn ^ "." ^ @@ -41,7 +37,7 @@ 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 + if (i >= n) then tail else (f i) :: (mk_list' f (i+1) n tail) @@ -56,7 +52,7 @@ let mk_context (settings:(string * string) list) = 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 + res @@ -64,8 +60,8 @@ module Symbol = struct type symbol = Z3native.symbol let gc (o:symbol) = (Z3native.context_of_symbol o) - - let kind (o:symbol) = (symbol_kind_of_int (Z3native.get_symbol_kind (gc o) o)) + + let kind (o:symbol) = (symbol_kind_of_int (Z3native.get_symbol_kind (gc o) 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 (gc o) o) @@ -75,7 +71,7 @@ struct | INT_SYMBOL -> (string_of_int (Z3native.get_symbol_int (gc o) o)) | STRING_SYMBOL -> (Z3native.get_symbol_string (gc o) o) - let mk_int (ctx:context) (i:int) = (Z3native.mk_int_symbol ctx i) + let mk_int (ctx:context) (i:int) = (Z3native.mk_int_symbol ctx i) let mk_string (ctx:context) (s:string) = (Z3native.mk_string_symbol ctx s) let mk_ints (ctx:context) (names:int list) = @@ -131,11 +127,11 @@ sig val equal : ast -> ast -> bool val compare : ast -> ast -> int val translate : ast -> context -> ast -end = struct +end = struct type ast = Z3native.ast let gc (x:ast) = Z3native.context_of_ast x - - module ASTVector = + + module ASTVector = struct type ast_vector = Z3native.ast_vector let gc (x:ast_vector) = Z3native.context_of_ast_vector x @@ -144,7 +140,7 @@ end = struct 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 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 @@ -157,22 +153,22 @@ end = struct 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 (gc x) x end module ASTMap = - struct + struct type ast_map = Z3native.ast_map let gc (x:ast_map) = Z3native.context_of_ast_map x - + let mk_ast_map (ctx:context) = Z3native.mk_ast_map ctx 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 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 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 get_size (x:ast_map) = Z3native.ast_map_size (gc x) x let get_keys (x:ast_map) = let av = (Z3native.ast_map_keys (gc x) x) in @@ -184,17 +180,17 @@ end = struct 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 is_expr (x:ast) = + + let is_expr (x:ast) = match get_ast_kind (x:ast) with | APP_AST - | NUMERAL_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_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 @@ -204,19 +200,19 @@ end = struct let equal (a:ast) (b:ast) = - (a == b) || - (if (gc a) != (gc b) then - false - else + (a == b) || + (if (gc a) != (gc b) then + false + else Z3native.is_eq_ast (gc a) a b) - - let compare a 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 (gc x) == to_ctx then + if (gc x) == to_ctx then x else Z3native.translate (gc x) x to_ctx @@ -236,24 +232,24 @@ sig end = struct type sort = Z3native.sort let gc (x:sort) = Z3native.context_of_ast x - + let equal:sort -> sort -> bool = fun a b -> (a == b) || - (if (gc a) != (gc b) then - false - else + (if (gc a) != (gc b) then + false + else Z3native.is_eq_sort (gc a) a b) - + 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 (ctx:context) (s:Symbol.symbol) = Z3native.mk_uninterpreted_sort ctx s let mk_uninterpreted_s (ctx:context) (s:string) = mk_uninterpreted ctx (Symbol.mk_string ctx s) -end +end and FuncDecl : -sig +sig type func_decl = Z3native.func_decl val gc : func_decl -> context module Parameter : @@ -266,7 +262,7 @@ val gc : func_decl -> context | 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 @@ -299,8 +295,8 @@ end = struct let gc (x:func_decl) = Z3native.context_of_ast x module Parameter = - struct - type parameter = + struct + type parameter = | P_Int of int | P_Dbl of float | P_Sym of Symbol.symbol @@ -308,7 +304,7 @@ 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 @@ -318,22 +314,22 @@ end = struct | 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 (Error "parameter is not an int") - - let get_float (x:parameter) = + + let get_float (x:parameter) = match x with | P_Dbl(x) -> x | _ -> raise (Error "parameter is not a float") - + let get_symbol (x:parameter) = match x with | P_Sym(x) -> x | _ -> raise (Error "parameter is not a symbol") - + let get_sort (x:parameter) = match x with | P_Srt(x) -> x @@ -375,25 +371,25 @@ end = struct let equal (a:func_decl) (b:func_decl) = (a == b) || - (if (gc a) != (gc b) then - false - else + (if (gc a) != (gc b) then + false + else Z3native.is_eq_func_decl (gc a) a b) - let to_string (x:func_decl) = Z3native.func_decl_to_string (gc x) x + 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 get_domain (x:func_decl) = + 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 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_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 @@ -407,7 +403,7 @@ end = struct | 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 + let apply (x:func_decl) (args:Expr.expr list) = Expr.expr_of_func_app (gc x) x args end @@ -429,28 +425,28 @@ sig val add_symbol : params -> Symbol.symbol -> Symbol.symbol -> unit val mk_params : context -> params val to_string : params -> string - + val update_param_value : context -> string -> string -> unit val set_print_mode : context -> Z3enums.ast_print_mode -> unit end = struct type params = Z3native.params let gc (x:params) = Z3native.context_of_params x - module ParamDescrs = - struct + module ParamDescrs = + struct type param_descrs = Z3native.param_descrs let gc (x:param_descrs) = Z3native.context_of_param_descrs x 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 (gc x) x - let to_string (x:param_descrs) = Z3native.param_descrs_to_string (gc x) 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 (gc x) x name value @@ -497,60 +493,60 @@ sig 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 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 = AST.ast +end = struct + type expr = AST.ast let gc (e:expr) = Z3native.context_of_ast e - - let expr_of_ast (a:AST.ast) : expr = + + let expr_of_ast (a:AST.ast) : expr = 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 a - + let ast_of_expr (e:expr) : AST.ast = e - let expr_of_func_app:context -> FuncDecl.func_decl -> expr list -> expr = + let expr_of_func_app:context -> FuncDecl.func_decl -> expr list -> expr = fun ctx f args -> (Z3native.mk_app ctx f (List.length args) (Array.of_list args)) - + let apply1 ctx f t = f ctx t let apply2 ctx f t1 t2 = f ctx t1 t2 let apply3 ctx f t1 t2 t3 = f ctx t1 t2 t3 let apply4 ctx f t1 t2 t3 t4 = f ctx t1 t2 t3 t4 - let simplify (x:expr) (p:Params.params option) = - match p with + 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 (ctx:context) = Z3native.simplify_get_help ctx let get_simplify_parameter_descrs (ctx:context) = Z3native.simplify_get_param_descrs ctx 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 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 Z3native.update_term (gc x) x (List.length args) (Array.of_list args) - - let substitute (x:expr) (from:expr list) (to_:expr list) = + + let substitute (x:expr) (from:expr list) (to_:expr list) = if (List.length from) <> (List.length to_) then raise (Error "Argument sizes do not match") else Z3native.substitute (gc x) x (List.length from) (Array.of_list from) (Array.of_list to_) - + let substitute_one (x:expr) (from:expr) (to_:expr) = substitute (x:expr) [ from ] [ to_ ] let substitute_vars (x:expr) (to_:expr list) = Z3native.substitute_vars (gc x) x (List.length to_) (Array.of_list to_) - + let translate (x:expr) to_ctx = if (gc x) == to_ctx then x @@ -561,11 +557,11 @@ end = struct 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) = + let is_const (x:expr) = (AST.is_app x) && (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) = 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 [] @@ -580,16 +576,16 @@ end open FuncDecl open Expr -module Boolean = -struct +module Boolean = +struct let mk_sort (ctx:context) = Z3native.mk_bool_sort ctx - let mk_const (ctx:context) (name:Symbol.symbol) = Expr.mk_const ctx name (mk_sort ctx) + 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 (ctx:context) = Z3native.mk_true ctx let mk_false (ctx:context) = Z3native.mk_false ctx - 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 mk_ite (ctx:context) (t1:expr) (t2:expr) (t3:expr) = apply3 ctx Z3native.mk_ite t1 t2 t3 + 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 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 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 @@ -599,7 +595,7 @@ struct let mk_distinct (ctx:context) (args:expr list) = Z3native.mk_distinct ctx (List.length args) (Array.of_list args) let get_bool_value (x:expr) = lbool_of_int (Z3native.get_bool_value (gc x) x) - let is_bool (x:expr) = + let is_bool (x:expr) = (AST.is_expr x) && (Z3native.is_eq_sort (gc x) (Z3native.mk_bool_sort (gc x)) (Z3native.get_sort (gc x) x)) let is_true (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_TRUE) @@ -616,11 +612,11 @@ struct end -module Quantifier = -struct +module Quantifier = +struct type quantifier = AST.ast let gc (x:quantifier) = Z3native.context_of_ast x - + let expr_of_quantifier (q:quantifier) : Expr.expr = q let quantifier_of_expr (e:Expr.expr) : quantifier = @@ -630,8 +626,8 @@ struct else e - - module Pattern = + + module Pattern = struct type pattern = Z3native.pattern let gc (x:pattern) = Z3native.context_of_ast x @@ -646,40 +642,40 @@ struct let to_string (x:pattern) = Z3native.pattern_to_string (gc x) x end - let get_index (x:expr) = + 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 (gc x) x - let is_universal (x:quantifier) = Z3native.is_quantifier_forall (gc x) x + let is_universal (x:quantifier) = Z3native.is_quantifier_forall (gc x) x let is_existential (x:quantifier) = not (is_universal x) let get_weight (x:quantifier) = Z3native.get_quantifier_weight (gc x) x - let get_num_patterns (x:quantifier) = Z3native.get_quantifier_num_patterns (gc x) x + let get_num_patterns (x:quantifier) = Z3native.get_quantifier_num_patterns (gc x) x let get_patterns (x:quantifier) = 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 (gc x) x - + let get_no_patterns (x:quantifier) = 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 (gc x) x - + let get_bound_variable_names (x:quantifier) = 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 = Z3native.get_quantifier_bound_sort (gc x) x i in mk_list f n - + let get_body (x:quantifier) = Z3native.get_quantifier_body (gc x) x let mk_bound (ctx:context) (index:int) (ty:Sort.sort) = Z3native.mk_bound ctx index ty @@ -693,7 +689,7 @@ struct if (List.length sorts) != (List.length names) then raise (Error "Number of sorts does not match number of names") else if ((List.length nopatterns) == 0 && quantifier_id == None && skolem_id == None) then - Z3native.mk_quantifier ctx true + Z3native.mk_quantifier ctx true (match weight with | None -> 1 | Some(x) -> x) (List.length patterns) (Array.of_list patterns) (List.length sorts) (Array.of_list sorts) @@ -702,14 +698,14 @@ struct else Z3native.mk_quantifier_ex ctx true (match weight with | None -> 1 | Some(x) -> x) - (match quantifier_id with | None -> null | Some(x) -> x) - (match skolem_id with | None -> null | 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) (Array.of_list patterns) (List.length nopatterns) (Array.of_list nopatterns) (List.length sorts) (Array.of_list sorts) (Array.of_list names) 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 Z3native.mk_quantifier_const ctx true @@ -720,8 +716,8 @@ struct else Z3native.mk_quantifier_const_ex ctx true (match weight with | None -> 1 | Some(x) -> x) - (match quantifier_id with | None -> null | Some(x) -> x) - (match skolem_id with | None -> null | 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) (Array.of_list bound_constants) (List.length patterns) (Array.of_list patterns) (List.length nopatterns) (Array.of_list nopatterns) @@ -740,14 +736,14 @@ struct else Z3native.mk_quantifier_ex ctx false (match weight with | None -> 1 | Some(x) -> x) - (match quantifier_id with | None -> null | Some(x) -> x) - (match skolem_id with | None -> null | 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) (Array.of_list patterns) (List.length nopatterns) (Array.of_list nopatterns) (List.length sorts) (Array.of_list sorts) (Array.of_list names) 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 Z3native.mk_quantifier_const ctx false @@ -758,8 +754,8 @@ struct else Z3native.mk_quantifier_const_ex ctx false (match weight with | None -> 1 | Some(x) -> x) - (match quantifier_id with | None -> null | Some(x) -> x) - (match skolem_id with | None -> null | 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) (Array.of_list bound_constants) (List.length patterns) (Array.of_list patterns) (List.length nopatterns) (Array.of_list nopatterns) @@ -776,12 +772,12 @@ else 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 x end -module Z3Array = +module Z3Array = struct let mk_sort (ctx:context) (domain:Sort.sort) (range:Sort.sort) = Z3native.mk_array_sort ctx domain range let is_store (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_STORE) @@ -789,7 +785,7 @@ struct let is_constant_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_CONST_ARRAY) let is_default_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ARRAY_DEFAULT) let is_array_map (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ARRAY_MAP) - let is_as_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_AS_ARRAY) + let is_as_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_AS_ARRAY) let is_array (x:expr) = (Z3native.is_app (Expr.gc x) x) && @@ -798,12 +794,12 @@ struct let get_domain (x:Sort.sort) = Z3native.get_array_sort_domain (Sort.gc x) x let get_range (x:Sort.sort) = Z3native.get_array_sort_range (Sort.gc x) x - let mk_const (ctx:context) (name:Symbol.symbol) (domain:Sort.sort) (range:Sort.sort) = + 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) = + + 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_store (ctx:context) (a:expr) (i:expr) (v:expr) = apply3 ctx Z3native.mk_store a i v let mk_const_array (ctx:context) (domain:Sort.sort) (v:expr) = Z3native.mk_const_array ctx domain v @@ -813,23 +809,23 @@ struct end -module Set = -struct +module Set = +struct let mk_sort (ctx:context) (ty:Sort.sort) = Z3native.mk_set_sort ctx ty - + 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 mk_empty (ctx:context) (domain:Sort.sort) = Z3native.mk_empty_set ctx domain + let mk_empty (ctx:context) (domain:Sort.sort) = Z3native.mk_empty_set ctx domain let mk_full (ctx:context) (domain:Sort.sort) = Z3native.mk_full_set ctx domain - let mk_set_add (ctx:context) (set:expr) (element:expr) = apply2 ctx Z3native.mk_set_add set element + 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) = Z3native.mk_set_union ctx (List.length args) (Array.of_list args) + let mk_union (ctx:context) (args:expr list) = Z3native.mk_set_union ctx (List.length args) (Array.of_list args) - let mk_intersection (ctx:context) (args:expr list) = + let mk_intersection (ctx:context) (args:expr list) = Z3native.mk_set_intersect ctx (List.length args) (Array.of_list args) let mk_difference (ctx:context) (arg1:expr) (arg2:expr) = apply2 ctx Z3native.mk_set_difference arg1 arg2 @@ -839,9 +835,9 @@ struct end -module FiniteDomain = -struct - let mk_sort (ctx:context) (name:Symbol.symbol) (size:int) = Z3native.mk_finite_domain_sort ctx name size +module FiniteDomain = +struct + let mk_sort (ctx:context) (name:Symbol.symbol) (size:int) = Z3native.mk_finite_domain_sort ctx 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) = @@ -851,14 +847,14 @@ struct 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:Sort.sort) = + let get_size (x:Sort.sort) = let (r, v) = (Z3native.get_finite_domain_sort_size (Sort.gc x) x) in if r then v else raise (Error "Conversion failed.") end -module Relation = +module Relation = struct let is_relation (x:expr) = let nc = (Expr.gc x) in @@ -881,20 +877,20 @@ struct let get_arity (x:Sort.sort) = Z3native.get_relation_arity (Sort.gc x) x - let get_column_sorts (x:Sort.sort) = + let get_column_sorts (x:Sort.sort) = let n = get_arity x 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 = Z3native.constructor - - module FieldNumTable = Hashtbl.Make(struct + + module FieldNumTable = Hashtbl.Make(struct type t = AST.ast let equal x y = AST.compare x y = 0 let hash = AST.hash @@ -910,16 +906,16 @@ struct 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 + let no = Z3native.mk_constructor ctx name recognizer n (Array.of_list field_names) - (let f x = match x with None -> null | Some(s) -> s in + (let f x = match x with None -> Z3native.mk_null_ast ctx | Some s -> s in Array.of_list (List.map f sorts)) (Array.of_list sort_refs) in FieldNumTable.add _field_nums no n ; no - + let get_num_fields (x:constructor) = FieldNumTable.find _field_nums x let get_constructor_decl (x:constructor) = @@ -930,7 +926,7 @@ struct let (_, b, _) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in b - let get_accessor_decls (x:constructor) = + let get_accessor_decls (x:constructor) = let (_, _, c) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in let f i = Array.get c i in mk_list f (Array.length c) @@ -943,7 +939,7 @@ struct let create (ctx:context) (c:Constructor.constructor list) = Z3native.mk_constructor_list ctx (List.length c) (Array.of_list 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) = Constructor.create ctx name recognizer field_names sorts sort_refs @@ -956,7 +952,7 @@ struct 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 = ConstructorList.create ctx e in @@ -970,16 +966,16 @@ struct let get_num_constructors (x:Sort.sort) = Z3native.get_datatype_sort_num_constructors (Sort.gc x) x - let get_constructors (x:Sort.sort) = + 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 = Z3native.get_datatype_sort_recognizer (Sort.gc x) x i in mk_list f n - + let get_accessors (x:Sort.sort) = let n = (get_num_constructors x) in let f i = ( @@ -991,8 +987,8 @@ struct end -module Enumeration = -struct +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) (Array.of_list enum_names)) in a @@ -1014,21 +1010,21 @@ struct 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 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) = Z3native.get_datatype_sort_recognizer (Sort.gc x) x inx end -module Z3List = -struct +module Z3List = +struct let mk_sort (ctx:context) (name:Symbol.symbol) (elem_sort:Sort.sort) = let (r, _, _, _, _, _, _) = Z3native.mk_list_sort ctx name elem_sort in - r - + 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) = 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 @@ -1040,16 +1036,16 @@ struct end -module Tuple = +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) (Array.of_list field_names) (Array.of_list field_sorts)) in + let (r, _, _) = (Z3native.mk_tuple_sort ctx name (List.length field_names) (Array.of_list field_names) (Array.of_list 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_num_fields (x:Sort.sort) = Z3native.get_tuple_sort_num_fields (Sort.gc x) x - let get_field_decls (x:Sort.sort) = + let get_field_decls (x:Sort.sort) = let n = get_num_fields x in let f i =Z3native.get_tuple_sort_field_decl (Sort.gc x) x i in mk_list f n @@ -1060,7 +1056,7 @@ module Arithmetic = struct 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_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) @@ -1077,70 +1073,70 @@ struct 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_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 + struct let mk_sort (ctx:context) = Z3native.mk_int_sort ctx - let get_int (x:expr) = + let get_int (x:expr) = let (r, v) = Z3native.get_numeral_int (Expr.gc x) x in if r then v else raise (Error "Conversion failed.") - let get_big_int (x:expr) = - if (is_int_numeral x) then + 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 + else 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) = Expr.mk_const ctx name (mk_sort ctx) + 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_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) = Z3native.mk_numeral ctx v (mk_sort ctx) + 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 (ctx:context) (t:expr) = apply1 ctx Z3native.mk_int2real t let mk_int2bv (ctx:context) (n:int) (t:expr) = Z3native.mk_int2bv ctx n t end module Real = - struct + struct let mk_sort (ctx:context) = Z3native.mk_real_sort ctx - let get_numerator (x:expr) = apply1 (Expr.gc x) Z3native.get_numerator 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) = + + let get_ratio (x:expr) = if (is_rat_numeral x) then let s = (Z3native.get_numeral_string (Expr.gc x) x) in Ratio.ratio_of_string s - else + else raise (Error "Conversion failed.") 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 (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 + if (den == 0) then raise (Error "Denominator is zero") - else + else Z3native.mk_real ctx num den - - 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 (ctx:context) (t:expr) = apply1 ctx Z3native.mk_is_int 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 (ctx:context) (t:expr) = apply1 ctx Z3native.mk_is_int t let mk_real2int (ctx:context) (t:expr) = apply1 ctx Z3native.mk_real2int t module AlgebraicNumber = - 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 + 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 @@ -1160,7 +1156,7 @@ end module BitVector = -struct +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) @@ -1210,19 +1206,19 @@ struct 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_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) = + let get_int (x:expr) = let (r, v) = Z3native.get_numeral_int (Expr.gc x) x in if r then v else 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) + 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 @@ -1276,9 +1272,9 @@ struct end -module FloatingPoint = +module FloatingPoint = struct - module RoundingMode = + module RoundingMode = struct let mk_sort (ctx:context) = Z3native.mk_fpa_rounding_mode_sort ctx let is_fprm (x:expr) = (Sort.get_sort_kind (Expr.get_sort(x))) == ROUNDING_MODE_SORT @@ -1287,18 +1283,18 @@ struct let mk_round_nearest_ties_to_away (ctx:context) = Z3native.mk_fpa_round_nearest_ties_to_away ctx let mk_rna (ctx:context) = Z3native.mk_fpa_rna ctx let mk_round_toward_positive (ctx:context) = Z3native.mk_fpa_round_toward_positive ctx - let mk_rtp (ctx:context) = Z3native.mk_fpa_rtp ctx + let mk_rtp (ctx:context) = Z3native.mk_fpa_rtp ctx let mk_round_toward_negative (ctx:context) = Z3native.mk_fpa_round_toward_negative ctx let mk_rtn (ctx:context) = Z3native.mk_fpa_rtn ctx let mk_round_toward_zero (ctx:context) = Z3native.mk_fpa_round_toward_zero ctx let mk_rtz (ctx:context) = Z3native.mk_fpa_rtz ctx end - + let mk_sort (ctx:context) (ebits:int) (sbits:int) = Z3native.mk_fpa_sort ctx ebits sbits let mk_sort_half (ctx:context) = Z3native.mk_fpa_sort_half ctx let mk_sort_16 (ctx:context) = Z3native.mk_fpa_sort_16 ctx let mk_sort_single (ctx:context) = Z3native.mk_fpa_sort_single ctx - let mk_sort_32 (ctx:context) = Z3native.mk_fpa_sort_32 ctx + let mk_sort_32 (ctx:context) = Z3native.mk_fpa_sort_32 ctx let mk_sort_double (ctx:context) = Z3native.mk_fpa_sort_double ctx let mk_sort_64 (ctx:context) = Z3native.mk_fpa_sort_64 ctx let mk_sort_quadruple (ctx:context) = Z3native.mk_fpa_sort_quadruple ctx @@ -1344,7 +1340,7 @@ struct 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 numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) x let mk_const (ctx:context) (name:Symbol.symbol) (s:Sort.sort) = Expr.mk_const ctx name s @@ -1385,7 +1381,7 @@ struct let mk_to_real (ctx:context) (t:expr) = apply1 ctx Z3native.mk_fpa_to_real t let get_ebits (ctx:context) (s:Sort.sort) = Z3native.fpa_get_ebits ctx s let get_sbits (ctx:context) (s:Sort.sort) = Z3native.fpa_get_sbits ctx s - let get_numeral_sign (ctx:context) (t:expr) = Z3native.fpa_get_numeral_sign ctx t + let get_numeral_sign (ctx:context) (t:expr) = Z3native.fpa_get_numeral_sign ctx t let get_numeral_significand_string (ctx:context) (t:expr) = Z3native.fpa_get_numeral_significand_string ctx t let get_numeral_significand_uint (ctx:context) (t:expr) = Z3native.fpa_get_numeral_significand_uint64 ctx t let get_numeral_exponent_string (ctx:context) (t:expr) = Z3native.fpa_get_numeral_exponent_string ctx t @@ -1396,7 +1392,7 @@ struct end -module Proof = +module Proof = struct 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) @@ -1441,67 +1437,67 @@ end module Goal = -struct +struct type goal = Z3native.goal let gc (x:goal) = Z3native.context_of_goal x 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_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 add (x:goal) (constraints:expr list) = let f e = Z3native.goal_assert (gc x) x e in ignore (List.map f constraints) ; () - + 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_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 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 (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 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 (gc x) "simplify" in Z3native.tactic_inc_ref (gc x) tn ; let arn = match p with - | None -> Z3native.tactic_apply (gc x) tn x + | 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 (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 + 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) = + let mk_goal (ctx:context) (models:bool) (unsat_cores:bool) (proofs:bool) = Z3native.mk_goal ctx models unsat_cores proofs let to_string (x:goal) = Z3native.goal_to_string (gc x) x - let as_expr (x:goal) = + let as_expr (x:goal) = let n = get_size x in - if n = 0 then + if n = 0 then Boolean.mk_true (gc x) else if n = 1 then List.hd (get_formulas x) else Boolean.mk_and (gc x) (get_formulas x) -end +end module Model = @@ -1563,7 +1559,7 @@ struct raise (Error "Non-zero arity functions and arrays have FunctionInterpretations as a model. Use FuncInterp.") else let np = Z3native.model_get_const_interp (gc x) x f in - if (Z3native.is_null np) then + if Z3native.is_null_ast np then None else Some np @@ -1574,7 +1570,7 @@ struct 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 n) then + if Z3native.is_null_ast n then None else match sk with @@ -1587,7 +1583,7 @@ struct | _ -> raise (Error "Constant functions do not have a function interpretation; use ConstInterp"); else let n = Z3native.model_get_func_interp (gc x) x f in - if (Z3native.is_null n) then None else Some n + 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 (gc x) x @@ -1698,7 +1694,7 @@ struct let mk_tactic (ctx:context) (name:string) = Z3native.mk_tactic ctx name let and_then (ctx:context) (t1:tactic) (t2:tactic) (ts:tactic list) = - let f p c = (match p with + 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 @@ -1747,7 +1743,7 @@ struct } in res - let create_sd k v = + let create_sd k v = let res:statistics_entry = { m_key = k ; m_is_int = false ; @@ -1758,14 +1754,14 @@ struct res let get_key (x:statistics_entry) = x.m_key - let get_int (x:statistics_entry) = x.m_int + 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) = + let to_string_value (x:statistics_entry) = if (is_int x) then string_of_int (get_int x) - else if (is_float x) then + else if (is_float x) then string_of_float (get_float x) else raise (Error "Unknown statistical entry type") @@ -1774,7 +1770,7 @@ struct 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 = ( @@ -1797,14 +1793,14 @@ end module Solver = -struct +struct type solver = Z3native.solver type status = UNSATISFIABLE | UNKNOWN | SATISFIABLE let gc (x:solver) = Z3native.context_of_solver x 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 (gc x) x @@ -1825,8 +1821,8 @@ struct else let f a b = Z3native.solver_assert_and_track (gc x) x a b in ignore (List.iter2 f cs ps) - - let assert_and_track (x:solver) (c:expr) (p:expr) = + + let assert_and_track (x:solver) (c:expr) (p:expr) = Z3native.solver_assert_and_track (gc x) x c p let get_num_assertions (x:solver) = @@ -1838,39 +1834,39 @@ struct AST.ASTVector.to_expr_list av let check (x:solver) (assumptions:expr list) = - let r = + let r = if ((List.length assumptions) == 0) then lbool_of_int (Z3native.solver_check (gc x) x) else lbool_of_int (Z3native.solver_check_assumptions (gc x) x (List.length assumptions) (Array.of_list assumptions)) in - match r with + match r with | L_TRUE -> SATISFIABLE | L_FALSE -> UNSATISFIABLE | _ -> UNKNOWN - + let get_model (x:solver) = let q = Z3native.solver_get_model (gc x) x in - if (Z3native.is_null q) then None else Some q - + if Z3native.is_null_model q then None else Some q + let get_proof (x:solver) = let q = Z3native.solver_get_proof (gc x) x in - if (Z3native.is_null q) then None else Some q - + if Z3native.is_null_ast q then None else Some q + let get_unsat_core (x:solver) = - let av = Z3native.solver_get_unsat_core (gc x) x in + let av = Z3native.solver_get_unsat_core (gc x) x in AST.ASTVector.to_expr_list av let get_reason_unknown (x:solver) = Z3native.solver_get_reason_unknown (gc x) x let get_statistics (x:solver) = Z3native.solver_get_statistics (gc x) x - + let mk_solver (ctx:context) (logic:Symbol.symbol option) = match logic with | 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) = Z3native.mk_simple_solver ctx + let mk_simple_solver (ctx:context) = Z3native.mk_simple_solver ctx let mk_solver_t (ctx:context) (t:Tactic.tactic) = Z3native.mk_solver_from_tactic ctx t let translate (x:solver) (to_ctx:context) = Z3native.solver_translate (gc x) x to_ctx let to_string (x:solver) = Z3native.solver_to_string (gc x) x @@ -1881,10 +1877,10 @@ module Fixedpoint = struct type fixedpoint = Z3native.fixedpoint let gc (x:fixedpoint) = Z3native.context_of_fixedpoint x - - let get_help (x:fixedpoint) = Z3native.fixedpoint_get_help (gc x) x - let set_parameters (x:fixedpoint) (p:Params.params) = Z3native.fixedpoint_set_params (gc x) x p - let get_param_descrs (x:fixedpoint) = Z3native.fixedpoint_get_param_descrs (gc x) x + + let get_help (x:fixedpoint) = Z3native.fixedpoint_get_help (gc x) x + let set_parameters (x:fixedpoint) (p:Params.params) = Z3native.fixedpoint_set_params (gc x) x p + let get_param_descrs (x:fixedpoint) = Z3native.fixedpoint_get_param_descrs (gc x) x let add (x:fixedpoint) (constraints:expr list) = let f e = Z3native.fixedpoint_assert (gc x) x e in @@ -1892,15 +1888,15 @@ struct () let register_relation (x:fixedpoint) (f:func_decl) = Z3native.fixedpoint_register_relation (gc x) x f - + let add_rule (x:fixedpoint) (rule:expr) (name:Symbol.symbol option) = - match name with - | None -> Z3native.fixedpoint_add_rule (gc x) x rule null - | Some(y) -> Z3native.fixedpoint_add_rule (gc x) x rule y - + 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 add_fact (x:fixedpoint) (pred:func_decl) (args:int list) = Z3native.fixedpoint_add_fact (gc x) x pred (List.length args) (Array.of_list args) - + let query (x:fixedpoint) (query:expr) = match (lbool_of_int (Z3native.fixedpoint_query (gc x) x query)) with | L_TRUE -> Solver.SATISFIABLE @@ -1912,38 +1908,38 @@ struct | L_TRUE -> Solver.SATISFIABLE | L_FALSE -> Solver.UNSATISFIABLE | _ -> Solver.UNKNOWN - - let push (x:fixedpoint) = Z3native.fixedpoint_push (gc x) x + + let push (x:fixedpoint) = Z3native.fixedpoint_push (gc x) x let pop (x:fixedpoint) = Z3native.fixedpoint_pop (gc x) x let update_rule (x:fixedpoint) (rule:expr) (name:Symbol.symbol) = Z3native.fixedpoint_update_rule (gc x) x rule name let get_answer (x:fixedpoint) = - let q = (Z3native.fixedpoint_get_answer (gc x) x) in - if (Z3native.is_null q) then None else Some q + let q = Z3native.fixedpoint_get_answer (gc x) x in + if Z3native.is_null_ast q then None else Some q let get_reason_unknown (x:fixedpoint) = Z3native.fixedpoint_get_reason_unknown (gc x) x let get_num_levels (x:fixedpoint) (predicate:func_decl) = Z3native.fixedpoint_get_num_levels (gc x) x predicate 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 q) then None else Some q - + 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 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) (Array.of_list kinds) let to_string_q (x:fixedpoint) (queries:expr list) = Z3native.fixedpoint_to_string (gc x) x (List.length queries) (Array.of_list queries) - let get_rules (x:fixedpoint) = + 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 get_assertions (x:fixedpoint) = let av = Z3native.fixedpoint_get_assertions (gc x) x in (AST.ASTVector.to_expr_list av) @@ -1960,153 +1956,153 @@ struct end -module Optimize = -struct +module Optimize = +struct type optimize = Z3native.optimize - type handle = { opt:optimize; h:int } - - let mk_handle (x:optimize) h = { opt = x; h = h } + type handle = { opt:optimize; h:int } - 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 mk_handle (x:optimize) h = { opt = x; h = 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:optimize) (constraints:expr list) = - let f e = Z3native.optimize_assert (gc x) x e in - List.iter f constraints - - let add_soft (x:optimize) (e:Expr.expr) (w:string) (s:Symbol.symbol) = + + let add (x:optimize) (constraints:expr list) = + let f e = Z3native.optimize_assert (gc x) x e in + List.iter f 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 q) then None else Some q - + + 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_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 - - +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 ctx name logic status attributes (List.length assumptions) (Array.of_list 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 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 + if (csn != cs || cdn != cd) then raise (Error "Argument size mismatch") else - Z3native.parse_smtlib_string ctx str - cs + Z3native.parse_smtlib_string ctx str + cs (Array.of_list sort_names) (Array.of_list sorts) - cd + cd (Array.of_list decl_names) (Array.of_list 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 + if (csn != cs || cdn != cd) then raise (Error "Argument size mismatch") else Z3native.parse_smtlib_file ctx file_name - cs + cs (Array.of_list sort_names) (Array.of_list sorts) - cd + cd (Array.of_list decl_names) (Array.of_list decls) - + let get_num_smtlib_formulas (ctx:context) = Z3native.get_smtlib_num_formulas ctx - + 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 - + mk_list f n + let get_num_smtlib_assumptions (ctx:context) = Z3native.get_smtlib_num_assumptions ctx - + 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_decls (ctx:context) = Z3native.get_smtlib_num_decls ctx - - let get_smtlib_decls (ctx:context) = + + 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 get_num_smtlib_sorts (ctx:context) = Z3native.get_smtlib_num_sorts ctx - - let get_smtlib_sorts (ctx:context) = + + 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 + if (csn != cs || cdn != cd) then raise (Error "Argument size mismatch") else - Z3native.parse_smtlib2_string ctx str - cs + Z3native.parse_smtlib2_string ctx str + cs (Array.of_list sort_names) (Array.of_list sorts) - cd + cd (Array.of_list decl_names) (Array.of_list 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 + if (csn != cs || cdn != cd) then raise (Error "Argument size mismatch") else Z3native.parse_smtlib2_string ctx file_name - cs + cs (Array.of_list sort_names) (Array.of_list sorts) - cd + cd (Array.of_list decl_names) (Array.of_list decls) end - -module Interpolation = + +module Interpolation = struct let mk_interpolant (ctx:context) (a:expr) = Z3native.mk_interpolant ctx a - + 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 @@ -2116,11 +2112,11 @@ struct 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 = 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 ctx pat p in let res = (lbool_of_int r) in @@ -2128,23 +2124,23 @@ struct | L_TRUE -> (res, None, Some(model)) | L_FALSE -> (res, Some(AST.ASTVector.to_expr_list interp), None) | _ -> (res, None, None) - + let get_interpolation_profile (ctx:context) = Z3native.interpolation_profile ctx - + 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 + match r with | 0 -> raise (Error "Interpolation problem could not be read.") | _ -> let f1 i = Array.get cnsts i in let f2 i = Array.get parents i in - let f3 i = Array.get theory i in + let f3 i = 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 ctx + let (r, str) = Z3native.check_interpolant ctx num (Array.of_list cnsts) (Array.of_list parents) @@ -2155,12 +2151,12 @@ struct | 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 (Array.of_list cnsts) (Array.of_list parents) filename num_theory (Array.of_list theory)) ; () end - + let set_global_param (id:string) (value:string) = (Z3native.global_param_set id value) @@ -2168,7 +2164,7 @@ let get_global_param (id:string) = let (r, v) = (Z3native.global_param_get id) in if not r then None - else + else Some v let global_param_reset_all = diff --git a/src/api/ml/z3native.ml.pre b/src/api/ml/z3native.ml.pre index 28c6c7d91..87a069df9 100644 --- a/src/api/ml/z3native.ml.pre +++ b/src/api/ml/z3native.ml.pre @@ -32,75 +32,5 @@ and optimize = ptr and param_descrs = ptr and rcf_num = ptr -external is_null : ptr -> bool - = "n_is_null" - -external mk_null : unit -> ptr - = "n_mk_null" - external set_internal_error_handler : ptr -> unit = "n_set_internal_error_handler" - - -external context_of_symbol : symbol -> context - = "n_context_of_symbol" - -external context_of_constructor : constructor -> context - = "n_context_of_constructor" - -external context_of_constructor_list : constructor_list -> context - = "n_context_of_constructor_list" - -external context_of_rcf_num : rcf_num -> context - = "n_context_of_rcf_num" - - -external context_of_ast : ast -> context - = "n_context_of_ast" - -external context_of_params : params -> context - = "n_context_of_params" - -external context_of_param_descrs : param_descrs -> context - = "n_context_of_param_descrs" - -external context_of_model : model -> context - = "n_context_of_model" - -external context_of_func_interp : func_interp -> context - = "n_context_of_func_interp" - -external context_of_func_entry : func_entry -> context - = "n_context_of_func_entry" - -external context_of_goal : goal -> context - = "n_context_of_goal" - -external context_of_tactic : tactic -> context - = "n_context_of_tactic" - -external context_of_probe : probe -> context - = "n_context_of_probe" - -external context_of_apply_result : apply_result -> context - = "n_context_of_apply_result" - -external context_of_solver : solver -> context - = "n_context_of_solver" - -external context_of_stats : stats -> context - = "n_context_of_stats" - -external context_of_ast_vector : ast_vector -> context - = "n_context_of_ast_vector" - -external context_of_ast_map : ast_map -> context - = "n_context_of_ast_map" - -external context_of_fixedpoint : fixedpoint -> context - = "n_context_of_fixedpoint" - -external context_of_optimize : optimize -> context - = "n_context_of_optimize" - - diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index de8ba62e6..c726d967f 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -72,10 +72,27 @@ static struct custom_operations default_custom_ops = { Z3_ ## X ## _plus * p = (Z3_ ## X ## _plus *) Data_custom_val(v); \ cp = p->cp; \ result = caml_alloc_custom(&Z3_context_plus_custom_ops, sizeof(Z3_context_plus), 0, 1); \ - *(Z3_context_plus*)Data_custom_val(result) = cp; \ - /* We increment the usage counter of the context */ \ + *(Z3_context_plus *)Data_custom_val(result) = cp; \ + /* We increment the usage counter of the context, as we just \ + created a second custom block holding that context */ \ cp->obj_count++; \ CAMLreturn(result); \ + } \ + \ + CAMLprim value DLL_PUBLIC n_is_null_ ## X (value v) { \ + CAMLparam1(v); \ + Z3_ ## X ## _plus* pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \ + CAMLreturn(Val_bool(pp->p == NULL)); \ + } \ + \ + CAMLprim value DLL_PUBLIC n_mk_null_ ## X (value v) { \ + CAMLparam1(v); \ + CAMLlocal1(result); \ + Z3_context_plus cp = *(Z3_context_plus*)(Data_custom_val(v)); \ + Z3_ ## X ## _plus a = Z3_ ## X ## _plus_mk(cp, NULL); \ + result = caml_alloc_custom(&Z3_ ## X ## _plus_custom_ops, sizeof(Z3_ ## X ## _plus), 0, 1); \ + *(Z3_ ## X ## _plus*)(Data_custom_val(result)) = a; \ + CAMLreturn(result); \ } @@ -103,7 +120,8 @@ Z3_context_plus Z3_context_plus_mk(Z3_context c) { Z3_context_plus r = (Z3_context_plus)malloc(sizeof(Z3_context_plus_data)); r->ctx = c; /* The context created here will be wrapped into a custom block. - Hence, we assign it a counter of one. */ + We regard custom blocks that point to a Z3_context_plus structure + as a usage of this structure. Hence, we assign it a counter of one. */ r->obj_count = 1; return r; } @@ -113,17 +131,17 @@ Z3_context Z3_context_plus_raw(Z3_context_plus * cp) { } inline void try_to_delete_context(Z3_context_plus cp) { - if (cp->obj_count > 0) - /* printf("try_to_delete_context: Not deleting context %p(%p) with cnt=%lu.\n", cp, cp->ctx, cp->obj_count) */ ; - else if (cp->obj_count < 0) - printf("try_to_delete_context: ERROR, found context %p(%p) with negative cnt=%lu.\n", cp, cp->ctx, cp->obj_count); - else { - printf("try_to_delete_context: Deleting context %p(%p) with cnt=%lu.\n", cp, cp->ctx, cp->obj_count); + if (cp->obj_count == 0) { + /* printf("try_to_delete_context: Deleting context %p(%p) with cnt=0.\n", cp, cp->ctx); */ Z3_del_context(cp->ctx); - cp->ctx = NULL; - cp->obj_count = 0; free(cp); } + /* + else if (cp->obj_count > 0) + printf("try_to_delete_context: Not deleting context %p(%p) with cnt=%lu.\n", cp, cp->ctx, cp->obj_count); + else if (cp->obj_count < 0) + printf("try_to_delete_context: ERROR, found context %p(%p) with negative cnt=%lu.\n", cp, cp->ctx, cp->obj_count); + */ } void Z3_context_finalize(value v) { @@ -147,27 +165,29 @@ static struct custom_operations Z3_context_plus_custom_ops = { typedef struct { Z3_context_plus cp; - Z3_ast a; + Z3_ast p; } Z3_ast_plus; -Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus cp, Z3_ast a) { +Z3_ast_plus Z3_ast_plus_mk(Z3_context_plus cp, Z3_ast p) { Z3_ast_plus r; r.cp = cp; - r.a = a; + r.p = p; /* printf("++\n"); */ cp->obj_count++; - Z3_inc_ref(cp->ctx, a); + if (p != NULL) + Z3_inc_ref(cp->ctx, p); return r; } Z3_ast Z3_ast_plus_raw(Z3_ast_plus * ap) { - return ap->a; + return ap->p; } void Z3_ast_finalize(value v) { /* printf("--\n"); */ Z3_ast_plus * ap = (Z3_ast_plus*)(Data_custom_val(v)); - Z3_dec_ref(ap->cp->ctx, ap->a); + if (ap->p != NULL) + Z3_dec_ref(ap->cp->ctx, ap->p); ap->cp->obj_count--; try_to_delete_context(ap->cp); } @@ -176,8 +196,14 @@ int Z3_ast_compare(value v1, value v2) { Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1); Z3_ast_plus * a2 = (Z3_ast_plus*)Data_custom_val(v2); assert(a1->cp->ctx == a2->cp->ctx); - unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->a); - unsigned id2 = Z3_get_ast_id(a2->cp->ctx, a2->a); + if (a1->p == NULL && a2->p == NULL) + return 0; + if (a1->p == NULL) + return -1; + if (a2->p == NULL) + return +1; + unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->p); + unsigned id2 = Z3_get_ast_id(a2->cp->ctx, a2->p); if (id1 == id2) return 0; else if (id1 < id2) @@ -188,8 +214,15 @@ int Z3_ast_compare(value v1, value v2) { int Z3_ast_compare_ext(value v1, value v2) { Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1); - unsigned id1 = Z3_get_ast_id(a1->cp->ctx, a1->a); + unsigned id1; int id2 = Val_int(v2); + if (a1->p == NULL && id2 == 0) + return 0; + if (a1->p == NULL) + return -1; + if (id2 == 0) + return +1; + id1 = Z3_get_ast_id(a1->cp->ctx, a1->p); if (id1 == id2) return 0; else if (id1 < id2) @@ -200,7 +233,10 @@ int Z3_ast_compare_ext(value v1, value v2) { intnat Z3_ast_hash(value v) { Z3_ast_plus * ap = (Z3_ast_plus*)Data_custom_val(v); - return Z3_get_ast_hash(ap->cp->ctx, ap->a); + if (ap->p == NULL) + return 0; + else + return Z3_get_ast_hash(ap->cp->ctx, ap->p); } static struct custom_operations Z3_ast_plus_custom_ops = { @@ -215,9 +251,6 @@ static struct custom_operations Z3_ast_plus_custom_ops = { MK_CTX_OF(ast) - - - #define MK_PLUS_OBJ_NO_REF(X) \ typedef struct { \ Z3_context_plus cp; \ @@ -241,7 +274,7 @@ MK_CTX_OF(ast) pp->cp->obj_count--; \ try_to_delete_context(pp->cp); \ } \ - \ + \ static struct custom_operations Z3_ ## X ## _plus_custom_ops = { \ (char*) "Z3_" #X " ops", \ Z3_ ## X ## _finalize, \ @@ -265,7 +298,8 @@ MK_CTX_OF(ast) r.cp = cp; \ r.p = p; \ r.cp->obj_count++; \ - Z3_ ## X ## _inc_ref(cp->ctx, p); \ + if (p != NULL) \ + Z3_ ## X ## _inc_ref(cp->ctx, p); \ return r; \ } \ \ @@ -275,7 +309,8 @@ MK_CTX_OF(ast) \ void Z3_ ## X ## _finalize(value v) { \ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \ - Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \ + if (pp->p != NULL) \ + Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \ pp->cp->obj_count--; \ try_to_delete_context(pp->cp); \ } \ @@ -292,8 +327,6 @@ MK_CTX_OF(ast) \ MK_CTX_OF(X) - - MK_PLUS_OBJ_NO_REF(symbol) MK_PLUS_OBJ_NO_REF(constructor) MK_PLUS_OBJ_NO_REF(constructor_list) @@ -319,19 +352,6 @@ MK_PLUS_OBJ(optimize) extern "C" { #endif -CAMLprim DLL_PUBLIC value n_is_null(value p) { - void * t = * (void**) Data_custom_val(p); - return Val_bool(t == 0); -} - -CAMLprim DLL_PUBLIC value n_mk_null( void ) { - CAMLparam0(); - CAMLlocal1(result); - result = caml_alloc(1, 0); - result = Val_int(0); - CAMLreturn (result); -} - void MLErrorHandler(Z3_context c, Z3_error_code e) { /* Internal do-nothing error handler. This is required to avoid that Z3 calls exit() From 71f991c5dff3ab224e2c87ae6a434dee07558fbf Mon Sep 17 00:00:00 2001 From: martin-neuhaeusser Date: Tue, 5 Apr 2016 12:51:03 +0200 Subject: [PATCH 14/25] Avoid using physical equality checks in OCaml bindings (z3.ml) This patch avoids the use of physical equality wherever possible and improves some details of the OCaml implementation. --- src/api/ml/z3.ml | 1256 +++++++++++++++---------------- src/api/ml/z3.mli | 1015 +++++++++++++------------ src/api/ml/z3native_stubs.c.pre | 92 ++- 3 files changed, 1192 insertions(+), 1171 deletions(-) diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml index e6e832572..c558038ca 100644 --- a/src/api/ml/z3.ml +++ b/src/api/ml/z3.ml @@ -14,9 +14,10 @@ type context = Z3native.context 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 @@ -29,29 +30,28 @@ struct 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 + string_of_int mn ^ "." ^ + string_of_int bld ^ "." ^ + string_of_int rev 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 [] + 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) ; + (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 ; + 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 @@ -59,26 +59,22 @@ let mk_context (settings:(string * string) list) = module Symbol = struct type symbol = Z3native.symbol - let gc (o:symbol) = (Z3native.context_of_symbol o) + let gc = Z3native.context_of_symbol - let kind (o:symbol) = (symbol_kind_of_int (Z3native.get_symbol_kind (gc o) 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 (gc o) o) - let get_string (o:symbol) = (Z3native.get_symbol_string (gc o) o) + let kind (o:symbol) = symbol_kind_of_int (Z3native.get_symbol_kind (gc o) 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 (gc o) o + let get_string (o:symbol) = Z3native.get_symbol_string (gc o) o let to_string (o:symbol) = - 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) + 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 mk_int (ctx:context) (i:int) = (Z3native.mk_int_symbol ctx i) - let mk_string (ctx:context) (s:string) = (Z3native.mk_string_symbol ctx s) - - let mk_ints (ctx:context) (names:int list) = - List.map (fun x -> mk_int ctx x) names - - let mk_strings (ctx:context) (names:string list) = - List.map (fun x -> mk_string ctx x) names + let mk_int = Z3native.mk_int_symbol + let mk_string = Z3native.mk_string_symbol + let mk_ints (ctx:context) (names:int list) = List.map (mk_int ctx) names + let mk_strings (ctx:context) (names:string list) = List.map (mk_string ctx) names end @@ -129,14 +125,14 @@ sig val translate : ast -> context -> ast end = struct type ast = Z3native.ast - let gc (x:ast) = Z3native.context_of_ast x + let gc = Z3native.context_of_ast module ASTVector = struct type ast_vector = Z3native.ast_vector - let gc (x:ast_vector) = Z3native.context_of_ast_vector x + let gc = Z3native.context_of_ast_vector - let mk_ast_vector (ctx:context) = Z3native.mk_ast_vector ctx + 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 @@ -145,12 +141,12 @@ end = struct let translate (x:ast_vector) (to_ctx:context) = Z3native.ast_vector_translate (gc x) x to_ctx let to_list (x:ast_vector) = - let xs = (get_size x) in - let f i = (get x i) in + 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 xs = get_size x in let f i = get x i in mk_list f xs @@ -160,9 +156,9 @@ end = struct module ASTMap = struct type ast_map = Z3native.ast_map - let gc (x:ast_map) = Z3native.context_of_ast_map x + let gc = Z3native.context_of_ast_map - let mk_ast_map (ctx:context) = Z3native.mk_ast_map ctx + 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 @@ -171,48 +167,41 @@ end = struct let get_size (x:ast_map) = Z3native.ast_map_size (gc x) x let get_keys (x:ast_map) = - let av = (Z3native.ast_map_keys (gc x) x) in - (ASTVector.to_list av) + let av = Z3native.ast_map_keys (gc x) x in + ASTVector.to_list av let to_string (x:ast_map) = Z3native.ast_map_to_string (gc x) x end 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 get_ast_kind (x:ast) = ast_kind_of_int (Z3native.get_ast_kind (gc x) x) let is_expr (x:ast) = - match get_ast_kind (x:ast) with + 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 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 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 = (=) - let equal (a:ast) (b:ast) = - (a == b) || - (if (gc a) != (gc b) then - false - else - Z3native.is_eq_ast (gc a) a 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 + (* 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 + if gc x = to_ctx then x else Z3native.translate (gc x) x to_ctx @@ -231,31 +220,26 @@ sig val mk_uninterpreted_s : context -> string -> sort end = struct type sort = Z3native.sort - let gc (x:sort) = Z3native.context_of_ast x + let gc = Z3native.context_of_ast - let equal:sort -> sort -> bool = fun a b -> - (a == b) || - (if (gc a) != (gc b) then - false - else - Z3native.is_eq_sort (gc a) a b) + let equal a b = (a = b) || (gc a = gc b && Z3native.is_eq_sort (gc a) a b) 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 (ctx:context) (s:Symbol.symbol) = Z3native.mk_uninterpreted_sort ctx s + 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 = Z3native.func_decl -val gc : func_decl -> context + val gc : func_decl -> context 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 @@ -292,7 +276,7 @@ val gc : func_decl -> context val apply : func_decl -> Expr.expr list -> Expr.expr end = struct type func_decl = AST.ast - let gc (x:func_decl) = Z3native.context_of_ast x + let gc = Z3native.context_of_ast module Parameter = struct @@ -305,50 +289,42 @@ end = struct | 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_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_int (x:parameter) = - match x with - | P_Int(x) -> x - | _ -> raise (Error "parameter is not an int") + let get_int = function + | P_Int x -> x + | _ -> raise (Error "parameter is not an int") - let get_float (x:parameter) = - match x with - | P_Dbl(x) -> x - | _ -> raise (Error "parameter is not a float") + let get_float = function + | P_Dbl x -> x + | _ -> raise (Error "parameter is not a float") - let get_symbol (x:parameter) = - match x with - | P_Sym(x) -> x - | _ -> raise (Error "parameter is not a symbol") + let get_symbol = function + | P_Sym x -> x + | _ -> raise (Error "parameter is not a symbol") - let get_sort (x:parameter) = - match x with - | P_Srt(x) -> x - | _ -> raise (Error "parameter is not a sort") + let get_sort = function + | P_Srt x -> x + | _ -> raise (Error "parameter is not a sort") - let get_ast (x:parameter) = - match x with - | P_Ast(x) -> x - | _ -> raise (Error "parameter is not an ast") + let get_ast = function + | P_Ast x -> x + | _ -> raise (Error "parameter is not an ast") - let get_func_decl (x:parameter) = - match x with - | P_Fdl(x) -> x - | _ -> raise (Error "parameter is not a func_decl") + let get_func_decl = function + | P_Fdl x -> x + | _ -> raise (Error "parameter is not a func_decl") - let get_rational (x:parameter) = - match x with - | P_Rat(x) -> x - | _ -> raise (Error "parameter is not a rational string") + 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) = @@ -369,12 +345,7 @@ end = struct let mk_fresh_const_decl (ctx:context) (prefix:string) (range:Sort.sort) = Z3native.mk_fresh_func_decl ctx prefix 0 [||] range - let equal (a:func_decl) (b:func_decl) = - (a == b) || - (if (gc a) != (gc b) then - false - else - Z3native.is_eq_func_decl (gc a) a b) + let equal a b = (a = b) || (gc a = gc b && Z3native.is_eq_func_decl (gc a) a 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 @@ -382,7 +353,7 @@ end = struct let get_domain_size (x:func_decl) = Z3native.get_domain_size (gc x) x let get_domain (x:func_decl) = - let n = (get_domain_size x) in + let n = get_domain_size x in let f i = Z3native.get_domain (gc x) x i in mk_list f n @@ -392,15 +363,17 @@ end = struct 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 + 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 + | 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 @@ -430,12 +403,12 @@ sig val set_print_mode : context -> Z3enums.ast_print_mode -> unit end = struct type params = Z3native.params - let gc (x:params) = Z3native.context_of_params x + let gc = Z3native.context_of_params module ParamDescrs = struct type param_descrs = Z3native.param_descrs - let gc (x:param_descrs) = Z3native.context_of_param_descrs x + let gc = Z3native.context_of_param_descrs 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) @@ -499,19 +472,20 @@ sig val compare : expr -> expr -> int end = struct type expr = AST.ast - let gc (e:expr) = Z3native.context_of_ast e + let gc = Z3native.context_of_ast - let expr_of_ast (a:AST.ast) : expr = + 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 + if q <> Z3enums.APP_AST && q <> VAR_AST && q <> QUANTIFIER_AST && q <> NUMERAL_AST then raise (Error "Invalid coercion") else a - let ast_of_expr (e:expr) : AST.ast = e + let ast_of_expr e = e - let expr_of_func_app:context -> FuncDecl.func_decl -> expr list -> expr = - fun ctx f args -> (Z3native.mk_app ctx f (List.length args) (Array.of_list args)) + let expr_of_func_app ctx f args = + let arg_array = Array.of_list args in + Z3native.mk_app ctx f (Array.length arg_array) arg_array let apply1 ctx f t = f ctx t let apply2 ctx f t1 t2 = f ctx t1 t2 @@ -523,32 +497,36 @@ end = struct | None -> Z3native.simplify (gc x) x | Some pp -> Z3native.simplify_ex (gc x) x pp - let get_simplify_help (ctx:context) = Z3native.simplify_get_help ctx - let get_simplify_parameter_descrs (ctx:context) = Z3native.simplify_get_param_descrs ctx + 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 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 + if AST.is_app x && List.length args <> get_num_args x then raise (Error "Number of arguments does not match") else Z3native.update_term (gc x) x (List.length args) (Array.of_list args) let substitute (x:expr) (from:expr list) (to_:expr list) = - if (List.length from) <> (List.length to_) then + let from_array = Array.of_list from in + let to_array = Array.of_list to_ in + if Array.length from_array <> Array.length to_array then raise (Error "Argument sizes do not match") else - Z3native.substitute (gc x) x (List.length from) (Array.of_list from) (Array.of_list to_) + Z3native.substitute (gc x) x (Array.length from_array) from_array to_array - let substitute_one (x:expr) (from:expr) (to_:expr) = substitute (x:expr) [ from ] [ to_ ] - let substitute_vars (x:expr) (to_:expr list) = Z3native.substitute_vars (gc x) x (List.length to_) (Array.of_list to_) + let substitute_one x from to_ = substitute x [ from ] [ to_ ] + let substitute_vars x to_ = + let to_array = Array.of_list to_ in + Z3native.substitute_vars (gc x) x (Array.length to_array) to_array let translate (x:expr) to_ctx = - if (gc x) == to_ctx then + if gc x = to_ctx then x else Z3native.translate (gc x) x to_ctx @@ -558,9 +536,9 @@ end = struct 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 + AST.is_app x + && 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) = 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 @@ -578,11 +556,11 @@ open Expr module Boolean = struct - let mk_sort (ctx:context) = Z3native.mk_bool_sort ctx + 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 (ctx:context) = Z3native.mk_true ctx - let mk_false (ctx:context) = Z3native.mk_false ctx + 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 (ctx:context) (a:expr) = apply1 ctx Z3native.mk_not a let mk_ite (ctx:context) (t1:expr) (t2:expr) (t3:expr) = apply3 ctx Z3native.mk_ite t1 t2 t3 @@ -595,33 +573,34 @@ struct let mk_distinct (ctx:context) (args:expr list) = Z3native.mk_distinct ctx (List.length args) (Array.of_list args) let get_bool_value (x:expr) = lbool_of_int (Z3native.get_bool_value (gc x) x) - let is_bool (x:expr) = - (AST.is_expr x) && (Z3native.is_eq_sort (gc x) (Z3native.mk_bool_sort (gc x)) (Z3native.get_sort (gc x) x)) + 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 is_true (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_TRUE) - let is_false (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_FALSE) - let is_eq (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_EQ) - let is_distinct (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_DISTINCT) - let is_ite (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_ITE) - let is_and (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_AND) - let is_or (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_OR) - let is_iff (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_IFF) - let is_xor (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_XOR) - let is_not (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (get_func_decl x) == OP_NOT) - let is_implies (x:expr) = (AST.is_app 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 = AST.ast - let gc (x:quantifier) = Z3native.context_of_ast x + let gc = Z3native.context_of_ast - let expr_of_quantifier (q:quantifier) : Expr.expr = q + let expr_of_quantifier q = q - let quantifier_of_expr (e:Expr.expr) : quantifier = - let q = (Z3enums.ast_kind_of_int (Z3native.get_ast_kind (gc e) e)) in - if (q != Z3enums.QUANTIFIER_AST) then + let quantifier_of_expr e = + 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 @@ -630,7 +609,7 @@ struct module Pattern = struct type pattern = Z3native.pattern - let gc (x:pattern) = Z3native.context_of_ast x + let gc = Z3native.context_of_ast let get_num_terms (x:pattern) = Z3native.get_pattern_num_terms (gc x) x @@ -653,26 +632,26 @@ struct let get_weight (x:quantifier) = Z3native.get_quantifier_weight (gc x) x let get_num_patterns (x:quantifier) = Z3native.get_quantifier_num_patterns (gc x) x let get_patterns (x:quantifier) = - let n = (get_num_patterns x) in + 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 (gc x) x let get_no_patterns (x:quantifier) = - let n = (get_num_patterns x) in + 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 (gc x) x let get_bound_variable_names (x:quantifier) = - let n = (get_num_bound x) in + 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 n = get_num_bound x in let f i = Z3native.get_quantifier_bound_sort (gc x) x i in mk_list f n @@ -680,86 +659,86 @@ struct let mk_bound (ctx:context) (index:int) (ty:Sort.sort) = Z3native.mk_bound ctx index ty let mk_pattern (ctx:context) (terms:expr list) = - if (List.length terms) == 0 then + if List.length terms = 0 then raise (Error "Cannot create a pattern from zero terms") else Z3native.mk_pattern ctx (List.length terms) (Array.of_list 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 + if (List.length sorts) <> (List.length names) then raise (Error "Number of sorts does not match number of names") - else if ((List.length nopatterns) == 0 && quantifier_id == None && skolem_id == None) then + else if ((List.length nopatterns) = 0 && quantifier_id = None && skolem_id = None) then Z3native.mk_quantifier ctx true - (match weight with | None -> 1 | Some(x) -> x) - (List.length patterns) (Array.of_list patterns) - (List.length sorts) (Array.of_list sorts) - (Array.of_list names) - body + (match weight with | None -> 1 | Some(x) -> x) + (List.length patterns) (Array.of_list patterns) + (List.length sorts) (Array.of_list sorts) + (Array.of_list names) + body else Z3native.mk_quantifier_ex ctx true - (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) (Array.of_list patterns) - (List.length nopatterns) (Array.of_list nopatterns) - (List.length sorts) (Array.of_list sorts) - (Array.of_list names) - body + (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) (Array.of_list patterns) + (List.length nopatterns) (Array.of_list nopatterns) + (List.length sorts) (Array.of_list sorts) + (Array.of_list names) + 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 + if ((List.length nopatterns) = 0 && quantifier_id = None && skolem_id = None) then Z3native.mk_quantifier_const ctx true - (match weight with | None -> 1 | Some(x) -> x) - (List.length bound_constants) (Array.of_list bound_constants) - (List.length patterns) (Array.of_list patterns) - body + (match weight with | None -> 1 | Some(x) -> x) + (List.length bound_constants) (Array.of_list bound_constants) + (List.length patterns) (Array.of_list patterns) + body else Z3native.mk_quantifier_const_ex ctx true - (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) (Array.of_list bound_constants) - (List.length patterns) (Array.of_list patterns) - (List.length nopatterns) (Array.of_list nopatterns) - body + (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) (Array.of_list bound_constants) + (List.length patterns) (Array.of_list patterns) + (List.length nopatterns) (Array.of_list nopatterns) + 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 + if (List.length sorts) <> (List.length names) then raise (Error "Number of sorts does not match number of names") - else if ((List.length nopatterns) == 0 && quantifier_id == None && skolem_id == None) then + else if ((List.length nopatterns) = 0 && quantifier_id = None && skolem_id = None) then Z3native.mk_quantifier ctx false - (match weight with | None -> 1 | Some(x) -> x) - (List.length patterns) (Array.of_list patterns) - (List.length sorts) (Array.of_list sorts) - (Array.of_list names) - body + (match weight with | None -> 1 | Some(x) -> x) + (List.length patterns) (Array.of_list patterns) + (List.length sorts) (Array.of_list sorts) + (Array.of_list names) + body else Z3native.mk_quantifier_ex ctx false - (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) (Array.of_list patterns) - (List.length nopatterns) (Array.of_list nopatterns) - (List.length sorts) (Array.of_list sorts) - (Array.of_list names) - body + (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) (Array.of_list patterns) + (List.length nopatterns) (Array.of_list nopatterns) + (List.length sorts) (Array.of_list sorts) + (Array.of_list names) + 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 + if ((List.length nopatterns) = 0 && quantifier_id = None && skolem_id = None) then Z3native.mk_quantifier_const ctx false - (match weight with | None -> 1 | Some(x) -> x) - (List.length bound_constants) (Array.of_list bound_constants) - (List.length patterns) (Array.of_list patterns) - body -else - Z3native.mk_quantifier_const_ex ctx false - (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) (Array.of_list bound_constants) - (List.length patterns) (Array.of_list patterns) - (List.length nopatterns) (Array.of_list nopatterns) - body + (match weight with | None -> 1 | Some(x) -> x) + (List.length bound_constants) (Array.of_list bound_constants) + (List.length patterns) (Array.of_list patterns) + body + else + Z3native.mk_quantifier_const_ex ctx false + (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) (Array.of_list bound_constants) + (List.length patterns) (Array.of_list patterns) + (List.length nopatterns) (Array.of_list 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 @@ -780,16 +759,16 @@ end module Z3Array = struct let mk_sort (ctx:context) (domain:Sort.sort) (range:Sort.sort) = Z3native.mk_array_sort ctx domain range - let is_store (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_STORE) - let is_select (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_SELECT) - let is_constant_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_CONST_ARRAY) - let is_default_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ARRAY_DEFAULT) - let is_array_map (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_ARRAY_MAP) - let is_as_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) == OP_AS_ARRAY) + let is_store (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_STORE) + let is_select (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SELECT) + let is_constant_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_CONST_ARRAY) + let is_default_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ARRAY_DEFAULT) + let is_array_map (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ARRAY_MAP) + let is_as_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_AS_ARRAY) let is_array (x:expr) = (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) + ((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) = Z3native.get_array_sort_domain (Sort.gc x) x let get_range (x:Sort.sort) = Z3native.get_array_sort_range (Sort.gc x) x @@ -813,11 +792,11 @@ module Set = struct let mk_sort (ctx:context) (ty:Sort.sort) = Z3native.mk_set_sort ctx ty - 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 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 mk_empty (ctx:context) (domain:Sort.sort) = Z3native.mk_empty_set ctx domain let mk_full (ctx:context) (domain:Sort.sort) = Z3native.mk_full_set ctx domain @@ -843,9 +822,9 @@ struct 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) + (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 is_lt (x:expr) = (AST.is_app 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.gc x) x) in @@ -859,21 +838,21 @@ struct let is_relation (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)) == RELATION_SORT)) + (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 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 @@ -891,30 +870,30 @@ struct 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) + 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 + 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 (Error "Number of field names does not match number of sort refs") - else - let no = Z3native.mk_constructor ctx name - recognizer - n - (Array.of_list field_names) - (let f x = match x with None -> Z3native.mk_null_ast ctx | Some s -> s in - Array.of_list (List.map f sorts)) - (Array.of_list sort_refs) in - FieldNumTable.add _field_nums no n ; - no + 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 + (Array.of_list field_names) + (let f x = match x with None -> Z3native.mk_null_ast ctx | Some s -> s in + Array.of_list (List.map f sorts)) + (Array.of_list sort_refs) in + FieldNumTable.add _field_nums no n; + no let get_num_fields (x:constructor) = FieldNumTable.find _field_nums x @@ -1055,25 +1034,25 @@ end module Arithmetic = struct 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) + ((sort_kind_of_int (Z3native.get_sort_kind (Expr.gc x) (Z3native.get_sort (Expr.gc x) x))) = INT_SORT) - 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_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 @@ -1123,7 +1102,7 @@ struct 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 + if (den = 0) then raise (Error "Denominator is zero") else Z3native.mk_real ctx num den @@ -1159,58 +1138,58 @@ module BitVector = 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) + ((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) = let (r, v) = Z3native.get_numeral_int (Expr.gc x) x in @@ -1277,7 +1256,7 @@ struct module RoundingMode = struct let mk_sort (ctx:context) = Z3native.mk_fpa_rounding_mode_sort ctx - let is_fprm (x:expr) = (Sort.get_sort_kind (Expr.get_sort(x))) == ROUNDING_MODE_SORT + 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) = Z3native.mk_fpa_round_nearest_ties_to_even ctx let mk_rne (ctx:context) = Z3native.mk_fpa_rne ctx let mk_round_nearest_ties_to_away (ctx:context) = Z3native.mk_fpa_round_nearest_ties_to_away ctx @@ -1309,37 +1288,37 @@ struct let mk_numeral_i_u (ctx:context) (sign:bool) (exponent:int) (significand:int) (s:Sort.sort) = Z3native.mk_fpa_numeral_int64_uint64 ctx sign exponent significand s let mk_numeral_s (ctx:context) (v:string) (s:Sort.sort) = Z3native.mk_numeral ctx v 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 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 numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) x let mk_const (ctx:context) (name:Symbol.symbol) (s:Sort.sort) = @@ -1394,63 +1373,61 @@ end module Proof = struct - 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) + 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 = Z3native.goal - let gc (x:goal) = Z3native.context_of_goal x + let gc = Z3native.context_of_goal 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_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 add (x:goal) (constraints:expr list) = - let f e = Z3native.goal_assert (gc x) x e in - ignore (List.map f constraints) ; - () + let add x constraints = + List.iter (Z3native.goal_assert (gc x) x) constraints let is_inconsistent (x:goal) = Z3native.goal_inconsistent (gc x) x let get_depth (x:goal) = Z3native.goal_depth (gc x) x @@ -1469,51 +1446,50 @@ struct let simplify (x:goal) (p:Params.params option) = let tn = Z3native.mk_tactic (gc x) "simplify" in - Z3native.tactic_inc_ref (gc x) tn ; + Z3native.tactic_inc_ref (gc x) tn; let arn = match p with | None -> Z3native.tactic_apply (gc x) tn x - | Some(pn) -> Z3native.tactic_apply_ex (gc x) tn x pn + | Some pn -> Z3native.tactic_apply_ex (gc x) tn x pn in - Z3native.apply_result_inc_ref (gc x) arn ; + 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 ; + 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) = - Z3native.mk_goal ctx models unsat_cores proofs + let mk_goal = Z3native.mk_goal 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 (gc x) - else if n = 1 then - List.hd (get_formulas x) - else - Boolean.mk_and (gc x) (get_formulas x) + let n = get_size x in + if n = 0 then + Boolean.mk_true (gc x) + else if n = 1 then + List.hd (get_formulas x) + else + Boolean.mk_and (gc x) (get_formulas x) end module Model = struct type model = Z3native.model - let gc (x:model) = Z3native.context_of_model x + let gc = Z3native.context_of_model module FuncInterp = struct type func_interp = Z3native.func_interp - let gc (x:func_interp) = Z3native.context_of_func_interp x + let gc = Z3native.context_of_func_interp module FuncEntry = struct type func_entry = Z3native.func_entry - let gc (x:func_entry) = Z3native.context_of_func_entry x + let gc = Z3native.context_of_func_entry 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 @@ -1544,18 +1520,18 @@ struct 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 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.gc f) (Z3native.get_range (FuncDecl.gc f) f))) == ARRAY_SORT then + 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 (gc x) x f in @@ -1568,18 +1544,18 @@ struct 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 + 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 + 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 (gc x) x f in @@ -1601,17 +1577,18 @@ struct 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 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 (gc x) x t completion in - if not r then None else Some v + match Z3native.model_eval (gc x) x t completion with + | (false, _) -> None + | (true, v) -> Some v - let evaluate (x:model) (t:expr) (completion:bool) = eval x t completion + let evaluate = eval let get_num_sorts (x:model) = Z3native.model_get_num_sorts (gc x) x let get_sorts (x:model) = @@ -1632,36 +1609,36 @@ struct type probe = Z3native.probe let apply (x:probe) (g:Goal.goal) = Z3native.probe_apply (gc x) x g - let get_num_probes (ctx:context) = Z3native.get_num_probes ctx + let get_num_probes = Z3native.get_num_probes 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 ctx name - let mk_probe (ctx:context) (name:string) = Z3native.mk_probe ctx name - let const (ctx:context) (v:float) = Z3native.probe_const ctx v - let lt (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_lt ctx p1 p2 - let gt (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_gt ctx p1 p2 - let le (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_le ctx p1 p2 - let ge (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_ge ctx p1 p2 - let eq (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_eq ctx p1 p2 - let and_ (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_and ctx p1 p2 - let or_ (ctx:context) (p1:probe) (p2:probe) = Z3native.probe_or ctx p1 p2 - let not_ (ctx:context) (p:probe) = Z3native.probe_not ctx 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 = Z3native.tactic - let gc (x:tactic) = Z3native.context_of_tactic x + let gc = Z3native.context_of_tactic module ApplyResult = struct type apply_result = Z3native.apply_result - let gc (x:apply_result) = Z3native.context_of_apply_result x + let gc = Z3native.context_of_apply_result let get_num_subgoals (x:apply_result) = Z3native.apply_result_get_num_subgoals (gc x) x @@ -1681,77 +1658,63 @@ struct 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 + | Some pn -> Z3native.tactic_apply_ex (gc x) x g pn - let get_num_tactics (ctx:context) = Z3native.get_num_tactics 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 ctx i in mk_list f n - let get_tactic_description (ctx:context) (name:string) = Z3native.tactic_get_descr ctx name - let mk_tactic (ctx:context) (name:string) = Z3native.mk_tactic ctx name + let get_tactic_description = Z3native.tactic_get_descr + let mk_tactic = Z3native.mk_tactic 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 + | None -> Some c + | Some(x) -> Some (Z3native.tactic_and_then ctx c x)) in match (List.fold_left f None ts) with | 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 + Z3native.tactic_and_then ctx t1 o - let or_else (ctx:context) (t1:tactic) (t2:tactic) = Z3native.tactic_or_else ctx t1 t2 - let try_for (ctx:context) (t:tactic) (ms:int) = Z3native.tactic_try_for ctx t ms - let when_ (ctx:context) (p:Probe.probe) (t:tactic) = Z3native.tactic_when ctx p t - let cond (ctx:context) (p:Probe.probe) (t1:tactic) (t2:tactic) = Z3native.tactic_cond ctx p t1 t2 - let repeat (ctx:context) (t:tactic) (max:int) = Z3native.tactic_repeat ctx t max - let skip (ctx:context) = Z3native.tactic_skip ctx - let fail (ctx:context) = Z3native.tactic_fail ctx - let fail_if (ctx:context) (p:Probe.probe) = Z3native.tactic_fail_if ctx p - let fail_if_not_decided (ctx:context) = Z3native.tactic_fail_if_not_decided ctx - let using_params (ctx:context) (t:tactic) (p:Params.params) = Z3native.tactic_using_params ctx t p - let with_ (ctx:context) (t:tactic) (p:Params.params) = using_params ctx t p + 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) (Array.of_list t) - let par_and_then (ctx:context) (t1:tactic) (t2:tactic) = Z3native.tactic_par_and_then ctx t1 t2 - let interrupt (ctx:context) = Z3native.interrupt ctx + let par_and_then = Z3native.tactic_par_and_then + let interrupt = Z3native.interrupt end module Statistics = struct type statistics = Z3native.stats - let gc (x:statistics) = Z3native.context_of_stats x + 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 } + m_key:string; + m_is_int:bool; + m_is_float:bool; + m_int:int; + 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 + { m_key = k; m_is_int = true; m_is_float = false; m_int = v; m_float = 0.0 } 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 + { 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 @@ -1759,9 +1722,9 @@ struct 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 + if is_int x then string_of_int (get_int x) - else if (is_float x) then + else if is_float x then string_of_float (get_float x) else raise (Error "Unknown statistical entry type") @@ -1773,12 +1736,13 @@ struct let get_entries (x:statistics) = let n = get_size x in - let f i = ( + 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)) + 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 + Entry.create_sd k (Z3native.stats_get_double_value (gc x) x i) + in mk_list f n let get_keys (x:statistics) = @@ -1787,8 +1751,8 @@ struct 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) + try Some(List.find (fun c -> Entry.get_key c = key) (get_entries x)) with + | Not_found -> None end @@ -1796,7 +1760,7 @@ module Solver = struct type solver = Z3native.solver type status = UNSATISFIABLE | UNKNOWN | SATISFIABLE - let gc (x:solver) = Z3native.context_of_solver x + let gc = Z3native.context_of_solver let string_of_status (s:status) = match s with | UNSATISFIABLE -> "unsatisfiable" @@ -1811,83 +1775,77 @@ struct let pop (x:solver) (n:int) = Z3native.solver_pop (gc x) x n let reset (x:solver) = Z3native.solver_reset (gc x) x - let add (x:solver) (constraints:expr list) = - let f e = (Z3native.solver_assert (gc x) x e) in - ignore (List.map f constraints) + let add x constraints = + List.iter (Z3native.solver_assert (gc x) x) constraints - let assert_and_track_l (x:solver) (cs:expr list) (ps:expr list) = - if ((List.length cs) != (List.length ps)) then - raise (Error "Argument size mismatch") - else - let f a b = Z3native.solver_assert_and_track (gc x) x a b in - ignore (List.iter2 f cs ps) + 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 assert_and_track (x:solver) (c:expr) (p:expr) = - Z3native.solver_assert_and_track (gc x) x c p + let assert_and_track x = Z3native.solver_assert_and_track (gc x) x - let get_num_assertions (x:solver) = + let get_num_assertions x = let a = Z3native.solver_get_assertions (gc x) x in AST.ASTVector.get_size a - let get_assertions (x:solver) = + let get_assertions x = let av = Z3native.solver_get_assertions (gc x) 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 (gc x) x) - else - lbool_of_int (Z3native.solver_check_assumptions (gc x) x (List.length assumptions) (Array.of_list assumptions)) + let result = + match assumptions with + | [] -> Z3native.solver_check (gc x) x + | _::_ -> + let assumption_array = Array.of_list assumptions in + Z3native.solver_check_assumptions (gc x) x (Array.length assumption_array) assumption_array in - match r with + match lbool_of_int result with | L_TRUE -> SATISFIABLE | L_FALSE -> UNSATISFIABLE | _ -> UNKNOWN - let get_model (x:solver) = + 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_proof (x:solver) = + 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 get_unsat_core (x:solver) = + 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:solver) = Z3native.solver_get_reason_unknown (gc x) x - let get_statistics (x:solver) = Z3native.solver_get_statistics (gc x) x + 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:context) (logic:Symbol.symbol option) = + let mk_solver ctx logic = match logic with | None -> Z3native.mk_solver ctx - | Some (x) -> Z3native.mk_solver_for_logic ctx x + | 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) = Z3native.mk_simple_solver ctx - let mk_solver_t (ctx:context) (t:Tactic.tactic) = Z3native.mk_solver_from_tactic ctx t - let translate (x:solver) (to_ctx:context) = Z3native.solver_translate (gc x) x to_ctx - let to_string (x:solver) = Z3native.solver_to_string (gc x) 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 = Z3native.fixedpoint - let gc (x:fixedpoint) = Z3native.context_of_fixedpoint x + let gc = Z3native.context_of_fixedpoint - let get_help (x:fixedpoint) = Z3native.fixedpoint_get_help (gc x) x - let set_parameters (x:fixedpoint) (p:Params.params) = Z3native.fixedpoint_set_params (gc x) x p - let get_param_descrs (x:fixedpoint) = Z3native.fixedpoint_get_param_descrs (gc x) x + 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 add (x:fixedpoint) (constraints:expr list) = - let f e = Z3native.fixedpoint_assert (gc x) x e in - ignore (List.map f constraints) ; - () + let add x constraints = + List.iter (Z3native.fixedpoint_assert (gc x) x) constraints - let register_relation (x:fixedpoint) (f:func_decl) = Z3native.fixedpoint_register_relation (gc x) x f + let register_relation x = Z3native.fixedpoint_register_relation (gc x) x let add_rule (x:fixedpoint) (rule:expr) (name:Symbol.symbol option) = match name with @@ -1898,27 +1856,27 @@ struct Z3native.fixedpoint_add_fact (gc x) x pred (List.length args) (Array.of_list args) 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 query_r (x:fixedpoint) (relations:func_decl list) = - match (lbool_of_int (Z3native.fixedpoint_query_relations (gc x) x (List.length relations) (Array.of_list relations))) with + match lbool_of_int (Z3native.fixedpoint_query (gc x) x query) with | L_TRUE -> Solver.SATISFIABLE | L_FALSE -> Solver.UNSATISFIABLE | _ -> Solver.UNKNOWN - let push (x:fixedpoint) = Z3native.fixedpoint_push (gc x) x - let pop (x:fixedpoint) = Z3native.fixedpoint_pop (gc x) x - let update_rule (x:fixedpoint) (rule:expr) (name:Symbol.symbol) = Z3native.fixedpoint_update_rule (gc x) x rule name + let query_r (x:fixedpoint) (relations:func_decl list) = + match lbool_of_int (Z3native.fixedpoint_query_relations (gc x) x (List.length relations) (Array.of_list relations)) with + | L_TRUE -> Solver.SATISFIABLE + | L_FALSE -> Solver.UNSATISFIABLE + | _ -> Solver.UNKNOWN - let get_answer (x:fixedpoint) = + 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_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_reason_unknown (x:fixedpoint) = Z3native.fixedpoint_get_reason_unknown (gc x) x - let get_num_levels (x:fixedpoint) (predicate:func_decl) = Z3native.fixedpoint_get_num_levels (gc x) x predicate + 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 get_cover_delta (x:fixedpoint) (level:int) (predicate:func_decl) = let q = Z3native.fixedpoint_get_cover_delta (gc x) x level predicate in @@ -1961,16 +1919,15 @@ struct type optimize = Z3native.optimize type handle = { opt:optimize; h:int } - let mk_handle (x:optimize) h = { opt = x; h = h } + 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:optimize) (constraints:expr list) = - let f e = Z3native.optimize_assert (gc x) x e in - List.iter f constraints + 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) @@ -1991,7 +1948,7 @@ struct 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 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 @@ -2003,40 +1960,40 @@ 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 ctx name logic status attributes - (List.length assumptions) (Array.of_list assumptions) - formula + (List.length assumptions) (Array.of_list 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 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 + if (csn <> cs || cdn <> cd) then raise (Error "Argument size mismatch") else Z3native.parse_smtlib_string ctx str - cs - (Array.of_list sort_names) - (Array.of_list sorts) - cd - (Array.of_list decl_names) - (Array.of_list decls) + cs + (Array.of_list sort_names) + (Array.of_list sorts) + cd + (Array.of_list decl_names) + (Array.of_list 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 + if (csn <> cs || cdn <> cd) then raise (Error "Argument size mismatch") else Z3native.parse_smtlib_file ctx file_name - cs - (Array.of_list sort_names) - (Array.of_list sorts) - cd - (Array.of_list decl_names) - (Array.of_list decls) + cs + (Array.of_list sort_names) + (Array.of_list sorts) + cd + (Array.of_list decl_names) + (Array.of_list decls) let get_num_smtlib_formulas (ctx:context) = Z3native.get_smtlib_num_formulas ctx @@ -2071,46 +2028,46 @@ struct 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") + if (csn <> cs || cdn <> cd) then + raise (Error "Argument size mismatch") else Z3native.parse_smtlib2_string ctx str - cs - (Array.of_list sort_names) - (Array.of_list sorts) - cd - (Array.of_list decl_names) - (Array.of_list decls) + cs + (Array.of_list sort_names) + (Array.of_list sorts) + cd + (Array.of_list decl_names) + (Array.of_list 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 + if (csn <> cs || cdn <> cd) then raise (Error "Argument size mismatch") else - Z3native.parse_smtlib2_string ctx file_name - cs - (Array.of_list sort_names) - (Array.of_list sorts) - cd - (Array.of_list decl_names) - (Array.of_list decls) + Z3native.parse_smtlib2_string ctx file_name + cs + (Array.of_list sort_names) + (Array.of_list sorts) + cd + (Array.of_list decl_names) + (Array.of_list decls) end module Interpolation = struct - let mk_interpolant (ctx:context) (a:expr) = Z3native.mk_interpolant ctx a + 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) ; + 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 ; + 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) = @@ -2121,60 +2078,55 @@ struct 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) + | L_TRUE -> (res, None, Some model) + | L_FALSE -> (res, Some (AST.ASTVector.to_expr_list interp), None) | _ -> (res, None, None) - let get_interpolation_profile (ctx:context) = Z3native.interpolation_profile ctx + 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 + 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.") | _ -> - let f1 i = Array.get cnsts i in - let f2 i = Array.get parents i in - let f3 i = Array.get theory i in - ((mk_list f1 num), - (mk_list f2 num), - (mk_list f3 num_theory)) + let f1 i = Array.get cnsts i in + let f2 i = Array.get parents i in + let f3 i = 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 ctx - num - (Array.of_list cnsts) - (Array.of_list parents) - (Array.of_list interps) - num_theory - (Array.of_list theory) in + num + (Array.of_list cnsts) + (Array.of_list parents) + (Array.of_list interps) + num_theory + (Array.of_list 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 (Array.of_list cnsts) (Array.of_list parents) filename num_theory (Array.of_list theory)) ; + (Z3native.write_interpolation_problem ctx num (Array.of_list cnsts) (Array.of_list parents) filename num_theory (Array.of_list 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 toggle_warning_messages = Z3native.toggle_warning_messages -let enable_trace (tag:string) = - (Z3native.enable_trace tag) +let enable_trace = Z3native.enable_trace -let disable_trace (tag:string) = - (Z3native.enable_trace tag) +let disable_trace = Z3native.enable_trace diff --git a/src/api/ml/z3.mli b/src/api/ml/z3.mli index 555e25bc0..02d6a8b2a 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 - let ctx = (mk_context []) in + let ctx = (mk_context []) in (...) @@ -26,17 +26,17 @@ exception Error of string let cfg = [("model", "true"); ("...", "...")] in - let ctx = (mk_context cfg) in + let ctx = (mk_context cfg) in (...) *) 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 @@ -252,7 +252,7 @@ sig 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 @@ -285,14 +285,14 @@ sig 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 @@ -354,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 @@ -373,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 @@ -387,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 @@ -424,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. @@ -471,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. @@ -479,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 @@ -498,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. *) @@ -513,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 @@ -553,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)]. *) @@ -665,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. @@ -696,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 @@ -735,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 @@ -749,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 @@ -779,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]]. @@ -836,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)) *) @@ -928,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 @@ -943,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 @@ -956,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 @@ -987,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 @@ -1019,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 @@ -1057,7 +1057,7 @@ sig (** The constructors. *) val get_constructors : Sort.sort -> FuncDecl.func_decl list - + (** The recognizers. *) val get_recognizers : Sort.sort -> FuncDecl.func_decl list @@ -1127,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. *) @@ -1146,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. *) @@ -1158,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. *) @@ -1179,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 @@ -1201,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. *) @@ -1213,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 @@ -1226,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 @@ -1247,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 @@ -1335,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 @@ -1517,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 @@ -1542,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 @@ -1605,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. @@ -1613,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]. @@ -1625,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. @@ -1641,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 @@ -1713,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. *) @@ -1754,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 @@ -1826,7 +1826,7 @@ end module FloatingPoint : sig - (** Rounding Modes *) + (** Rounding Modes *) module RoundingMode : sig (** Create the RoundingMode sort. *) @@ -1837,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 @@ -1886,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 @@ -1902,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 @@ -1919,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 @@ -1938,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 @@ -1995,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 @@ -2050,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 @@ -2068,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 @@ -2122,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 @@ -2152,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 @@ -2176,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) @@ -2191,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) @@ -2206,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))) @@ -2258,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)) @@ -2295,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. @@ -2308,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 @@ -2359,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) ... @@ -2378,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) @@ -2423,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. @@ -2433,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'. @@ -2491,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 @@ -2513,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) @@ -2547,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. @@ -2593,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 @@ -2626,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 @@ -2643,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. @@ -2689,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. *) @@ -2721,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. *) @@ -2734,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. @@ -2743,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. @@ -2763,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 @@ -2779,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. *) @@ -2819,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 @@ -2844,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 @@ -2871,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 @@ -2882,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 @@ -2928,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 @@ -2936,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. *) @@ -2978,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. *) @@ -3017,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 @@ -3035,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 @@ -3052,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. *) @@ -3083,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 @@ -3113,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 @@ -3124,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. @@ -3158,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 property about the predicate. - The property is added at level. *) + The property is added at level. *) 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. *) @@ -3199,83 +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 *) - 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 +(** Optimization *) +module Optimize : +sig + type optimize + type handle - (** Backtrack one backtracking point. - Note that an exception is thrown if Pop is called without a corresponding [Push] - {!push} *) - val pop : optimize -> unit - - (** 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 + (** 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 + + (** Backtrack one backtracking point. + Note that an exception is thrown if Pop is called without a corresponding [Push] + {!push} *) + val pop : optimize -> unit + + (** 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 *) @@ -3286,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 @@ -3323,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 @@ -3341,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. *) @@ -3361,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. *) @@ -3381,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". @@ -3397,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. @@ -3406,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_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index c726d967f..5fe0da62c 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -63,6 +63,14 @@ static struct custom_operations default_custom_ops = { custom_compare_ext_default, }; +inline 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) { \ @@ -150,14 +158,32 @@ void Z3_context_finalize(value v) { try_to_delete_context(cp); } +int Z3_context_compare(value v1, value v2) { + 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) { + 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, - custom_compare_default, - custom_hash_default, + Z3_context_compare, + Z3_context_hash, custom_serialize_default, custom_deserialize_default, - custom_compare_ext_default, + Z3_context_compare_ext }; @@ -195,13 +221,21 @@ void Z3_ast_finalize(value v) { int Z3_ast_compare(value v1, value v2) { Z3_ast_plus * a1 = (Z3_ast_plus*)Data_custom_val(v1); Z3_ast_plus * a2 = (Z3_ast_plus*)Data_custom_val(v2); - assert(a1->cp->ctx == a2->cp->ctx); + + /* 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) @@ -275,14 +309,33 @@ MK_CTX_OF(ast) 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, \ - custom_compare_default, \ - custom_hash_default, \ + Z3_ ## X ## _compare, \ + Z3_ ## X ## _hash, \ custom_serialize_default, \ custom_deserialize_default, \ - custom_compare_ext_default, \ + Z3_ ## X ## _compare_ext \ }; \ \ MK_CTX_OF(X) @@ -315,14 +368,33 @@ MK_CTX_OF(ast) 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, \ - custom_compare_default, \ - custom_hash_default, \ + Z3_ ## X ## _compare, \ + Z3_ ## X ## _hash, \ custom_serialize_default, \ custom_deserialize_default, \ - custom_compare_ext_default, \ + Z3_ ## X ## _compare_ext \ }; \ \ MK_CTX_OF(X) From b873c6b50897543978be0e78aef3f283c25e1bda Mon Sep 17 00:00:00 2001 From: martin-neuhaeusser Date: Wed, 6 Apr 2016 12:10:59 +0200 Subject: [PATCH 15/25] Simplify OCaml API This patch simplifies the implementation of the OCaml bindings. For example, the applyX wrapper functions have become unnecessary in the new OCaml API. It also removes the internal ML2C structure that was used as an intermediate layer between the C and the OCaml layer. --- scripts/update_api.py | 49 +-- src/api/ml/z3.ml | 739 ++++++++++++++++++++---------------------- 2 files changed, 367 insertions(+), 421 deletions(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index f1a06a63d..909f324f0 100755 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -1208,9 +1208,9 @@ def mk_ml(ml_dir): ml_native.write(s); ml_pref.close() - ml_native.write('module ML2C = struct\n\n') + ml_native.write('\n') for name, result, params in _dotnet_decls: - ml_native.write(' external n_%s : ' % ml_method_name(name)) + ml_native.write('external %s : ' % ml_method_name(name)) ip = inparams(params) op = outparams(params) if len(ip) == 0: @@ -1231,55 +1231,20 @@ def mk_ml(ml_dir): ml_native.write('%s' % param2ml(p)) if len(op) > 0: ml_native.write(')') - ml_native.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') - - # Exception wrappers - for name, result, params in _dotnet_decls: - ip = inparams(params) - op = outparams(params) - ml_native.write(' let %s ' % ml_method_name(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(' = ') - 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('\n') - - ml_native.write('\n') # 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)) + 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)) ml_native.write('(**/**)\n') ml_native.close() diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml index c558038ca..60d83dd86 100644 --- a/src/api/ml/z3.ml +++ b/src/api/ml/z3.ml @@ -23,16 +23,13 @@ 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 (major, minor, build, revision) = Z3native.get_version () + 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 + string_of_int major ^ "." ^ + string_of_int minor ^ "." ^ + string_of_int build ^ "." ^ + string_of_int revision end let mk_list f n = @@ -47,36 +44,34 @@ let mk_list f n = 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); + List.iter f settings; let res = Z3native.mk_context_rc cfg in - Z3native.del_config(cfg); + 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 = Z3native.symbol let gc = Z3native.context_of_symbol - let kind (o:symbol) = symbol_kind_of_int (Z3native.get_symbol_kind (gc o) 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 (gc o) o - let get_string (o:symbol) = Z3native.get_symbol_string (gc o) o - let to_string (o:symbol) = + 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 mk_int = Z3native.mk_int_symbol let mk_string = Z3native.mk_string_symbol - let mk_ints (ctx:context) (names:int list) = List.map (mk_int ctx) names - let mk_strings (ctx:context) (names:string list) = List.map (mk_string ctx) names -end + 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 @@ -150,7 +145,7 @@ end = struct let f i = get x i in mk_list f xs - let to_string (x:ast_vector) = Z3native.ast_vector_to_string (gc x) x + let to_string x = Z3native.ast_vector_to_string (gc x) x end module ASTMap = @@ -328,13 +323,15 @@ end = struct end 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) (Array.of_list domain) range + let dom_arr = Array.of_list domain in + Z3native.mk_func_decl ctx name (Array.length dom_arr) dom_arr range 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) = - Z3native.mk_fresh_func_decl ctx prefix (List.length domain) (Array.of_list domain) range + let dom_arr = Array.of_list domain in + Z3native.mk_fresh_func_decl ctx prefix (Array.length dom_arr) dom_arr range let mk_const_decl (ctx:context) (name:Symbol.symbol) (range:Sort.sort) = Z3native.mk_func_decl ctx name 0 [||] range @@ -465,10 +462,6 @@ 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 = AST.ast @@ -487,11 +480,6 @@ end = struct let arg_array = Array.of_list args in Z3native.mk_app ctx f (Array.length arg_array) arg_array - let apply1 ctx f t = f ctx t - let apply2 ctx f t1 t2 = f ctx t1 t2 - let apply3 ctx f t1 t2 t3 = f ctx t1 t2 t3 - let apply4 ctx f t1 t2 t3 t4 = f ctx t1 t2 t3 t4 - let simplify (x:expr) (p:Params.params option) = match p with | None -> Z3native.simplify (gc x) x @@ -562,16 +550,26 @@ struct 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 (ctx:context) (a:expr) = apply1 ctx Z3native.mk_not a - 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 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) = Z3native.mk_and ctx (List.length args) (Array.of_list args) - let mk_or (ctx:context) (args:expr list) = Z3native.mk_or ctx (List.length args) (Array.of_list 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) = Z3native.mk_distinct ctx (List.length args) (Array.of_list args) - let get_bool_value (x:expr) = lbool_of_int (Z3native.get_bool_value (gc x) x) + 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_and ctx args = + let arg_arr = Array.of_list args in + Z3native.mk_and ctx (Array.length arg_arr) arg_arr + + let mk_or ctx args = + let arg_arr = Array.of_list args in + Z3native.mk_or ctx (Array.length arg_arr) arg_arr + + let mk_eq = Z3native.mk_eq + let mk_distinct ctx args = + let arg_arr = Array.of_list args in + Z3native.mk_distinct ctx (Array.length arg_arr) arg_arr + + let get_bool_value x = lbool_of_int (Z3native.get_bool_value (gc x) x) let is_bool x = AST.is_expr x @@ -605,20 +603,19 @@ struct else e - module Pattern = struct type pattern = Z3native.pattern let gc = Z3native.context_of_ast - let get_num_terms (x:pattern) = Z3native.get_pattern_num_terms (gc x) x + let get_num_terms x = Z3native.get_pattern_num_terms (gc x) x - let get_terms (x:pattern) = - let n = (get_num_terms x) 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 (gc x) x + let to_string x = Z3native.pattern_to_string (gc x) x end let get_index (x:expr) = @@ -627,218 +624,198 @@ struct else Z3native.get_index_value (gc x) x - let is_universal (x:quantifier) = Z3native.is_quantifier_forall (gc x) x - let is_existential (x:quantifier) = not (is_universal x) - let get_weight (x:quantifier) = Z3native.get_quantifier_weight (gc x) x - let get_num_patterns (x:quantifier) = Z3native.get_quantifier_num_patterns (gc x) x - let get_patterns (x:quantifier) = + 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 (gc x) x + let get_num_no_patterns x = Z3native.get_quantifier_num_no_patterns (gc x) x - let get_no_patterns (x:quantifier) = + 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 (gc x) x + let get_num_bound x = Z3native.get_quantifier_num_bound (gc x) x - let get_bound_variable_names (x:quantifier) = + 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 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) = Z3native.get_quantifier_body (gc x) x - let mk_bound (ctx:context) (index:int) (ty:Sort.sort) = Z3native.mk_bound ctx index 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 + let mk_pattern ctx terms = + let terms_arr = Array.of_list terms in + if Array.length terms_arr = 0 then raise (Error "Cannot create a pattern from zero terms") else - Z3native.mk_pattern ctx (List.length terms) (Array.of_list terms) + Z3native.mk_pattern ctx (Array.length terms_arr) terms_arr - 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 + let _internal_mk_quantifier ~universal ctx sorts names body weight patterns nopatterns quantifier_id skolem_id = + let sorts_arr = Array.of_list sorts in + let names_arr = Array.of_list names in + if Array.length sorts_arr <> Array.length names_arr then raise (Error "Number of sorts does not match number of names") - else if ((List.length nopatterns) = 0 && quantifier_id = None && skolem_id = None) then - Z3native.mk_quantifier ctx true - (match weight with | None -> 1 | Some(x) -> x) - (List.length patterns) (Array.of_list patterns) - (List.length sorts) (Array.of_list sorts) - (Array.of_list names) - body else - Z3native.mk_quantifier_ex ctx true - (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) (Array.of_list patterns) - (List.length nopatterns) (Array.of_list nopatterns) - (List.length sorts) (Array.of_list sorts) - (Array.of_list names) + let patterns_arr = Array.of_list patterns in + match nopatterns, quantifier_id, skolem_id with + | [], None, None -> + Z3native.mk_quantifier ctx universal + (match weight with | None -> 1 | Some x -> x) + (Array.length patterns_arr) patterns_arr + (Array.length sorts_arr) sorts_arr + names_arr body + | _ -> + let nopatterns_arr = Array.of_list nopatterns in + 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) + (Array.length patterns_arr) patterns_arr + (Array.length nopatterns_arr) nopatterns_arr + (Array.length sorts_arr) sorts_arr + names_arr body + + let _internal_mk_quantifier_const ~universal ctx bound_constants body weight patterns nopatterns quantifier_id skolem_id = + let patterns_arr = Array.of_list patterns in + let bound_constants_arr = Array.of_list bound_constants in + match nopatterns, quantifier_id, skolem_id with + | [], None, None -> + Z3native.mk_quantifier_const ctx universal + (match weight with | None -> 1 | Some x -> x) + (Array.length bound_constants_arr) bound_constants_arr + (Array.length patterns_arr) patterns_arr + body + | _ -> + let nopatterns_arr = Array.of_list nopatterns in + 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) + (Array.length bound_constants_arr) bound_constants_arr + (Array.length patterns_arr) patterns_arr + (Array.length nopatterns_arr) nopatterns_arr 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 - Z3native.mk_quantifier_const ctx true - (match weight with | None -> 1 | Some(x) -> x) - (List.length bound_constants) (Array.of_list bound_constants) - (List.length patterns) (Array.of_list patterns) - body - else - Z3native.mk_quantifier_const_ex ctx true - (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) (Array.of_list bound_constants) - (List.length patterns) (Array.of_list patterns) - (List.length nopatterns) (Array.of_list nopatterns) - 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 (Error "Number of sorts does not match number of names") - else if ((List.length nopatterns) = 0 && quantifier_id = None && skolem_id = None) then - Z3native.mk_quantifier ctx false - (match weight with | None -> 1 | Some(x) -> x) - (List.length patterns) (Array.of_list patterns) - (List.length sorts) (Array.of_list sorts) - (Array.of_list names) - body - else - Z3native.mk_quantifier_ex ctx false - (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) (Array.of_list patterns) - (List.length nopatterns) (Array.of_list nopatterns) - (List.length sorts) (Array.of_list sorts) - (Array.of_list names) - 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 - Z3native.mk_quantifier_const ctx false - (match weight with | None -> 1 | Some(x) -> x) - (List.length bound_constants) (Array.of_list bound_constants) - (List.length patterns) (Array.of_list patterns) - body - else - Z3native.mk_quantifier_const_ex ctx false - (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) (Array.of_list bound_constants) - (List.length patterns) (Array.of_list patterns) - (List.length nopatterns) (Array.of_list nopatterns) - body + 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) (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 + 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 + 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 x + let to_string x = Expr.to_string x end - module Z3Array = struct - let mk_sort (ctx:context) (domain:Sort.sort) (range:Sort.sort) = Z3native.mk_array_sort ctx domain range - let is_store (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_STORE) - let is_select (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_SELECT) - let is_constant_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_CONST_ARRAY) - let is_default_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ARRAY_DEFAULT) - let is_array_map (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_ARRAY_MAP) - let is_as_array (x:expr) = (AST.is_app x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_AS_ARRAY) + 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_array (x:expr) = - (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 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) = Z3native.get_array_sort_domain (Sort.gc x) x - let get_range (x:Sort.sort) = Z3native.get_array_sort_range (Sort.gc x) 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 ctx name domain range = 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_const_s ctx name domain range = 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_store (ctx:context) (a:expr) (i:expr) (v:expr) = apply3 ctx Z3native.mk_store a i v - let mk_const_array (ctx:context) (domain:Sort.sort) (v:expr) = Z3native.mk_const_array ctx domain v - let mk_map (ctx:context) (f:func_decl) (args:expr list) = Z3native.mk_map ctx f (List.length args) (Array.of_list 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_select = Z3native.mk_select + let mk_store = Z3native.mk_store + let mk_const_array = Z3native.mk_const_array + + let mk_map ctx f args = + let args_arr = Array.of_list args in + Z3native.mk_map ctx f (Array.length args_arr) args_arr + + 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) = Z3native.mk_set_sort ctx ty + let mk_sort = Z3native.mk_set_sort - 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 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 mk_empty (ctx:context) (domain:Sort.sort) = Z3native.mk_empty_set ctx domain - let mk_full (ctx:context) (domain:Sort.sort) = Z3native.mk_full_set ctx 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) = Z3native.mk_set_union ctx (List.length args) (Array.of_list args) + 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 = + let args_arr = Array.of_list args in + Z3native.mk_set_union ctx (Array.length args_arr) args_arr - let mk_intersection (ctx:context) (args:expr list) = - Z3native.mk_set_intersect ctx (List.length args) (Array.of_list args) + let mk_intersection ctx args = + let args_arr = Array.of_list args in + Z3native.mk_set_intersect ctx (Array.length args_arr) args_arr - 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 + 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 (ctx:context) (name:Symbol.symbol) (size:int) = Z3native.mk_finite_domain_sort ctx name size - let mk_sort_s (ctx:context) (name:string) (size:int) = mk_sort ctx (Symbol.mk_string ctx name) size + 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 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 is_lt (x:expr) = AST.is_app 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.gc x) x) in - if r then v - else raise (Error "Conversion failed.") + 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: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)) = RELATION_SORT)) + 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) @@ -1059,15 +1036,15 @@ struct module Integer = struct - let mk_sort (ctx:context) = Z3native.mk_int_sort ctx + let mk_sort = Z3native.mk_int_sort - let get_int (x:expr) = - let (r, v) = Z3native.get_numeral_int (Expr.gc x) x in - if r then v - else raise (Error "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 + 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 @@ -1076,23 +1053,23 @@ struct 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 (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_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 (ctx:context) (t:expr) = apply1 ctx Z3native.mk_int2real t - let mk_int2bv (ctx:context) (n:int) (t:expr) = Z3native.mk_int2bv ctx n t + let mk_int2real = Z3native.mk_int2real + let mk_int2bv = Z3native.mk_int2bv end module Real = struct - let mk_sort (ctx:context) = Z3native.mk_real_sort ctx - 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 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_ratio (x:expr) = - if (is_rat_numeral x) then - let s = (Z3native.get_numeral_string (Expr.gc x) x) in + 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.") @@ -1102,15 +1079,15 @@ struct 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 + if den = 0 then raise (Error "Denominator is zero") else Z3native.mk_real ctx num den 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 (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_is_integer = Z3native.mk_is_int + let mk_real2int = Z3native.mk_real2int module AlgebraicNumber = struct @@ -1121,16 +1098,25 @@ struct end end - let mk_add (ctx:context) (t:expr list) = Z3native.mk_add ctx (List.length t) (Array.of_list t) - let mk_mul (ctx:context) (t:expr list) = Z3native.mk_mul ctx (List.length t) (Array.of_list t) - let mk_sub (ctx:context) (t:expr list) = Z3native.mk_sub ctx (List.length t) (Array.of_list t) - let mk_unary_minus (ctx:context) (t:expr) = apply1 ctx Z3native.mk_unary_minus 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_add (ctx:context) (t:expr list) = + let t_arr = Array.of_list t in + Z3native.mk_add ctx (Array.length t_arr) t_arr + + let mk_mul (ctx:context) (t:expr list) = + let t_arr = Array.of_list t in + Z3native.mk_mul ctx (Array.length t_arr) t_arr + + let mk_sub (ctx:context) (t:expr list) = + let t_arr = Array.of_list t in + Z3native.mk_sub ctx (Array.length t_arr) t_arr + + 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 @@ -1191,63 +1177,65 @@ struct 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) = - let (r, v) = Z3native.get_numeral_int (Expr.gc x) x in - if r then v - else raise (Error "Conversion failed.") + 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) = Z3native.mk_extract ctx high low t - let mk_sign_ext (ctx:context) (i:int) (t:expr) = Z3native.mk_sign_ext ctx i t - let mk_zero_ext (ctx:context) (i:int) (t:expr) = Z3native.mk_zero_ext ctx i t - let mk_repeat (ctx:context) (i:int) (t:expr) = Z3native.mk_repeat ctx i 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) = Z3native.mk_rotate_left ctx i t - let mk_rotate_right (ctx:context) (i:int) (t:expr) = Z3native.mk_rotate_right ctx i 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) = Z3native.mk_bv2int ctx t signed - let mk_add_no_overflow (ctx:context) (t1:expr) (t2:expr) (signed:bool) = Z3native.mk_bvadd_no_overflow ctx t1 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) = Z3native.mk_bvsub_no_underflow ctx t1 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) = Z3native.mk_bvmul_no_overflow ctx t1 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) = Z3native.mk_numeral ctx v (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 @@ -1255,38 +1243,38 @@ module FloatingPoint = struct module RoundingMode = struct - let mk_sort (ctx:context) = Z3native.mk_fpa_rounding_mode_sort 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) = Z3native.mk_fpa_round_nearest_ties_to_even ctx - let mk_rne (ctx:context) = Z3native.mk_fpa_rne ctx - let mk_round_nearest_ties_to_away (ctx:context) = Z3native.mk_fpa_round_nearest_ties_to_away ctx - let mk_rna (ctx:context) = Z3native.mk_fpa_rna ctx - let mk_round_toward_positive (ctx:context) = Z3native.mk_fpa_round_toward_positive ctx - let mk_rtp (ctx:context) = Z3native.mk_fpa_rtp ctx - let mk_round_toward_negative (ctx:context) = Z3native.mk_fpa_round_toward_negative ctx - let mk_rtn (ctx:context) = Z3native.mk_fpa_rtn ctx - let mk_round_toward_zero (ctx:context) = Z3native.mk_fpa_round_toward_zero ctx - let mk_rtz (ctx:context) = Z3native.mk_fpa_rtz 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) = Z3native.mk_fpa_sort ctx ebits sbits - let mk_sort_half (ctx:context) = Z3native.mk_fpa_sort_half ctx - let mk_sort_16 (ctx:context) = Z3native.mk_fpa_sort_16 ctx - let mk_sort_single (ctx:context) = Z3native.mk_fpa_sort_single ctx - let mk_sort_32 (ctx:context) = Z3native.mk_fpa_sort_32 ctx - let mk_sort_double (ctx:context) = Z3native.mk_fpa_sort_double ctx - let mk_sort_64 (ctx:context) = Z3native.mk_fpa_sort_64 ctx - let mk_sort_quadruple (ctx:context) = Z3native.mk_fpa_sort_quadruple ctx - let mk_sort_128 (ctx:context) = Z3native.mk_fpa_sort_128 ctx + 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_nan (ctx:context) (s:Sort.sort) = Z3native.mk_fpa_nan ctx s - let mk_inf (ctx:context) (s:Sort.sort) (negative:bool) = Z3native.mk_fpa_inf ctx s negative - let mk_zero (ctx:context) (s:Sort.sort) (negative:bool) = Z3native.mk_fpa_zero ctx s negative - 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) = Z3native.mk_fpa_numeral_double ctx value s - let mk_numeral_i (ctx:context) (value:int) (s:Sort.sort) = Z3native.mk_fpa_numeral_int ctx value s - let mk_numeral_i_u (ctx:context) (sign:bool) (exponent:int) (significand:int) (s:Sort.sort) = Z3native.mk_fpa_numeral_int64_uint64 ctx sign exponent significand s - let mk_numeral_s (ctx:context) (v:string) (s:Sort.sort) = Z3native.mk_numeral ctx v 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 x) && (FuncDecl.get_decl_kind (Expr.get_func_decl x) = OP_FPA_ABS) @@ -1321,53 +1309,52 @@ struct 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 numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) 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 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) = Z3native.mk_fpa_to_fp_bv ctx t s - let mk_to_fp_float (ctx:context) (rm:expr) (t:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_float ctx rm t s - let mk_to_fp_real (ctx:context) (rm:expr) (t:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_real ctx rm t s - let mk_to_fp_signed (ctx:context) (rm:expr) (t:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_signed ctx rm t s - let mk_to_fp_unsigned (ctx:context) (rm:expr) (t:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_unsigned ctx rm t s - let mk_to_ubv (ctx:context) (rm:expr) (t:expr) (size:int) = Z3native.mk_fpa_to_ubv ctx rm t size - let mk_to_sbv (ctx:context) (rm:expr) (t:expr) (size:int) = Z3native.mk_fpa_to_sbv ctx rm t size - let mk_to_real (ctx:context) (t:expr) = apply1 ctx Z3native.mk_fpa_to_real t - let get_ebits (ctx:context) (s:Sort.sort) = Z3native.fpa_get_ebits ctx s - let get_sbits (ctx:context) (s:Sort.sort) = Z3native.fpa_get_sbits ctx s - let get_numeral_sign (ctx:context) (t:expr) = Z3native.fpa_get_numeral_sign ctx t - let get_numeral_significand_string (ctx:context) (t:expr) = Z3native.fpa_get_numeral_significand_string ctx t - let get_numeral_significand_uint (ctx:context) (t:expr) = Z3native.fpa_get_numeral_significand_uint64 ctx t - let get_numeral_exponent_string (ctx:context) (t:expr) = Z3native.fpa_get_numeral_exponent_string ctx t - let get_numeral_exponent_int (ctx:context) (t:expr) = Z3native.fpa_get_numeral_exponent_int64 ctx t - let mk_to_ieee_bv (ctx:context) (t:expr) = Z3native.mk_fpa_to_ieee_bv ctx t - let mk_to_fp_int_real (ctx:context) (rm:expr) (exponent:expr) (significand:expr) (s:Sort.sort) = Z3native.mk_fpa_to_fp_int_real ctx rm exponent significand s - let numeral_to_string (x:expr) = Z3native.get_numeral_string (Expr.gc x) x + let mk_const = Expr.mk_const + let mk_const_s = Expr.mk_const_s + + 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 @@ -1466,13 +1453,10 @@ struct 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 (gc x) - else if n = 1 then - List.hd (get_formulas x) - else - Boolean.mk_and (gc x) (get_formulas x) + 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 @@ -2024,36 +2008,34 @@ struct 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 + let sort_names_arr = Array.of_list sort_names in + let sorts_arr = Array.of_list sorts in + let decl_names_arr = Array.of_list decl_names in + let decls_arr = Array.of_list decls in + let csn = Array.length sort_names_arr in + let cs = Array.length sorts_arr in + let cdn = Array.length decl_names_arr in + let cd = Array.length decls_arr in + if csn <> cs || cdn <> cd then raise (Error "Argument size mismatch") else Z3native.parse_smtlib2_string ctx str - cs - (Array.of_list sort_names) - (Array.of_list sorts) - cd - (Array.of_list decl_names) - (Array.of_list decls) + cs sort_names_arr sorts_arr cd decl_names_arr decls_arr 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 + let sort_names_arr = Array.of_list sort_names in + let sorts_arr = Array.of_list sorts in + let decl_names_arr = Array.of_list decl_names in + let decls_arr = Array.of_list decls in + let csn = Array.length sort_names_arr in + let cs = Array.length sorts_arr in + let cdn = Array.length decl_names_arr in + let cd = Array.length decls_arr in + if csn <> cs || cdn <> cd then raise (Error "Argument size mismatch") else Z3native.parse_smtlib2_string ctx file_name - cs - (Array.of_list sort_names) - (Array.of_list sorts) - cd - (Array.of_list decl_names) - (Array.of_list decls) + cs sort_names_arr sorts_arr cd decl_names_arr decls_arr end module Interpolation = @@ -2076,7 +2058,7 @@ struct 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 + 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) @@ -2112,8 +2094,7 @@ struct | _ -> () 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 (Array.of_list cnsts) (Array.of_list parents) filename num_theory (Array.of_list theory)); - () + Z3native.write_interpolation_problem ctx num (Array.of_list cnsts) (Array.of_list parents) filename num_theory (Array.of_list theory) end let set_global_param = Z3native.global_param_set From 1662ba8353b43df4b6d112e1f96b745ef6dc6e45 Mon Sep 17 00:00:00 2001 From: martin-neuhaeusser Date: Wed, 6 Apr 2016 12:36:11 +0200 Subject: [PATCH 16/25] Add more comments on comparison functions in the C layer of the OCaml bindings --- src/api/ml/z3native_stubs.c.pre | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index 5fe0da62c..c726c7852 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -159,6 +159,10 @@ void Z3_context_finalize(value v) { } 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); @@ -172,6 +176,8 @@ int Z3_context_compare_ext(value v1, value 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; } From bd9d13279ad65773158741f26ce5b134e6d4813e Mon Sep 17 00:00:00 2001 From: martin-neuhaeusser Date: Wed, 6 Apr 2016 12:39:19 +0200 Subject: [PATCH 17/25] Pretty printing --- src/api/ml/z3.ml | 14 +++++++------- src/api/ml/z3.mli | 12 ++++++------ 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml index 60d83dd86..3a797e5d8 100644 --- a/src/api/ml/z3.ml +++ b/src/api/ml/z3.ml @@ -679,13 +679,13 @@ struct | _ -> let nopatterns_arr = Array.of_list nopatterns in 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) - (Array.length patterns_arr) patterns_arr - (Array.length nopatterns_arr) nopatterns_arr - (Array.length sorts_arr) sorts_arr - names_arr body + (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) + (Array.length patterns_arr) patterns_arr + (Array.length nopatterns_arr) nopatterns_arr + (Array.length sorts_arr) sorts_arr + names_arr body let _internal_mk_quantifier_const ~universal ctx bound_constants body weight patterns nopatterns quantifier_id skolem_id = let patterns_arr = Array.of_list patterns in diff --git a/src/api/ml/z3.mli b/src/api/ml/z3.mli index 02d6a8b2a..9104b3080 100644 --- a/src/api/ml/z3.mli +++ b/src/api/ml/z3.mli @@ -285,7 +285,7 @@ sig 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 @@ -3232,21 +3232,21 @@ sig val add : optimize -> Expr.expr list -> unit (** Asssert a soft constraint. - Supply integer weight and string that identifies a group + 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 *) From 95454679e28fb30fc2de48712f7d7f9289672920 Mon Sep 17 00:00:00 2001 From: martin-neuhaeusser Date: Wed, 6 Apr 2016 12:45:21 +0200 Subject: [PATCH 18/25] Another round of pretty printing --- src/api/ml/z3native_stubs.c.pre | 137 ++++++++++++++++---------------- 1 file changed, 68 insertions(+), 69 deletions(-) diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index c726c7852..02bafeef6 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -24,32 +24,32 @@ extern "C" { #include #include -#define CAMLlocal6(X1,X2,X3,X4,X5,X6) \ - CAMLlocal5(X1,X2,X3,X4,X5); \ +#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); \ +#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); \ +#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); \ +#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); \ +#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); \ +#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); \ +#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); \ +#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) @@ -76,31 +76,31 @@ inline int compare_pointers(void* pt1, void* pt2) { CAMLprim DLL_PUBLIC value n_context_of_ ## X(value v) { \ CAMLparam1(v); \ CAMLlocal1(result); \ - Z3_context_plus cp; \ + Z3_context_plus cp; \ Z3_ ## X ## _plus * p = (Z3_ ## X ## _plus *) Data_custom_val(v); \ - cp = p->cp; \ + 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; \ + *(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++; \ + 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); \ + } \ + \ + 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); \ + *(Z3_ ## X ## _plus*)(Data_custom_val(result)) = a; \ + CAMLreturn(result); \ } @@ -314,34 +314,34 @@ MK_CTX_OF(ast) 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); \ + 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) { \ + \ + intnat Z3_ ## X ## _hash(value v) { \ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \ - return (intnat)pp->p; \ + 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)); \ + 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, \ + Z3_ ## X ## _compare, \ + Z3_ ## X ## _hash, \ custom_serialize_default, \ custom_deserialize_default, \ - Z3_ ## X ## _compare_ext \ + Z3_ ## X ## _compare_ext \ }; \ \ MK_CTX_OF(X) @@ -357,7 +357,7 @@ MK_CTX_OF(ast) r.cp = cp; \ r.p = p; \ r.cp->obj_count++; \ - if (p != NULL) \ + if (p != NULL) \ Z3_ ## X ## _inc_ref(cp->ctx, p); \ return r; \ } \ @@ -368,7 +368,7 @@ MK_CTX_OF(ast) \ void Z3_ ## X ## _finalize(value v) { \ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \ - if (pp->p != NULL) \ + if (pp->p != NULL) \ Z3_ ## X ## _dec_ref(pp->cp->ctx, pp->p); \ pp->cp->obj_count--; \ try_to_delete_context(pp->cp); \ @@ -377,30 +377,30 @@ MK_CTX_OF(ast) 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); \ + 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) { \ + \ + intnat Z3_ ## X ## _hash(value v) { \ Z3_ ## X ## _plus * pp = (Z3_ ## X ## _plus*)Data_custom_val(v); \ - return (intnat)pp->p; \ + 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)); \ + 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, \ + Z3_ ## X ## _compare, \ + Z3_ ## X ## _hash, \ custom_serialize_default, \ custom_deserialize_default, \ - Z3_ ## X ## _compare_ext \ + Z3_ ## X ## _compare_ext \ }; \ \ MK_CTX_OF(X) @@ -425,7 +425,6 @@ MK_PLUS_OBJ(ast_vector) MK_PLUS_OBJ(fixedpoint) MK_PLUS_OBJ(optimize) - #ifdef __cplusplus extern "C" { #endif From 34bf4b1d3cb63b51720cbb627865b5001e6eebec Mon Sep 17 00:00:00 2001 From: martin-neuhaeusser Date: Mon, 11 Apr 2016 15:06:28 +0200 Subject: [PATCH 19/25] Fix installation of custom error handler during context creation in OCaml bindings This patch fixes a bug detected by valgrind, where a custom error handler did not get installed correctly. --- src/api/ml/z3native_stubs.c.pre | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index 02bafeef6..47655c57e 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -436,8 +436,10 @@ void MLErrorHandler(Z3_context c, Z3_error_code e) n_* wrapper functions. */ } -void DLL_PUBLIC n_set_internal_error_handler(value a0) +CAMLprim value DLL_PUBLIC n_set_internal_error_handler(value ctx_v) { - Z3_context _a0 = * (Z3_context*) Data_custom_val(a0); - Z3_set_error_handler(_a0, MLErrorHandler); + 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); } From 67ac1a003e35fc5c2d730d5f06ee98707ad320ce Mon Sep 17 00:00:00 2001 From: "Martin R. Neuhaeusser" Date: Mon, 18 Apr 2016 17:14:48 +0200 Subject: [PATCH 20/25] Avoid conversion between mutable arrays and lists in OCaml API. This patch eliminates the conversion between OCaml arrays and lists from Z3's OCaml API. --- scripts/update_api.py | 30 ++++-- src/api/ml/z3.ml | 212 ++++++++++++++++-------------------------- 2 files changed, 98 insertions(+), 144 deletions(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index 909f324f0..09a10f6cf 100755 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -265,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)) @@ -1043,8 +1043,6 @@ def arrayparams(params): op.append(param) return op - - def ml_plus_type(ts): if ts == 'Z3_context': return 'Z3_context_plus' @@ -1309,6 +1307,8 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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): @@ -1316,10 +1316,12 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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 @@ -1360,9 +1362,13 @@ def mk_z3native_stubs_c(ml_dir): # C interface if k == IN_ARRAY or k == INOUT_ARRAY: t = param_type(param) ts = type2str(t) + 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(' _a%s[_i] = %s;\n' % (i, ml_unwrap(t, ts, 'Field(a' + str(i) + ', _i)'))) + 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 ml_wrapper.write('\n /* invoke Z3 function */\n ') @@ -1421,8 +1427,9 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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++) {\n' % param_array_capacity_pos(p)) + # 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): @@ -1430,8 +1437,11 @@ def mk_z3native_stubs_c(ml_dir): # C interface 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(' Store_field(_a%s_val, _i, tmp_val);\n' % i) - ml_wrapper.write(' }\n') + 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: wrp = ml_set_wrap(pt, '_a%d_val' % i, '_a%d' % i) wrp = wrp.replace('*)', '**)') diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml index 3a797e5d8..bbbb9e74b 100644 --- a/src/api/ml/z3.ml +++ b/src/api/ml/z3.ml @@ -323,24 +323,22 @@ end = struct end let mk_func_decl (ctx:context) (name:Symbol.symbol) (domain:Sort.sort list) (range:Sort.sort) = - let dom_arr = Array.of_list domain in - Z3native.mk_func_decl ctx name (Array.length dom_arr) dom_arr range + 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) = 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) = - let dom_arr = Array.of_list domain in - Z3native.mk_fresh_func_decl ctx prefix (Array.length dom_arr) dom_arr range + Z3native.mk_fresh_func_decl ctx prefix (List.length domain) domain range let mk_const_decl (ctx:context) (name:Symbol.symbol) (range:Sort.sort) = - Z3native.mk_func_decl ctx name 0 [||] range + Z3native.mk_func_decl ctx name 0 [] 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 + Z3native.mk_func_decl ctx (Symbol.mk_string ctx name) 0 [] range let mk_fresh_const_decl (ctx:context) (prefix:string) (range:Sort.sort) = - Z3native.mk_fresh_func_decl ctx prefix 0 [||] range + 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) @@ -477,8 +475,7 @@ end = struct let ast_of_expr e = e let expr_of_func_app ctx f args = - let arg_array = Array.of_list args in - Z3native.mk_app ctx f (Array.length arg_array) arg_array + Z3native.mk_app ctx f (List.length args) args let simplify (x:expr) (p:Params.params option) = match p with @@ -498,20 +495,18 @@ end = struct if AST.is_app x && List.length args <> get_num_args x then raise (Error "Number of arguments does not match") else - Z3native.update_term (gc x) x (List.length args) (Array.of_list args) + Z3native.update_term (gc x) x (List.length args) args let substitute (x:expr) (from:expr list) (to_:expr list) = - let from_array = Array.of_list from in - let to_array = Array.of_list to_ in - if Array.length from_array <> Array.length to_array then + let len = List.length from in + if List.length to_ <> len then raise (Error "Argument sizes do not match") else - Z3native.substitute (gc x) x (Array.length from_array) from_array to_array + Z3native.substitute (gc x) x len from to_ let substitute_one x from to_ = substitute x [ from ] [ to_ ] let substitute_vars x to_ = - let to_array = Array.of_list to_ in - Z3native.substitute_vars (gc x) x (Array.length to_array) to_array + Z3native.substitute_vars (gc x) x (List.length to_) to_ let translate (x:expr) to_ctx = if gc x = to_ctx then @@ -556,18 +551,12 @@ struct let mk_implies = Z3native.mk_implies let mk_xor = Z3native.mk_xor - let mk_and ctx args = - let arg_arr = Array.of_list args in - Z3native.mk_and ctx (Array.length arg_arr) arg_arr + let mk_and ctx args = Z3native.mk_and ctx (List.length args) args - let mk_or ctx args = - let arg_arr = Array.of_list args in - Z3native.mk_or ctx (Array.length arg_arr) arg_arr + let mk_or ctx args = Z3native.mk_or ctx (List.length args) args let mk_eq = Z3native.mk_eq - let mk_distinct ctx args = - let arg_arr = Array.of_list args in - Z3native.mk_distinct ctx (Array.length arg_arr) arg_arr + let mk_distinct ctx args = Z3native.mk_distinct ctx (List.length args) args let get_bool_value x = lbool_of_int (Z3native.get_bool_value (gc x) x) @@ -656,56 +645,50 @@ struct let mk_bound = Z3native.mk_bound let mk_pattern ctx terms = - let terms_arr = Array.of_list terms in - if Array.length terms_arr = 0 then + let len = List.length terms in + if len = 0 then raise (Error "Cannot create a pattern from zero terms") else - Z3native.mk_pattern ctx (Array.length terms_arr) terms_arr + Z3native.mk_pattern ctx len terms let _internal_mk_quantifier ~universal ctx sorts names body weight patterns nopatterns quantifier_id skolem_id = - let sorts_arr = Array.of_list sorts in - let names_arr = Array.of_list names in - if Array.length sorts_arr <> Array.length names_arr then + let len = List.length sorts in + if List.length names <> len then raise (Error "Number of sorts does not match number of names") else - let patterns_arr = Array.of_list patterns in match nopatterns, quantifier_id, skolem_id with | [], None, None -> Z3native.mk_quantifier ctx universal (match weight with | None -> 1 | Some x -> x) - (Array.length patterns_arr) patterns_arr - (Array.length sorts_arr) sorts_arr - names_arr body + (List.length patterns) patterns + len sorts + names body | _ -> - let nopatterns_arr = Array.of_list nopatterns in 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) - (Array.length patterns_arr) patterns_arr - (Array.length nopatterns_arr) nopatterns_arr - (Array.length sorts_arr) sorts_arr - names_arr body + (List.length patterns) patterns + (List.length nopatterns) nopatterns + len sorts + names body let _internal_mk_quantifier_const ~universal ctx bound_constants body weight patterns nopatterns quantifier_id skolem_id = - let patterns_arr = Array.of_list patterns in - let bound_constants_arr = Array.of_list bound_constants in match nopatterns, quantifier_id, skolem_id with | [], None, None -> Z3native.mk_quantifier_const ctx universal (match weight with | None -> 1 | Some x -> x) - (Array.length bound_constants_arr) bound_constants_arr - (Array.length patterns_arr) patterns_arr + (List.length bound_constants) bound_constants + (List.length patterns) patterns body | _ -> - let nopatterns_arr = Array.of_list nopatterns in 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) - (Array.length bound_constants_arr) bound_constants_arr - (Array.length patterns_arr) patterns_arr - (Array.length nopatterns_arr) nopatterns_arr + (List.length bound_constants) bound_constants + (List.length patterns) patterns + (List.length nopatterns) nopatterns body let mk_forall = _internal_mk_quantifier ~universal:true @@ -754,8 +737,7 @@ struct let mk_const_array = Z3native.mk_const_array let mk_map ctx f args = - let args_arr = Array.of_list args in - Z3native.mk_map ctx f (Array.length args_arr) args_arr + Z3native.mk_map ctx f (List.length args) args let mk_term_array = Z3native.mk_array_default let mk_array_ext = Z3native.mk_array_ext @@ -777,12 +759,10 @@ struct let mk_set_add = Z3native.mk_set_add let mk_del = Z3native.mk_set_del let mk_union ctx args = - let args_arr = Array.of_list args in - Z3native.mk_set_union ctx (Array.length args_arr) args_arr + Z3native.mk_set_union ctx (List.length args) args let mk_intersection ctx args = - let args_arr = Array.of_list args in - Z3native.mk_set_intersect ctx (Array.length args_arr) args_arr + Z3native.mk_set_intersect ctx (List.length args) args let mk_difference = Z3native.mk_set_difference let mk_complement = Z3native.mk_set_complement @@ -855,20 +835,20 @@ struct 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 + 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 + 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 - (Array.of_list field_names) + field_names (let f x = match x with None -> Z3native.mk_null_ast ctx | Some s -> s in - Array.of_list (List.map f sorts)) - (Array.of_list sort_refs) in + List.map f sorts) + sort_refs in FieldNumTable.add _field_nums no n; no @@ -884,8 +864,7 @@ struct let get_accessor_decls (x:constructor) = let (_, _, c) = (Z3native.query_constructor (gc x) x (get_num_fields x)) in - let f i = Array.get c i in - mk_list f (Array.length c) + c end module ConstructorList = @@ -893,7 +872,7 @@ struct type constructor_list = Z3native.constructor_list let create (ctx:context) (c:Constructor.constructor list) = - Z3native.mk_constructor_list ctx (List.length c) (Array.of_list c) + 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) = @@ -903,7 +882,7 @@ struct 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 (x,_) = (Z3native.mk_datatype ctx name (List.length constructors) (Array.of_list constructors)) in + 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) = @@ -912,10 +891,9 @@ struct 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 = Array.of_list (List.map f c) in - let (r, a) = Z3native.mk_datatypes ctx n (Array.of_list names) cla in - let g i = Array.get r i in - mk_list g (Array.length r) + let cla = List.map f c in + let (r, _) = Z3native.mk_datatypes ctx n names cla in + r 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 @@ -946,7 +924,7 @@ end 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) (Array.of_list enum_names)) in + 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) = @@ -995,7 +973,7 @@ end 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) (Array.of_list field_names) (Array.of_list field_sorts)) in + 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 @@ -1099,16 +1077,13 @@ struct end let mk_add (ctx:context) (t:expr list) = - let t_arr = Array.of_list t in - Z3native.mk_add ctx (Array.length t_arr) t_arr + Z3native.mk_add ctx (List.length t) t let mk_mul (ctx:context) (t:expr list) = - let t_arr = Array.of_list t in - Z3native.mk_mul ctx (Array.length t_arr) t_arr + Z3native.mk_mul ctx (List.length t) t let mk_sub (ctx:context) (t:expr list) = - let t_arr = Array.of_list t in - Z3native.mk_sub ctx (Array.length t_arr) t_arr + Z3native.mk_sub ctx (List.length t) t let mk_unary_minus = Z3native.mk_unary_minus let mk_div = Z3native.mk_div @@ -1674,7 +1649,7 @@ struct 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) (Array.of_list t) + 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 @@ -1781,8 +1756,7 @@ struct match assumptions with | [] -> Z3native.solver_check (gc x) x | _::_ -> - let assumption_array = Array.of_list assumptions in - Z3native.solver_check_assumptions (gc x) x (Array.length assumption_array) assumption_array + Z3native.solver_check_assumptions (gc x) x (List.length assumptions) assumptions in match lbool_of_int result with | L_TRUE -> SATISFIABLE @@ -1837,7 +1811,7 @@ struct | Some y -> Z3native.fixedpoint_add_rule (gc x) x rule y let add_fact (x:fixedpoint) (pred:func_decl) (args:int list) = - Z3native.fixedpoint_add_fact (gc x) x pred (List.length args) (Array.of_list args) + Z3native.fixedpoint_add_fact (gc x) x pred (List.length args) args let query (x:fixedpoint) (query:expr) = match lbool_of_int (Z3native.fixedpoint_query (gc x) x query) with @@ -1846,7 +1820,7 @@ struct | _ -> Solver.UNKNOWN let query_r (x:fixedpoint) (relations:func_decl list) = - match lbool_of_int (Z3native.fixedpoint_query_relations (gc x) x (List.length relations) (Array.of_list relations)) with + 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 @@ -1869,13 +1843,13 @@ struct 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 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) (Array.of_list kinds) + 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) (Array.of_list queries) + 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 @@ -1944,24 +1918,19 @@ 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 ctx name logic status attributes - (List.length assumptions) (Array.of_list assumptions) + (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 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 + 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 - (Array.of_list sort_names) - (Array.of_list sorts) - cd - (Array.of_list decl_names) - (Array.of_list decls) + 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 @@ -1972,12 +1941,7 @@ struct raise (Error "Argument size mismatch") else Z3native.parse_smtlib_file ctx file_name - cs - (Array.of_list sort_names) - (Array.of_list sorts) - cd - (Array.of_list decl_names) - (Array.of_list decls) + cs sort_names sorts cd decl_names decls let get_num_smtlib_formulas (ctx:context) = Z3native.get_smtlib_num_formulas ctx @@ -2008,34 +1972,26 @@ struct 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 sort_names_arr = Array.of_list sort_names in - let sorts_arr = Array.of_list sorts in - let decl_names_arr = Array.of_list decl_names in - let decls_arr = Array.of_list decls in - let csn = Array.length sort_names_arr in - let cs = Array.length sorts_arr in - let cdn = Array.length decl_names_arr in - let cd = Array.length decls_arr in + 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_smtlib2_string ctx str - cs sort_names_arr sorts_arr cd decl_names_arr decls_arr + 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 sort_names_arr = Array.of_list sort_names in - let sorts_arr = Array.of_list sorts in - let decl_names_arr = Array.of_list decl_names in - let decls_arr = Array.of_list decls in - let csn = Array.length sort_names_arr in - let cs = Array.length sorts_arr in - let cdn = Array.length decl_names_arr in - let cd = Array.length decls_arr in + 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_smtlib2_string ctx file_name - cs sort_names_arr sorts_arr cd decl_names_arr decls_arr + cs sort_names sorts cd decl_names decls end module Interpolation = @@ -2072,29 +2028,17 @@ struct in match r with | 0 -> raise (Error "Interpolation problem could not be read.") - | _ -> - let f1 i = Array.get cnsts i in - let f2 i = Array.get parents i in - let f3 i = Array.get theory i in - (mk_list f1 num, - mk_list f2 num, - mk_list f3 num_theory) + | _ -> (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 - (Array.of_list cnsts) - (Array.of_list parents) - (Array.of_list interps) - num_theory - (Array.of_list theory) in + 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 (Array.of_list cnsts) (Array.of_list parents) filename num_theory (Array.of_list theory) + Z3native.write_interpolation_problem ctx num cnsts parents filename num_theory theory end let set_global_param = Z3native.global_param_set From 6889767c9adcb4fd3e6d6be31695d3f68dfbb0c0 Mon Sep 17 00:00:00 2001 From: "Martin R. Neuhaeusser" Date: Tue, 19 Apr 2016 10:04:49 +0200 Subject: [PATCH 21/25] Fix bug in OCaml API where double values have been wrapped incorrectly. This patch fixes a segmentation fault that occurs due to incorrect wrapping of double values in the OCaml API. --- scripts/update_api.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index 09a10f6cf..16ec1e81e 100755 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -1179,7 +1179,7 @@ def ml_set_wrap(t, d, 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: From 436113896d8699ca49af485285f07c1328958b23 Mon Sep 17 00:00:00 2001 From: "Martin R. Neuhaeusser" Date: Tue, 19 Apr 2016 12:51:16 +0200 Subject: [PATCH 22/25] Fix typo in OCaml bindings --- scripts/update_api.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scripts/update_api.py b/scripts/update_api.py index 16ec1e81e..a06f1fbb1 100755 --- a/scripts/update_api.py +++ b/scripts/update_api.py @@ -1364,11 +1364,11 @@ def mk_z3native_stubs_c(ml_dir): # C interface ts = type2str(t) 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(' 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') + ml_wrapper.write(' assert(_iter == Val_emptylist);\n\n') i = i + 1 ml_wrapper.write('\n /* invoke Z3 function */\n ') From 140f0bb7945ffefb6c01e7139e0fb02f666319e7 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Tue, 3 May 2016 13:34:20 +0100 Subject: [PATCH 23/25] ML API build fix --- src/api/ml/z3native_stubs.c.pre | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/api/ml/z3native_stubs.c.pre b/src/api/ml/z3native_stubs.c.pre index 47655c57e..d6b2cdab4 100644 --- a/src/api/ml/z3native_stubs.c.pre +++ b/src/api/ml/z3native_stubs.c.pre @@ -63,7 +63,7 @@ static struct custom_operations default_custom_ops = { custom_compare_ext_default, }; -inline int compare_pointers(void* pt1, void* pt2) { +int compare_pointers(void* pt1, void* pt2) { if (pt1 == pt2) return 0; else if ((intnat)pt1 < (intnat)pt2) @@ -138,7 +138,7 @@ Z3_context Z3_context_plus_raw(Z3_context_plus * cp) { return (*cp)->ctx; } -inline void try_to_delete_context(Z3_context_plus cp) { +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); From 91af947863fe279f4672c3c0554c9a1b81e0d1a3 Mon Sep 17 00:00:00 2001 From: Nikolaj Bjorner Date: Tue, 3 May 2016 11:09:05 -0700 Subject: [PATCH 24/25] adding checks for #570 Signed-off-by: Nikolaj Bjorner --- src/sat/sat_clause_set.cpp | 8 +++++++- src/smt/theory_arith_core.h | 26 ++++++++++++++++++-------- 2 files changed, 25 insertions(+), 9 deletions(-) diff --git a/src/sat/sat_clause_set.cpp b/src/sat/sat_clause_set.cpp index ca8e9d841..29c761130 100644 --- a/src/sat/sat_clause_set.cpp +++ b/src/sat/sat_clause_set.cpp @@ -35,6 +35,8 @@ namespace sat { unsigned id = c.id(); if (id >= m_id2pos.size()) return; + if (empty()) + return; unsigned pos = m_id2pos[id]; if (pos == UINT_MAX) return; @@ -52,7 +54,11 @@ namespace sat { clause & clause_set::erase() { SASSERT(!empty()); clause & c = *m_set.back(); - m_id2pos[c.id()] = UINT_MAX; + SASSERT(c.id() < m_id2pos.size()); + SASSERT(m_id2pos[c.id()] == m_set.size()-1); + if (c.id() < m_id2pos.size()) { + m_id2pos[c.id()] = UINT_MAX; + } m_set.pop_back(); return c; } diff --git a/src/smt/theory_arith_core.h b/src/smt/theory_arith_core.h index 8a83b93bd..95c7fdfad 100644 --- a/src/smt/theory_arith_core.h +++ b/src/smt/theory_arith_core.h @@ -1866,7 +1866,7 @@ namespace smt { template template void theory_arith::pivot(theory_var x_i, theory_var x_j, numeral const & a_ij, bool apply_gcd_test) { - TRACE("arith_pivot", tout << "pivoting: v" << x_i << ", v" << x_j << "\n";); + TRACE("arith_pivoting", tout << "pivoting: v" << x_i << ", v" << x_j << "\n";); m_stats.m_pivots++; SASSERT(is_base(x_i) || is_quasi_base(x_i)); SASSERT(x_i != x_j); @@ -2067,14 +2067,14 @@ namespace smt { theory_var max = get_num_vars(); theory_var result = max; row const & r = m_rows[get_var_row(x_i)]; - int n; int best_col_sz = INT_MAX; int best_so_far = INT_MAX; - - typename vector::const_iterator it = r.begin_entries(); + int n = 0; + typename vector::const_iterator it = r.begin_entries(); typename vector::const_iterator end = r.end_entries(); - - for (; it != end; ++it) { + + for (; it != end; ++it) { + if (!it->is_dead()) { theory_var x_j = it->m_var; numeral const & a_ij = it->m_coeff; @@ -2090,14 +2090,14 @@ namespace smt { best_so_far = num; best_col_sz = col_sz; n = 1; - } + } else if (num == best_so_far && col_sz == best_col_sz) { n++; if (m_random()%n == 0) { result = x_j; out_a_ij = a_ij; } - } + } } } } @@ -2174,6 +2174,7 @@ namespace smt { inf_numeral curr_error; typename var_heap::iterator it = m_to_patch.begin(); typename var_heap::iterator end = m_to_patch.end(); + //unsigned n = 0; for (; it != end; ++it) { theory_var v = *it; if (below_lower(v)) @@ -2188,7 +2189,16 @@ namespace smt { << ", best_error: " << best_error << ", curr_error: " << curr_error << "\n";); best = v; best_error = curr_error; + //n = 2; } +#if 0 + else if (false && n > 0 && curr_error == best_error) { + n++; + if (m_random()%n == 0) { + best = v; + } + } +#endif } if (best == null_theory_var) m_to_patch.clear(); // all variables are satisfied From d11d9bd1de1d90dbca9db865ee6d5b4e52a5888a Mon Sep 17 00:00:00 2001 From: Nikolaj Bjorner Date: Tue, 3 May 2016 16:24:12 -0700 Subject: [PATCH 25/25] avoid crash on quantifiers + sequences Signed-off-by: Nikolaj Bjorner --- src/smt/theory_seq.cpp | 6 ++++-- src/smt/theory_seq_empty.h | 25 +++++++++++++++++++++---- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/src/smt/theory_seq.cpp b/src/smt/theory_seq.cpp index a8811b179..86761412f 100644 --- a/src/smt/theory_seq.cpp +++ b/src/smt/theory_seq.cpp @@ -2380,7 +2380,7 @@ void theory_seq::init_model(expr_ref_vector const& es) { } void theory_seq::init_model(model_generator & mg) { - m_factory = alloc(seq_factory, get_manager(), get_family_id()); + m_factory = alloc(seq_factory, get_manager(), get_family_id(), mg.get_model()); mg.register_factory(m_factory); for (unsigned j = 0; j < m_nqs.size(); ++j) { ne const& n = m_nqs[j]; @@ -2469,7 +2469,9 @@ model_value_proc * theory_seq::mk_value(enode * n, model_generator & mg) { for (unsigned i = 0; i < concats.size(); ++i) { expr* c = concats[i], *c1; if (m_util.str.is_unit(c, c1)) { - sv->add_dependency(ctx.get_enode(c1)); + if (ctx.e_internalized(c1)) { + sv->add_dependency(ctx.get_enode(c1)); + } } else if (m_util.str.is_string(c)) { sv->add_string(c); diff --git a/src/smt/theory_seq_empty.h b/src/smt/theory_seq_empty.h index be17fe5ac..27c72cc97 100644 --- a/src/smt/theory_seq_empty.h +++ b/src/smt/theory_seq_empty.h @@ -25,6 +25,7 @@ Revision History: namespace smt { class seq_factory : public value_factory { typedef hashtable symbol_set; + proto_model& m_model; ast_manager& m; seq_util u; symbol_set m_strings; @@ -34,8 +35,9 @@ namespace smt { expr_ref_vector m_trail; public: - seq_factory(ast_manager & m, family_id fid): + seq_factory(ast_manager & m, family_id fid, proto_model& md): value_factory(m, fid), + m_model(md), m(m), u(m), m_next(0), @@ -78,6 +80,17 @@ namespace smt { v2 = u.str.mk_string(symbol("b")); return true; } + sort* ch; + if (u.is_seq(s, ch)) { + if (m_model.get_some_values(ch, v1, v2)) { + v1 = u.str.mk_unit(v1); + v2 = u.str.mk_unit(v2); + return true; + } + else { + return false; + } + } NOT_IMPLEMENTED_YET(); return false; } @@ -92,7 +105,7 @@ namespace smt { return u.str.mk_string(sym); } } - sort* seq = 0; + sort* seq = 0, *ch = 0; if (u.is_re(s, seq)) { expr* v0 = get_fresh_value(seq); return u.re.mk_to_re(v0); @@ -102,7 +115,11 @@ namespace smt { //return u.str.mk_char(zstring(s), 0); return u.str.mk_char(zstring("a"), 0); } - NOT_IMPLEMENTED_YET(); + if (u.is_seq(s, ch)) { + expr* v = m_model.get_fresh_value(ch); + return u.str.mk_unit(v); + } + UNREACHABLE(); return 0; } virtual void register_value(expr* n) { @@ -126,7 +143,7 @@ namespace smt { public: theory_seq_empty(ast_manager& m):theory(m.mk_family_id("seq")), m_used(false) {} virtual void init_model(model_generator & mg) { - mg.register_factory(alloc(seq_factory, get_manager(), get_family_id())); + mg.register_factory(alloc(seq_factory, get_manager(), get_family_id(), mg.get_model())); } };