From cfa099007a2c93628ab5fae0acdf32224d1dc483 Mon Sep 17 00:00:00 2001 From: "Christoph M. Wintersteiger" Date: Thu, 20 Dec 2012 20:51:18 +0000 Subject: [PATCH] ML build system checks Signed-off-by: Christoph M. Wintersteiger --- scripts/mk_util.py | 5 +- src/api/ml/z3.ml | 127 +++++++++++++++++++-------------------------- 2 files changed, 55 insertions(+), 77 deletions(-) diff --git a/scripts/mk_util.py b/scripts/mk_util.py index 38af3893f..a0f123609 100644 --- a/scripts/mk_util.py +++ b/scripts/mk_util.py @@ -1439,7 +1439,7 @@ class MLComponent(Component): for mlfile in get_ml_files(self.src_dir): out.write(' %s' % os.path.join(self.to_src_dir, mlfile)) out.write('\n') - out.write('\t$(CXX) $(CXXFLAGS) $(CXX_OUT_FLAG)api/ml/z3native$(OBJ_EXT) -I%s %s/z3native.c\n' % (get_component(API_COMPONENT).to_src_dir, self.to_src_dir)) + out.write('\t$(CXX) $(CXXFLAGS) $(CXX_OUT_FLAG)api/ml/z3native$(OBJ_EXT) -I%s -I%s %s/z3native.c\n' % (get_component(API_COMPONENT).to_src_dir, OCAML_LIB, self.to_src_dir)) out.write('\t$(SLINK) $(SLINK_OUT_FLAG)%s $(SLINK_FLAGS) %s$(OBJ_EXT) libz3$(SO_EXT)\n' % (libfile, os.path.join('api', 'ml', 'z3native'))) out.write('z3.cmxa: %s\n' % libfile) out.write('\tcd %s && ocamlbuild -cflags \'-g\' -lflags -cclib,-L../..,-cclib,-lz3,-cclib,-lz3ml,-linkall -build-dir ../../../%s/api/ml z3.cmxa z3native$(OBJ_EXT) && cd -\n' % (self.to_src_dir,BUILD_DIR)) @@ -1577,7 +1577,7 @@ class MLExampleComponent(ExampleComponent): for mlfile in get_ml_files(self.ex_dir): out.write(' %s/%s' % (self.to_ex_dir, mlfile)) out.write('\n') - out.write('ml_example($EXE_EXT): z3.cmxa ') + out.write('ml_example($EXE_EXT): z3.cmxa ml_example.byte') for mlfile in get_ml_files(self.ex_dir): out.write(' %s' % os.path.join(self.to_ex_dir, mlfile)) out.write('\n') @@ -2434,6 +2434,7 @@ def mk_bindings(api_files): _execfile(os.path.join('scripts', 'update_api.py'), g) # HACK cp_z3py_to_build() if is_ml_enabled(): + check_ml() mk_z3consts_ml(api_files) # Extract enumeration types from API files, and add python definitions. diff --git a/src/api/ml/z3.ml b/src/api/ml/z3.ml index 31bb7e5fc..4f847bc48 100644 --- a/src/api/ml/z3.ml +++ b/src/api/ml/z3.ml @@ -10,26 +10,11 @@ module Log = struct let m_is_open = false (* CMW: "open" seems to be an invalid function name*) - 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 + let open_ fn = int2lbool(open_log fn) == 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 = object method virtual dispose : unit @@ -40,7 +25,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 @@ -49,15 +34,14 @@ 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 ( Printf.printf "Disposing %d \n" (Oo.id self) ; (del_context m_n_ctx) ) else ( - (* re-queue for finalization? *) + (* re-queue for finalization? *) ) method sub_one_ctx_obj = m_refCount <- m_refCount - 1 @@ -82,9 +66,9 @@ object (self) method virtual incref : Z3native.ptr -> unit method virtual decref : Z3native.ptr -> unit - (* - Disposes of the underlying native Z3 object. - *) + (* + Disposes of the underlying native Z3 object. + *) method dispose = Printf.printf "Disposing z3object %d \n" (Oo.id self) ; (match m_n_obj with @@ -108,17 +92,16 @@ object (self) method get_context = m_ctx method get_native_context = m_ctx#get_native -(* - method array_to_native a = + (* + method array_to_native a = let f e = e#get_native_object in (Array.map f a) - method array_length a = + method array_length a = match a with - | Some(x) -> (Array.length x) - | None -> 0 -*) - + | Some(x) -> (Array.length x) + | None -> 0 + *) end class symbol ctx_init obj_init = @@ -127,55 +110,49 @@ object (self) method incref o = () method decref o = () -end -class int_symbol ctx_init obj_init = -object(self) - inherit symbol ctx_init obj_init -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 string_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 -module Symbol = -struct - let create ctx obj = + 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 int_symbol ctx obj :> symbol) - | STRING_SYMBOL -> (new string_symbol ctx obj :> symbol) + | INT_SYMBOL -> (new intsymbol ctx obj :> symbol) + | STRING_SYMBOL -> (new stringsymbol ctx obj :> symbol) ) | None -> raise (Exception "Can't create null objects") - 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") - - let is_int_symbol o = match o#m_n_obj with - | Some(x) -> x#kind == INT_SYMBOL - | _ -> false - - let is_string_symbol o = match o#m_n_obj with - | Some(x) -> x#kind == STRING_SYMBOL - | _ -> false - - let get_int o = match o#m_n_obj with - | Some(x) -> (get_symbol_int o#get_native_context x) - | None -> 0 - - 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 + +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