mirror of
https://github.com/Z3Prover/z3
synced 2025-04-12 12:08:18 +00:00
more ML API
Signed-off-by: Christoph M. Wintersteiger <cwinter@microsoft.com>
This commit is contained in:
parent
0e98d26721
commit
50560ba791
|
@ -23,48 +23,42 @@ end
|
||||||
class context settings =
|
class context settings =
|
||||||
object (self)
|
object (self)
|
||||||
inherit idisposable
|
inherit idisposable
|
||||||
val mutable m_n_ctx : Z3native.z3_context option = None
|
|
||||||
|
val mutable m_n_ctx : Z3native.z3_context =
|
||||||
|
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
|
||||||
|
del_config(cfg) ;
|
||||||
|
v
|
||||||
|
|
||||||
val mutable m_refCount : int = 0
|
val mutable m_refCount : int = 0
|
||||||
|
|
||||||
initializer
|
initializer Gc.finalise (fun self -> self#dispose) self
|
||||||
let cfg = mk_config() in
|
|
||||||
(match settings with
|
|
||||||
| Some(x) ->
|
|
||||||
let f e = (set_param_value cfg (fst e) (snd e)) in
|
|
||||||
(List.iter f x)
|
|
||||||
| _ -> ()
|
|
||||||
) ;
|
|
||||||
m_n_ctx <- Some (mk_context_rc cfg) ;
|
|
||||||
del_config(cfg) ;
|
|
||||||
Gc.finalise (fun self -> self#dispose) self
|
|
||||||
|
|
||||||
method dispose : unit =
|
method dispose : unit =
|
||||||
if m_refCount == 0 then (
|
if m_refCount == 0 then (
|
||||||
Printf.printf "Disposing %d \n" (Oo.id self) ;
|
Printf.printf "Disposing %d \n" (Oo.id self) ;
|
||||||
match m_n_ctx with
|
(del_context m_n_ctx)
|
||||||
| Some(x) -> (del_context x)
|
|
||||||
| None -> ()
|
|
||||||
) else (
|
) else (
|
||||||
(* re-queue for finalization? *)
|
(* re-queue for finalization? *)
|
||||||
)
|
)
|
||||||
|
|
||||||
method sub_one_ctx_obj = m_refCount <- m_refCount - 1
|
method sub_one_ctx_obj = m_refCount <- m_refCount - 1
|
||||||
method add_one_ctx_obj = m_refCount <- m_refCount + 1
|
method add_one_ctx_obj = m_refCount <- m_refCount + 1
|
||||||
|
method get_native = m_n_ctx
|
||||||
end
|
end
|
||||||
|
|
||||||
class virtual z3object ctx_init obj_init =
|
class virtual z3object ctx_init obj_init =
|
||||||
object (self)
|
object (self)
|
||||||
inherit idisposable
|
inherit idisposable
|
||||||
val mutable m_ctx : context option = ctx_init
|
val mutable m_ctx : context = ctx_init
|
||||||
val mutable m_n_obj : Z3native.ptr option = obj_init
|
val mutable m_n_obj : Z3native.ptr option = obj_init
|
||||||
|
|
||||||
initializer
|
initializer
|
||||||
(match m_n_obj with
|
(match m_n_obj with
|
||||||
| Some (x) -> self#incref x;
|
| Some (x) -> self#incref x;
|
||||||
(match m_ctx with
|
m_ctx#add_one_ctx_obj
|
||||||
| Some(x) -> x#add_one_ctx_obj
|
|
||||||
| None -> ()
|
|
||||||
)
|
|
||||||
| None -> ()
|
| None -> ()
|
||||||
);
|
);
|
||||||
Gc.finalise (fun self -> self#dispose) self
|
Gc.finalise (fun self -> self#dispose) self
|
||||||
|
@ -78,15 +72,9 @@ object (self)
|
||||||
method dispose =
|
method dispose =
|
||||||
Printf.printf "Disposing z3object %d \n" (Oo.id self) ;
|
Printf.printf "Disposing z3object %d \n" (Oo.id self) ;
|
||||||
(match m_n_obj with
|
(match m_n_obj with
|
||||||
| Some (x) -> self#decref x; m_n_obj <- None
|
| Some (x) -> self#decref x; m_n_obj <- None; m_ctx#sub_one_ctx_obj
|
||||||
| None -> ()
|
| None -> ()
|
||||||
);
|
);
|
||||||
(match m_ctx with
|
|
||||||
| Some (x) -> x#sub_one_ctx_obj
|
|
||||||
| None -> ()
|
|
||||||
);
|
|
||||||
m_ctx <- None
|
|
||||||
|
|
||||||
|
|
||||||
method get_native_object = m_n_obj
|
method get_native_object = m_n_obj
|
||||||
|
|
||||||
|
@ -102,6 +90,7 @@ object (self)
|
||||||
m_n_obj <- x
|
m_n_obj <- x
|
||||||
|
|
||||||
method get_context = m_ctx
|
method get_context = m_ctx
|
||||||
|
method get_native_context = m_ctx#get_native
|
||||||
|
|
||||||
(*
|
(*
|
||||||
method array_to_native a =
|
method array_to_native a =
|
||||||
|
@ -113,6 +102,57 @@ object (self)
|
||||||
| Some(x) -> (Array.length x)
|
| Some(x) -> (Array.length x)
|
||||||
| None -> 0
|
| None -> 0
|
||||||
*)
|
*)
|
||||||
|
end
|
||||||
|
|
||||||
|
class symbol ctx_init obj_init =
|
||||||
|
object (self)
|
||||||
|
inherit z3object ctx_init obj_init
|
||||||
|
|
||||||
|
method incref o = ()
|
||||||
|
method decref o = ()
|
||||||
|
|
||||||
|
method kind = match m_n_obj with
|
||||||
|
| Some(x) -> (int2symbol_kind (get_symbol_kind self#get_native_context x))
|
||||||
|
| _ -> raise (Exception "Underlying object lost")
|
||||||
|
|
||||||
|
method is_int_symbol = match m_n_obj with
|
||||||
|
| Some(x) -> self#kind == INT_SYMBOL
|
||||||
|
| _ -> false
|
||||||
|
|
||||||
|
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 =
|
||||||
|
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)
|
||||||
|
)
|
||||||
|
| None -> raise (Exception "Can't create null objects")
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
and intsymbol ctx_init obj_init =
|
||||||
|
object(self)
|
||||||
|
inherit symbol ctx_init obj_init
|
||||||
|
|
||||||
|
method get_int = match m_n_obj with
|
||||||
|
| Some(x) -> (get_symbol_int m_ctx#get_native x)
|
||||||
|
| None -> 0
|
||||||
|
end
|
||||||
|
|
||||||
|
and stringsymbol ctx_init obj_init =
|
||||||
|
object(self)
|
||||||
|
inherit symbol ctx_init obj_init
|
||||||
|
end
|
||||||
|
|
Loading…
Reference in a new issue