(*
This file is part of the dpll(t) engine sammy
Copyright (C) 2004  The University of Iowa
Cesare Tinelli
George Hagen

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
*)

(* cstore.ml *)

(* constraint store.  Part of interface between theory and main engine. *)

(* this version assumes that we will only ever assert UNDET preds *)

(*let table_size = 100*)

open Global

type s_elem = 
    { level: int; (* decision level *)
(*      mutable quant_preds: Pred.pred list;*)
      mutable t_pred_no: int        (* total number of asserted predicates
               _in the theory_ at this level *)
    } 

type cstack = s_elem list

exception Assert_error
exception Retract_error
exception Assert_pred_error
exception T_status_error

(*let impl_table = Implicants.create_table ()*)

(*
let set_my_implicants = Implicants.set_implicants impl_table
let all_prime_implicants = Implicants.all_prime_implicants impl_table
let increase_activity = Pred.increase_activity
let get_max_level = Implicants.get_max_level impl_table
let get_id_level id = Implicants.get_max_level impl_table [id]
*)

class cstore (pred_db:Pred_db.pred_db) =
  let theory = new Theory.theory in
(*
  let set_impls id status = (* when it depends on a theory, not assert *)
  (* sets the theory implicants on a pred (if any) *)
    let id' = if status = Unsat then compl id
              else id
    in
    let implist = theory#implicants id' in
    let level = get_max_level implist in
    set_my_implicants id (Some implist) level true (State.current_state());
    level
  in
  (* once we have a decision pred *)
  (* used in set_list_implicants below, for returned lists *)
  let set_list_implicants clist = 
    (* eliminate any that are already set! *)
    List.fold_left (fun c ((a,s,_) as b) ->
                   if Pred.pred_status (pred_db#get_pred a) = Undet then
                     begin
                       set_impls a s;
                       b::c
                     end
                   else
                     begin
                       c
                     end
                   ) [] clist
  in
*)
object
  val mutable stack:cstack = [{ level = State.empty_level();
(*        quant_preds = [];*)
        t_pred_no = 0
            }]

  val mutable removed_ids = []

(*
  val mutable current_split_id = None
  val mutable max_changed_list_size = 0
*)

  method print_stats = ()

  method theory = theory

  (* currently only used in setting initial activity values for predicates *)
  (* normally activity is incremented when traversing the implicant graph
     on a conflict *)
  method increment_activity lit = Satbox.increase_activity lit 1


  (* returns a (pred*Global.status) list of newly determined preds *)
  (* can raise Theory.Incons *)
  method assert_lit lit =
    let pred = Pred.pred lit in
    let id = Pred.lit_id lit in
if debug then (print_string  ("cstore#assert_lit "^(id_string id)^" at level "^(string_of_int(State.current_level())));print_string "\n";flush stdout);
    let status = 
      if is_negative id then
        Unsat
      else
        Valid
    in
    let my_return = 
      if Pred.is_interpreted pred then 
        begin
if debug then (print_string  "theory pred";print_string "\n";flush stdout);
            match status with
                Valid | Unsat -> (*let clist = *)
if debug then (print_string (val_string (theory#status (unsigned id)));print_string "\n";flush stdout);
                    if theory#entails (compl id) then
(
if debug then (print_string  ("theory INCONS");print_string "\n";flush stdout);
                      raise Theory.Incons
)
                    else if theory#entails id then (* no change *)
                      begin
if debug then (print_string  ("cstore#assert_lit already determined!");print_string "\n";flush stdout);
                        []
                      end
                    else
                      begin
                        match stack with
                          [] -> raise Assert_error (* not supposed to happen *)
                        | stack_top::_ ->
                          if stack_top.level < State.current_level() then
(
                            stack <- { level = State.current_level();
                              t_pred_no = 1
                            }::stack
(*;print_string "t_pred_no = 1\n"*)
)
                          else if stack_top.level > State.current_level() then
                            failwith "cstore stack mismatch error 1"
                          else
(*( *)

                            stack_top.t_pred_no <- stack_top.t_pred_no + 1;
(*print_string "t_pred_no = %d\n" stack_top.t_pred_no
);*)
                        if status == Valid then
                          theory#assert_pos (unsigned id)
                        else 
                          theory#assert_neg (unsigned id)
                      end
              | _ -> failwith "Assert pred/theory error"
        end
      else
        begin
if debug then (print_string  "boolean pred";print_string "\n";flush stdout);
           match stack with
             [] -> raise Assert_error (* not supposed to happen *)
           | stack_top::_ ->
             if stack_top.level < State.current_level() then

               stack <- { level = State.current_level();
                 t_pred_no = 0
               }::stack
             else if stack_top.level > State.current_level() then
               failwith "cstore stack mismatch error 2";
             []
        end
    in
    List.map (fun (pid,st) -> 
      if st == Unsat then 
        compl pid 
      else 
        pid
    ) my_return


(*
let decide_lit lit =
  stack <- { level = State.current_level();
             t_pred_no = 0
           }::stack;
  self#assert_lit lit
*)


(*
  (* sets the theory implicants on a pred (if any) *)
  method set_theory_implicants pred status = 
    if (Pred.is_interpreted pred) then
      begin
        let id = Pred.id pred in
        set_impls id status;
        ()
      end

  (* assumes this is a theory-interpreted pred *)
  method augment_theory_implicants pred status c =  
    let id = Pred.id pred in 
    let id' = if status = Unsat then compl id
              else id
    in
    let base_impls = theory#implicants id' in
    let lits = Pred.clause_lit_list c in
    let implist = List.fold_left (fun acc l -> 
                        let p = Pred.pred l in
                        if p = pred then acc
                        else (Pred.id p)::acc
                     ) base_impls lits
    in
    let level = get_max_level implist in
    set_my_implicants id (Some implist) level true (State.current_state())
*)


  (* gets predicate status and sets implicant information as necessary *)
  method t_status pred =
if debug then (print_string ("cstore#t_status "^(id_string (Pred.id pred)));print_string "\n";flush stdout);
let tmp =
    if Pred.is_interpreted pred then
      let id = Pred.id pred in
        theory#status id
    else
      Pred.pred_status pred
in
if debug then (print_string ("cstore#t_status "^(id_string (Pred.id pred))^" is "^(val_string tmp));print_string "\n";flush stdout);
tmp


  (* For the cvcl theory this should be empty! *)
  method implicants (id:Global.pred_id) = 
(*    theory#implicants id*)
(    ([]:Global.pred_id list))


  (* only call if we KNOW this will never be seen again! *)
  method unregister_pred pred =
    if Pred.is_interpreted pred then
      theory#remove_expression (Pred.id pred)

(*
  method get_state id =
    let level = get_id_level id in
    State.previous_state level
*)

  method next_id =
     theory#next_id

(*
  (* returns a conflict set for the empty clause c as a list of unsigned
     predicate identifiers.
  *)
  method conflict_set (c:Pred.clause) = 
    if (Global.pars.activity_behavior land 4) != 0 then
      List.iter (fun x -> Pred.increase_activity x 1) (Pred.clause_lit_list c);

    let ids = Pred.clause_pred_ids c in
    match Global.pars.conflict_analysis with
      | 3 -> (* FULL REGRESSION -DEFAULT- *)
             (* this uses the actual level of the implicants *)
               begin
                 all_prime_implicants ids
               end
      | _ -> failwith "Only full regression implicants supported"
*)

  (* can work from current_state *)
  method backtrack target_state =
    let old_level = State.level target_state in
if debug then (print_string  ("cstore#backtrack "^(string_of_int old_level));print_string "\n";flush stdout);
    let rec undo s = 
      match s with 
    [_] -> s
  | {level = this_level; t_pred_no = n}::r ->
      if this_level <= old_level then
        s
      else begin
        theory#retract_last n;
if debug then (print_string  ("cstore#backtrack_last "^(id_string n)^" from level "^(id_string this_level));print_string "\n";flush stdout);
        undo r
      end
  | _ -> raise Retract_error  (* not supposed to happen *)
    in
      stack <- undo stack

end
