diff --git a/src/checker/drup_check.ml b/src/checker/drup_check.ml index 1f576800..bec1666e 100644 --- a/src/checker/drup_check.ml +++ b/src/checker/drup_check.ml @@ -53,7 +53,7 @@ end Each event is checked by reverse-unit propagation on previous events. *) module Fwd_check : sig - type error = [ `Bad_steps of Veci.t | `No_empty_clause ] + type error = [ `Bad_steps of int Vec.t | `No_empty_clause ] val pp_error : Trace.t -> error Fmt.printer @@ -62,10 +62,10 @@ module Fwd_check : sig success. In case of error it returns [Error idxs] where [idxs] are the indexes in the trace of the steps that failed. *) end = struct - type t = { checker: Checker.t; errors: Veci.t } + type t = { checker: Checker.t; errors: int Vec.t } let create cstore : t = - { checker = Checker.create cstore; errors = Veci.create () } + { checker = Checker.create cstore; errors = Vec.create () } (* check event, return [true] if it's valid *) let check_op (self : t) i (op : Trace.op) : bool = @@ -85,15 +85,15 @@ end = struct Checker.del_clause self.checker c; true - type error = [ `Bad_steps of Veci.t | `No_empty_clause ] + type error = [ `Bad_steps of int Vec.t | `No_empty_clause ] let pp_error trace out = function | `No_empty_clause -> Fmt.string out "no empty clause found" | `Bad_steps bad -> - let n0 = Veci.get bad 0 in + let n0 = Vec.get bad 0 in Fmt.fprintf out "@[checking failed on %d ops.@ @[<2>First failure is op[%d]:@ %a@]@]" - (Veci.size bad) n0 Trace.pp_op (Trace.get trace n0) + (Vec.size bad) n0 Trace.pp_op (Trace.get trace n0) let check trace : _ result = let self = create (Trace.cstore trace) in @@ -114,13 +114,13 @@ end = struct ) else ( Log.debugf 10 (fun k -> k "(@[check.proof_rule.fail@ :idx %d@ :op %a@])" i Trace.pp_op op); - Veci.push self.errors i + Vec.push self.errors i )); - Log.debugf 10 (fun k -> k "found %d errors" (Veci.size self.errors)); + Log.debugf 10 (fun k -> k "found %d errors" (Vec.size self.errors)); if not !has_false then Error `No_empty_clause - else if Veci.size self.errors > 0 then + else if Vec.size self.errors > 0 then Error (`Bad_steps self.errors) else Ok () diff --git a/src/main/show_trace.ml b/src/main/show_trace.ml index 38e56702..de64bf2a 100644 --- a/src/main/show_trace.ml +++ b/src/main/show_trace.ml @@ -10,7 +10,7 @@ type state = { p_reader: Proof.Trace_reader.t; } -let show_sat (self : state) ~tag v : unit = +let show_sat (_self : state) ~tag v : unit = match tag with | "AssCSat" -> (match diff --git a/src/sat/heap.ml b/src/sat/heap.ml index 468cb99a..aea71157 100644 --- a/src/sat/heap.ml +++ b/src/sat/heap.ml @@ -4,10 +4,10 @@ module type S = Heap_intf.S module Make (Elt : RANKED) = struct type elt_store = Elt.store type elt = Elt.t - type t = { store: elt_store; heap: Veci.t (* vec of elements *) } + type t = { store: elt_store; heap: int Vec.t (* vec of elements *) } let _absent_index = -1 - let create store : t = { store; heap = Veci.create () } + let create store : t = { store; heap = Vec.create () } let[@inline] left i = (i lsl 1) + 1 (* i*2 + 1 *) let[@inline] right i = (i + 1) lsl 1 (* (i+1)*2 *) @@ -16,17 +16,17 @@ module Make (Elt : RANKED) = struct (* let rec heap_property cmp ({heap=heap} as s) i = - i >= (Veci.size heap) || + i >= (Vec.size heap) || ((i = 0 || not(cmp (Vec. get heap i) (Vec.get heap (parent i)))) && heap_property cmp s (left i) && heap_property cmp s (right i)) let heap_property cmp s = heap_property cmp s 1 *) - let[@inline] get_elt_ self i = Elt.of_int_unsafe (Veci.get self.heap i) + let[@inline] get_elt_ self i = Elt.of_int_unsafe (Vec.get self.heap i) let[@inline] set_elt_ self i elt = - Veci.set self.heap i (elt : Elt.t :> int) + Vec.set self.heap i (elt : Elt.t :> int) (* [elt] is above or at its expected position. Move it up the heap (towards high indices) to restore the heap property *) @@ -43,7 +43,7 @@ module Make (Elt : RANKED) = struct Elt.set_heap_idx self.store elt !i let percolate_down (self : t) (elt : Elt.t) : unit = - let sz = Veci.size self.heap in + let sz = Vec.size self.heap in let li = ref (left (Elt.heap_idx self.store elt)) in let ri = ref (right (Elt.heap_idx self.store elt)) in let i = ref (Elt.heap_idx self.store elt) in @@ -83,7 +83,7 @@ module Make (Elt : RANKED) = struct let filter (self : t) filt : unit = let j = ref 0 in - let lim = Veci.size self.heap in + let lim = Vec.size self.heap in for i = 0 to lim - 1 do if filt (get_elt_ self i) then ( set_elt_ self !j (get_elt_ self i); @@ -92,24 +92,24 @@ module Make (Elt : RANKED) = struct ) else Elt.set_heap_idx self.store (get_elt_ self i) _absent_index done; - Veci.shrink self.heap (lim - !j); + Vec.shrink self.heap (lim - !j); for i = (lim / 2) - 1 downto 0 do percolate_down self (get_elt_ self i) done - let[@inline] size s = Veci.size s.heap - let[@inline] is_empty s = Veci.is_empty s.heap + let[@inline] size s = Vec.size s.heap + let[@inline] is_empty s = Vec.is_empty s.heap let clear self : unit = - Veci.iter self.heap ~f:(fun e -> + Vec.iter self.heap ~f:(fun e -> Elt.set_heap_idx self.store (Elt.of_int_unsafe e) _absent_index); - Veci.clear self.heap; + Vec.clear self.heap; () let insert self elt = if not (in_heap self elt) then ( - Elt.set_heap_idx self.store elt (Veci.size self.heap); - Veci.push self.heap (elt : Elt.t :> int); + Elt.set_heap_idx self.store elt (Vec.size self.heap); + Vec.push self.heap (elt : Elt.t :> int); percolate_up self elt ) @@ -128,21 +128,21 @@ module Make (Elt : RANKED) = struct *) let remove_min self = - match Veci.size self.heap with + match Vec.size self.heap with | 0 -> raise Not_found | 1 -> - let x = Elt.of_int_unsafe (Veci.pop self.heap) in + let x = Elt.of_int_unsafe (Vec.pop_exn self.heap) in Elt.set_heap_idx self.store x _absent_index; x | _ -> let x = get_elt_ self 0 in - let new_hd = Elt.of_int_unsafe (Veci.pop self.heap) in + let new_hd = Elt.of_int_unsafe (Vec.pop_exn self.heap) in (* heap.last() *) set_elt_ self 0 new_hd; Elt.set_heap_idx self.store x _absent_index; Elt.set_heap_idx self.store new_hd 0; (* enforce heap property again *) - if Veci.size self.heap > 1 then percolate_down self new_hd; + if Vec.size self.heap > 1 then percolate_down self new_hd; x end [@@inline] diff --git a/src/sat/solver.ml b/src/sat/solver.ml index d9a6f775..6010475b 100644 --- a/src/sat/solver.ml +++ b/src/sat/solver.ml @@ -13,7 +13,7 @@ module Atom = Store.Atom module Var = Store.Var module Clause = Store.Clause -module H = Heap.Make [@specialise] (struct +module H = Heap.Make (struct type store = Store.t type t = var @@ -262,7 +262,7 @@ type t = { store them here. *) trail: AVec.t; (* decision stack + propagated elements (atoms or assignments). *) - var_levels: Veci.t; (* decision levels in [trail] *) + var_levels: int Vec.t; (* decision levels in [trail] *) assumptions: AVec.t; (* current assumptions *) mutable th_head: int; (* Start offset in the queue {!trail} of @@ -328,7 +328,7 @@ let create_ ~store ~tracer ~stat ~max_clauses_learnt (plugin : plugin) : t = th_head = 0; elt_head = 0; trail = AVec.create (); - var_levels = Veci.create (); + var_levels = Vec.create (); assumptions = AVec.create (); order = H.create store; var_incr = 1.; @@ -357,7 +357,7 @@ let iter_clauses_learnt_ (self : t) ~f : unit = Vec.iter ~f:iter_pool self.clause_pools; () -let[@inline] decision_level st = Veci.size st.var_levels +let[@inline] decision_level st = Vec.size st.var_levels let[@inline] nb_clauses st = CVec.size st.clauses_hyps let stat self = self.stat @@ -578,7 +578,7 @@ let preprocess_clause_ (self : t) (c : Clause.t) : Clause.t = let new_decision_level (self : t) = assert (self.th_head = AVec.size self.trail); assert (self.elt_head = AVec.size self.trail); - Veci.push self.var_levels (AVec.size self.trail); + Vec.push self.var_levels (AVec.size self.trail); let (module P) = self.plugin in P.push_level (); () @@ -613,7 +613,7 @@ let cancel_until (self : t) lvl = else ( Log.debugf 5 (fun k -> k "(@[sat.cancel-until %d@])" lvl); (* We set the head of the solver and theory queue to what it was. *) - let head = ref (Veci.get self.var_levels lvl) in + let head = ref (Vec.get self.var_levels lvl) in self.elt_head <- !head; self.th_head <- !head; (* Now we need to cleanup the vars that are not valid anymore @@ -646,7 +646,7 @@ let cancel_until (self : t) lvl = assert (n > 0); (* Resize the vectors according to their new size. *) AVec.shrink self.trail !head; - Veci.shrink self.var_levels lvl; + Vec.shrink self.var_levels lvl; let (module P) = self.plugin in P.pop_levels n; Delayed_actions.clear_on_backtrack self.delayed_actions; diff --git a/src/sat/store.ml b/src/sat/store.ml index 40bf35b5..fcbe54a9 100644 --- a/src/sat/store.ml +++ b/src/sat/store.ml @@ -5,8 +5,8 @@ module Lit_tbl = Hashtbl.Make (Lit) type cstore = { c_lits: atom array Vec.t; (* storage for clause content *) - c_activity: Vec_float.t; - c_recycle_idx: Veci.t; (* recycle clause numbers that were GC'd *) + c_activity: float Vec.t; + c_recycle_idx: int Vec.t; (* recycle clause numbers that were GC'd *) c_proof: Step_vec.t; (* clause -> proof_rule for its proof *) c_attached: Bitvec.t; c_marked: Bitvec.t; @@ -19,7 +19,7 @@ type t = { v_of_lit: var Lit_tbl.t; (* lit -> var *) v_level: int Vec.t; (* decision/assignment level, or -1 *) v_heap_idx: int Vec.t; (* index in priority heap *) - v_weight: Vec_float.t; (* heuristic activity *) + v_weight: float Vec.t; (* heuristic activity *) v_reason: var_reason option Vec.t; (* reason for assignment *) v_seen: Bitvec.t; (* generic temporary marker *) v_default_polarity: Bitvec.t; (* default polarity in decisions *) @@ -52,7 +52,7 @@ let create ?(size = `Big) ~stat () : t = v_of_lit = Lit_tbl.create size_map; v_level = Vec.create (); v_heap_idx = Vec.create (); - v_weight = Vec_float.create (); + v_weight = Vec.create (); v_reason = Vec.create (); v_seen = Bitvec.create (); v_default_polarity = Bitvec.create (); @@ -67,8 +67,8 @@ let create ?(size = `Big) ~stat () : t = c_store = { c_lits = Vec.create (); - c_activity = Vec_float.create (); - c_recycle_idx = Veci.create ~cap:0 (); + c_activity = Vec.create (); + c_recycle_idx = Vec.create (); c_proof = Step_vec.create ~cap:0 (); c_dead = Bitvec.create (); c_attached = Bitvec.create (); @@ -88,10 +88,10 @@ module Var = struct let[@inline] set_level self v l = Vec.set self.v_level (v : var :> int) l let[@inline] reason self v = Vec.get self.v_reason (v : var :> int) let[@inline] set_reason self v r = Vec.set self.v_reason (v : var :> int) r - let[@inline] weight self v = Vec_float.get self.v_weight (v : var :> int) + let[@inline] weight self v = Vec.get self.v_weight (v : var :> int) let[@inline] set_weight self v w = - Vec_float.set self.v_weight (v : var :> int) w + Vec.set self.v_weight (v : var :> int) w let[@inline] mark self v = Bitvec.set self.v_seen (v : var :> int) true let[@inline] unmark self v = Bitvec.set self.v_seen (v : var :> int) false @@ -208,16 +208,16 @@ module Clause = struct in (* allocate new ID *) let cid = - if Veci.is_empty c_recycle_idx then + if Vec.is_empty c_recycle_idx then Vec.size c_lits else - Veci.pop c_recycle_idx + Vec.pop_exn c_recycle_idx in (* allocate space *) (let new_len = cid + 1 in Vec.ensure_size c_lits ~elt:[||] new_len; - Vec_float.ensure_size c_activity new_len; + Vec.ensure_size c_activity ~elt:0. new_len; Step_vec.ensure_size c_proof new_len; Bitvec.ensure_size c_attached new_len; Bitvec.ensure_size c_dead new_len; @@ -298,17 +298,17 @@ module Clause = struct Bitvec.set c_removable cid false; Bitvec.set c_marked cid false; Vec.set c_lits cid [||]; - Vec_float.set c_activity cid 0.; + Vec.set c_activity cid 0.; - Veci.push c_recycle_idx cid; + Vec.push c_recycle_idx cid; (* recycle idx *) () let[@inline] activity store c = - Vec_float.get store.c_store.c_activity (c : t :> int) + Vec.get store.c_store.c_activity (c : t :> int) let[@inline] set_activity store c f = - Vec_float.set store.c_store.c_activity (c : t :> int) f + Vec.set store.c_store.c_activity (c : t :> int) f let[@inline] atoms_a store c : atom array = Vec.get store.c_store.c_lits (c : t :> int) @@ -372,7 +372,7 @@ let alloc_var_uncached_ ?default_pol:(pol = true) self (form : Lit.t) : var = Vec.push v_level (-1); Vec.push v_heap_idx (-1); Vec.push v_reason None; - Vec_float.push v_weight 0.; + Vec.push v_weight 0.; Bitvec.ensure_size v_seen v_idx; Bitvec.ensure_size v_default_polarity v_idx; Bitvec.set v_default_polarity v_idx pol; diff --git a/src/util/Vec.ml b/src/util/Vec.ml index 05f38914..2b46a7fc 100644 --- a/src/util/Vec.ml +++ b/src/util/Vec.ml @@ -1,7 +1,9 @@ type 'a t = { mutable data: 'a array; mutable sz: int } let make n x = { data = Array.make n x; sz = 0 } + let[@inline] create () = { data = [||]; sz = 0 } + let[@inline] clear s = s.sz <- 0 let[@inline] shrink t i = diff --git a/src/util/Vec_float.ml b/src/util/Vec_float.ml deleted file mode 100644 index 0546be01..00000000 --- a/src/util/Vec_float.ml +++ /dev/null @@ -1,98 +0,0 @@ -module A = Bigarray.Array1 - -type float_arr = (float, Bigarray.float64_elt, Bigarray.c_layout) A.t -type t = { mutable data: float_arr; mutable sz: int } - -let mk_arr_ sz : float_arr = A.create Bigarray.float64 Bigarray.c_layout sz -let create ?(cap = 16) () : t = { sz = 0; data = mk_arr_ cap } -let[@inline] clear self = self.sz <- 0 -let[@inline] shrink self n = if n < self.sz then self.sz <- n -let[@inline] size self = self.sz -let[@inline] is_empty self = self.sz = 0 - -let copy self = - if size self = 0 then - create ~cap:0 () - else ( - (* copy bigarray *) - let data = mk_arr_ (size self) in - A.blit (A.sub self.data 0 (size self)) data; - { sz = self.sz; data } - ) - -let[@inline] fast_remove t i = - assert (i >= 0 && i < t.sz); - A.unsafe_set t.data i @@ A.unsafe_get t.data (t.sz - 1); - t.sz <- t.sz - 1 - -let filter_in_place f vec = - let i = ref 0 in - while !i < size vec do - if f (A.unsafe_get vec.data !i) then - incr i - else - fast_remove vec !i - done - -(* ensure capacity is [new_cap] *) -let resize_cap_ self new_cap = - assert (A.dim self.data < new_cap); - let new_data = mk_arr_ new_cap in - A.blit self.data (A.sub new_data 0 (A.dim self.data)); - self.data <- new_data - -let ensure_cap self (n : int) = - if n > A.dim self.data then ( - let new_cap = max n ((A.dim self.data * 2) + 10) in - resize_cap_ self new_cap - ) - -let ensure_size self n = - if n > self.sz then ( - ensure_cap self n; - self.sz <- n - ) - -let[@inline] push (self : t) x : unit = - ensure_cap self (self.sz + 1); - self.data.{self.sz} <- x; - self.sz <- 1 + self.sz - -let[@inline] pop self = - if self.sz > 0 then ( - let x = self.data.{self.sz - 1} in - self.sz <- self.sz - 1; - x - ) else - failwith "vec_float.pop: empty" - -let[@inline] get self i : float = - assert (i >= 0 && i < self.sz); - A.unsafe_get self.data i - -let[@inline] set self i x : unit = - assert (i >= 0 && i < self.sz); - A.unsafe_set self.data i x - -let[@inline] iter ~f self = - for i = 0 to self.sz - 1 do - f self.data.{i} - done - -let[@inline] iteri ~f self = - for i = 0 to self.sz - 1 do - f i self.data.{i} - done - -let to_iter v k = iter ~f:k v - -include Vec_sig.Make_extensions (struct - type nonrec elt = float - type nonrec t = t - - let to_iter = to_iter - let get = get - let size = size - let iter = iter - let iteri = iteri -end) diff --git a/src/util/Vec_float.mli b/src/util/Vec_float.mli deleted file mode 100644 index efdba289..00000000 --- a/src/util/Vec_float.mli +++ /dev/null @@ -1,5 +0,0 @@ -(** Vectors of floats - - These vectors are more optimized than {!Vec}. *) - -include Vec_sig.S with type elt := float diff --git a/src/util/Veci.ml b/src/util/Veci.ml deleted file mode 100644 index 48f74dd5..00000000 --- a/src/util/Veci.ml +++ /dev/null @@ -1,111 +0,0 @@ -module A = Bigarray.Array1 - -type int32arr = (int32, Bigarray.int32_elt, Bigarray.c_layout) A.t -type t = { mutable data: int32arr; mutable sz: int } - -let mk_arr_ sz : int32arr = A.create Bigarray.int32 Bigarray.c_layout sz -let create ?(cap = 16) () : t = { sz = 0; data = mk_arr_ cap } -let[@inline] clear self = self.sz <- 0 -let[@inline] shrink self n = if n < self.sz then self.sz <- n -let[@inline] size self = self.sz -let[@inline] is_empty self = self.sz = 0 - -let copy self = - if size self = 0 then - create ~cap:0 () - else ( - (* copy bigarray *) - let data = mk_arr_ (size self) in - A.blit self.data data; - { sz = self.sz; data } - ) - -let[@inline] fast_remove t i = - assert (i >= 0 && i < t.sz); - A.unsafe_set t.data i @@ A.unsafe_get t.data (t.sz - 1); - t.sz <- t.sz - 1 - -let filter_in_place f vec = - let i = ref 0 in - while !i < size vec do - if f (Int32.to_int (A.unsafe_get vec.data !i)) then - incr i - else - fast_remove vec !i - done - -(* ensure capacity is [new_cap] *) -let resize_cap_ self new_cap = - assert (A.dim self.data < new_cap); - let new_data = mk_arr_ new_cap in - A.blit self.data (A.sub new_data 0 (A.dim self.data)); - self.data <- new_data - -let ensure_cap self (n : int) = - if n > A.dim self.data then ( - let new_cap = max n (max 4 (A.dim self.data * 2)) in - resize_cap_ self new_cap - ) - -let ensure_size self n = - if n > self.sz then ( - ensure_cap self n; - self.sz <- n - ) - -let[@inline] push (self : t) i : unit = - ensure_cap self (self.sz + 1); - self.data.{self.sz} <- Int32.of_int i; - self.sz <- 1 + self.sz - -let[@inline] push_i32 self i = - ensure_cap self (self.sz + 1); - self.data.{self.sz} <- i; - self.sz <- 1 + self.sz - -let[@inline] pop self = - if self.sz > 0 then ( - let x = Int32.to_int self.data.{self.sz - 1} in - self.sz <- self.sz - 1; - x - ) else - failwith "vecI32.pop: empty" - -let[@inline] get self i : int = - assert (i >= 0 && i < self.sz); - Int32.to_int (A.unsafe_get self.data i) - -let[@inline] get_i32 self i : int32 = - assert (i >= 0 && i < self.sz); - A.unsafe_get self.data i - -let[@inline] set self i x : unit = - assert (i >= 0 && i < self.sz); - A.unsafe_set self.data i (Int32.of_int x) - -let[@inline] set_i32 self i x : unit = - assert (i >= 0 && i < self.sz); - A.unsafe_set self.data i x - -let[@inline] iter ~f self = - for i = 0 to self.sz - 1 do - f (Int32.to_int self.data.{i}) - done - -let[@inline] iteri ~f self = - for i = 0 to self.sz - 1 do - f i (Int32.to_int self.data.{i}) - done - -let[@inline] to_iter self k = iter ~f:k self - -include Vec_sig.Make_extensions (struct - type nonrec elt = int - type nonrec t = t - - let to_iter = to_iter - let get = get - let size = size - let iter = iter - let iteri = iteri -end) diff --git a/src/util/Veci.mli b/src/util/Veci.mli deleted file mode 100644 index 0e1c3ef3..00000000 --- a/src/util/Veci.mli +++ /dev/null @@ -1,9 +0,0 @@ -(** Vectors of int32 integers - - These vectors are more optimized than {!Vec}. *) - -include Vec_sig.S with type elt := int - -val push_i32 : t -> int32 -> unit -val get_i32 : t -> int -> int32 -val set_i32 : t -> int -> int32 -> unit