ML build system checks

Signed-off-by: Christoph M. Wintersteiger <cwinter@microsoft.com>

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.

src/api/ml/z3.ml

@@ -10,24 +10,9 @@ 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
+  let open_ fn = int2lbool(open_log fn) == L_TRUE
-		 Printf.printf "ol returned %d\n" rv ;
+  let close = (close_log)
-		 ((int2lbool rv) == L_TRUE)
+  let append s = (append_log s)
-  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 = 
@@ -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 
+  initializer Gc.finalise (fun self -> self#dispose) self
-    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)
+    | Some(x) -> (Array.length x)
-      | None -> 0
+    | 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  = 
+  method kind = match m_n_obj with
-object(self)
+    | Some(x) -> (int2symbol_kind (get_symbol_kind self#get_native_context x))
-  inherit symbol ctx_init obj_init
+    | _ -> raise (Exception "Underlying object lost")
-end
 
-class string_symbol ctx_init obj_init = 
+  method is_int_symbol = match m_n_obj with
-object(self)
+    | Some(x) -> self#kind == INT_SYMBOL
-  inherit symbol ctx_init obj_init
+    | _ -> false
-end
 
-module Symbol =
+  method is_string_symbol = match m_n_obj with
-struct
+    | Some(x) -> self#kind == STRING_SYMBOL
-  let create ctx obj =
+    | _ -> 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)
+	  | INT_SYMBOL -> (new intsymbol ctx obj :> symbol)
-          | STRING_SYMBOL -> (new string_symbol 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
+end
-    | Some(x) -> (int2symbol_kind (get_symbol_kind o#get_native_context x))
+
-    | _ -> raise (Exception "Underlying object lost")
+and intsymbol ctx_init obj_init  = 
-
+object(self)
-  let is_int_symbol o = match o#m_n_obj with
+  inherit symbol ctx_init obj_init
-    | Some(x) -> x#kind == INT_SYMBOL
+
-    | _ -> false
+  method get_int = match m_n_obj with
-
+    | Some(x) -> (get_symbol_int m_ctx#get_native x)
-  let is_string_symbol o = match o#m_n_obj with
+    | None -> 0
-    | Some(x) -> x#kind == STRING_SYMBOL
+end
-    | _ -> false
+
-
+and stringsymbol ctx_init obj_init = 
-  let get_int o = match o#m_n_obj with
+object(self)
-    | Some(x) -> (get_symbol_int o#get_native_context x)
+  inherit symbol ctx_init obj_init
-    | 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