mirrors/z3
3
0
Fork 0
mirror of https://github.com/Z3Prover/z3 synced 2025-11-03 21:09:11 +00:00
Code Activity

ML API bugfixes

Browse source 
Signed-off-by: Christoph M. Wintersteiger <cwinter@microsoft.com>
This commit is contained in:
Christoph M. Wintersteiger 2012-12-20 04:10:38 +00:00
parent 0fad5abd19
commit b193b827ed
3 changed files with 101 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

14
examples/ml/ml_example.ml
View file

@ -5,10 +5,18 @@
open Z3
let _ = ignore(Log.open_ "z3.log") ;
let cfg = Some [("model", "true"); ("proof", "false")] in
exception ExampleException of string
let _ =
if not (Log.open_ "z3.log") then
raise (ExampleException "Log couldn't be opened.")
else
(
Printf.printf "Running Z3 version %s\n" Version.to_string ;
let cfg = [("model", "true"); ("proof", "false")] in
let ctx = (new context cfg) in
Printf.printf "Disposing...\n";
ctx#dispose ;
ctx#dispose (* can do, but we'd rather let it go out of scope *) ;
);
Printf.printf "Exiting.\n";
;;

19
scripts/update_api.py
View file

@ -325,7 +325,9 @@ def param2pystr(p):
def param2ml(p):
k = param_kind(p)
if k == OUT:
if param_type(p) == STRING:
if param_type(p) == INT or param_type(p) == UINT or param_type(p) == INT64 or param_type(p) == UINT64:
return "int"
elif param_type(p) == STRING:
return "string"
else:
return "ptr"
@ -1124,9 +1126,16 @@ def mk_ml():
ml_native.write('%s -> ' % param2ml(p))
if len(op) > 0:
ml_native.write('(')
first = True
if result != VOID or len(op) == 0:
ml_native.write('%s' % type2ml(result))
first = False
for p in op:
ml_native.write(' * %s' % param2ml(p))
if first:
first = False
else:
ml_native.write(' * ')
ml_native.write('%s' % param2ml(p))
if len(op) > 0:
ml_native.write(')')
ml_native.write('\n')
@ -1153,11 +1162,13 @@ def mk_ml():
i = i + 1
ml_native.write(' = \n')
ml_native.write(' ')
if result == VOID:
if result == VOID and len(op) == 0:
ml_native.write('let _ = ')
else:
ml_native.write('let res = ')
ml_native.write('(ML2C.n_%s' % (ml_method_name(name)))
if len(ip) == 0:
ml_native.write(' ()')
first = True
i = 0;
for p in params:
@ -1170,7 +1181,7 @@ def mk_ml():
ml_native.write(' if err <> OK then\n')
ml_native.write(' raise (Exception (ML2C.n_get_error_msg_ex a0 (error_code2int err)))\n')
ml_native.write(' else\n')
if result == VOID:
if result == VOID and len(op) == 0:
ml_native.write(' ()\n')
else:
ml_native.write(' res\n')

97
src/api/ml/z3.ml
View file

@ -10,9 +10,24 @@ module Log =
struct
let m_is_open = false
(* CMW: "open" seems to be an invalid function name*)
let open_ fn = int2lbool(open_log fn) == L_TRUE
let close = (close_log)
let append s = (append_log s)
let open_ fn = let rv = (open_log fn) in
Printf.printf "ol returned %d\n" rv ;
((int2lbool rv) == L_TRUE)
let close = close_log
let append s = append_log s
end
module Version =
struct
let major = let (x, _, _, _) = get_version in x
let minor = let (_, x, _, _) = get_version in x
let build = let (_, _, x, _) = get_version in x
let revision = let (_, _, _, x) = get_version in x
let to_string =
string_of_int major ^ "." ^
string_of_int minor ^ "." ^
string_of_int build ^ "." ^
string_of_int revision ^ "."
end
class virtual idisposable =
@ -25,7 +40,7 @@ object (self)
inherit idisposable
val mutable m_n_ctx : Z3native.z3_context =
let cfg = mk_config() in
let cfg = mk_config in
let f e = (set_param_value cfg (fst e) (snd e)) in
(List.iter f settings) ;
let v = mk_context_rc cfg in
@ -34,7 +49,8 @@ object (self)
val mutable m_refCount : int = 0
initializer Gc.finalise (fun self -> self#dispose) self
initializer
Gc.finalise (fun self -> self#dispose) self
method dispose : unit =
if m_refCount == 0 then (
@ -102,6 +118,7 @@ object (self)
| Some(x) -> (Array.length x)
| None -> 0
*)
end
class symbol ctx_init obj_init =
@ -110,51 +127,55 @@ object (self)
method incref o = ()
method decref o = ()
end
method kind = match m_n_obj with
| Some(x) -> (int2symbol_kind (get_symbol_kind self#get_native_context x))
| _ -> raise (Exception "Underlying object lost")
class int_symbol ctx_init obj_init =
object(self)
inherit symbol ctx_init obj_init
end
method is_int_symbol = match m_n_obj with
| Some(x) -> self#kind == INT_SYMBOL
| _ -> false
class string_symbol ctx_init obj_init =
object(self)
inherit symbol ctx_init obj_init
end
method is_string_symbol = match m_n_obj with
| Some(x) -> self#kind == STRING_SYMBOL
| _ -> false
method to_string = match m_n_obj with
| Some(x) ->
(
match self#kind with
| INT_SYMBOL -> (string_of_int (get_symbol_int self#get_native_context x))
| STRING_SYMBOL -> (get_symbol_string self#get_native_context x)
)
| None -> ""
method create ctx obj =
module Symbol =
struct
let create ctx obj =
match obj with
| Some(x) -> (
match (int2symbol_kind (get_symbol_kind ctx#get_native x)) with
| INT_SYMBOL -> (new intsymbol ctx obj :> symbol)
| STRING_SYMBOL -> (new stringsymbol ctx obj :> symbol)
| INT_SYMBOL -> (new int_symbol ctx obj :> symbol)
| STRING_SYMBOL -> (new string_symbol ctx obj :> symbol)
)
| None -> raise (Exception "Can't create null objects")
end
let kind o = match o#m_n_obj with
| Some(x) -> (int2symbol_kind (get_symbol_kind o#get_native_context x))
| _ -> raise (Exception "Underlying object lost")
end
let is_int_symbol o = match o#m_n_obj with
| Some(x) -> x#kind == INT_SYMBOL
| _ -> false
and intsymbol ctx_init obj_init =
object(self)
inherit symbol ctx_init obj_init
let is_string_symbol o = match o#m_n_obj with
| Some(x) -> x#kind == STRING_SYMBOL
| _ -> false
method get_int = match m_n_obj with
| Some(x) -> (get_symbol_int m_ctx#get_native x)
let get_int o = match o#m_n_obj with
| Some(x) -> (get_symbol_int o#get_native_context x)
| None -> 0
end
and stringsymbol ctx_init obj_init =
object(self)
inherit symbol ctx_init obj_init
let get_string o = match o#m_n_obj with
| Some(x) -> (get_symbol_string o#get_native_context x)
| None -> ""
let to_string o = match o#m_n_obj with
| Some(x) ->
(
match (kind o) with
| INT_SYMBOL -> (string_of_int (get_symbol_int o#get_native_context x))
| STRING_SYMBOL -> (get_symbol_string o#get_native_context x)
)
| None -> ""
end