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

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.
*)

(* pred_db.ml *)

open Global

let table_size = Global.pars.pred_table_size

exception Pred_not_found of int
exception Backtrack_error

class pred_db =
(*  let (*state*) = State.initial_state in*)
  let pred_table =
    (Hashtbl.create table_size : (Global.pred_id, Pred.pred) Hashtbl.t) in
  let in_pred_table = Hashtbl.mem pred_table in
  let add_to_pred_table = Hashtbl.add pred_table in
  let find_pred = Hashtbl.find pred_table in
  let get_all_preds = Hashtbl.fold (fun n p l -> p::l) pred_table in

  let lit_table =
    (Hashtbl.create table_size : (Global.pred_id, Pred.lit) Hashtbl.t) in
  let add_to_lit_table = Hashtbl.add lit_table in
  let find_lit = Hashtbl.find lit_table in
  let get_all_lits = Hashtbl.fold (fun n l ls -> l::ls) lit_table in
  let remove_pred pid = 
    Hashtbl.remove pred_table pid;
    Hashtbl.remove lit_table pid; 
    Hashtbl.remove lit_table (-pid) 
  in

(*   let idtable = Hashtbl.create table_size in (\* (name,id#)hash *\) *)
(*   let imem = Hashtbl.mem idtable in *)

object (self)


  (* note!  the following sublists will be in reverse order! *)
  val mutable recent_pred_list = ([]:Global.pred_id list list) (* total list *)
  val mutable most_recent_pred_list = ([]:Pred.pred list) (* one step only *)
  val mutable recent_term_list = ([]:int list list)

  val mutable quant_pred_list = ([]:Pred.pred list)

  method private add_recent_pred (x:Pred.pred) =
    most_recent_pred_list <- x::most_recent_pred_list;
    let x' = Pred.id x in
    match recent_pred_list with
        p::t -> recent_pred_list <- (x'::p)::t
      | [] -> recent_pred_list <- [[x']]

  method mark_point =
    recent_pred_list <- []::recent_pred_list;
  
  (* f is a fun that unregisters the pred with the theory (if necessary)*) 
  method remove_pred (f:Pred.pred -> unit) id =
    try
      f (find_pred id);
      remove_pred id
    with Not_found -> raise (Pred_not_found id)

  method all_preds = get_all_preds []

  method all_lits = get_all_lits []

  (* (add_int_pred id formula) adds a predicate with identifier id
     and string value formula to the predicate table.
     Does nothing if a predicate with identifier id is already in the table.
  *)
  method add_pred id formula =
if adebug then (print_string  ("Pred_db.add_pred "^(id_string id));print_string "\n";flush stdout);
    if not (in_pred_table id) then
      let pred = Pred.new_pred id formula (*state*) false true false in
      begin
        add_to_pred_table id pred;
  self#add_recent_pred pred
      end


  (* This method assumes that the predicate will NEVER become interpreted by
     the theory.
     If this is not the case, use add_pred and Pred.set_uninterpreted.
   *)
  method add_uninterpreted_pred id formula =
if adebug then (print_string  ("Pred_db.add_uninterpreted_pred "^(id_string id));print_string "\n";flush stdout);
    if not (in_pred_table id) then
      let pred = Pred.new_pred id formula (*state*) false false false in
      begin
        add_to_pred_table id pred;
  self#add_recent_pred pred
      end

  (* adds a new abstract pred to db *)
  (* returns the pred's id *)
  method add_abstract_pred id =
if adebug then (print_string  ("Pred_db.add_abstract_pred "^(id_string id));print_string "\n";flush stdout);
    if not (in_pred_table id) then
      let pred = Pred.new_pred id ("_"^(id_string id)) (*state*) true true false in
      begin
        add_to_pred_table id pred;
  self#add_recent_pred pred
      end

  (* This method assumes that the predicate will NEVER become interpreted by
     the theory.
     If this is not the case, use add_abstract_pred and pred#set_uninterpreted.
   *)
  method add_uninterpreted_abstract_pred id =
if adebug then (print_string  ("Pred_db.add_uninterpreted_abstract_pred "^(id_string id));print_string "\n";flush stdout);
    if not (in_pred_table id) then
      let pred = Pred.new_pred id ("_"^(id_string id)) (*state*) true false false in
      begin
        add_to_pred_table id pred;
  self#add_recent_pred pred
      end

  method add_quantified_abstraction_pred id =
if adebug then (print_string  ("Pred_db.add_quantified_abstraction_pred "^(id_string id));print_string "\n";flush stdout);
    if not (in_pred_table id) then
      let pred = Pred.new_pred id ("?"^(id_string id)) (*state*) true false true in
      begin
        add_to_pred_table id pred;
        quant_pred_list <- pred::quant_pred_list;
  self#add_recent_pred pred
      end

  method get_pred id =
    try
      find_pred id
    with Not_found -> raise (Pred_not_found id)

  (* returns the literal associated with id (neg id=neg literal) *)
  (* updates the littable with new objects as appropriate *)
  method get_lit id =
    try find_lit id
    with Not_found ->
      (* add the new literal to the table *)
      try
      let p = find_pred (unsigned id) in
        if is_positive id then
          let lit = Pred.new_pos_lit p in
            add_to_lit_table id lit;
            lit
        else
          let lit = Pred.new_neg_lit p in
            add_to_lit_table id lit;
            lit
      with Not_found ->
        Printf.printf "pred_db:get_lit %s error\n" (id_string id); print_string "\n";flush stdout;
        raise (Pred_not_found id)

  method print_stats =
    Printf.printf "Number of predicates: %d \n" (List.length (get_all_preds []))

  method quantified_partial_model =
    List.fold_left (fun acc x -> 
      if Pred.is_quantified_abstraction x then
        match Pred.pred_status x with
            Undet -> acc
          | _ -> (Pred.id x)::acc 
      else
        acc
    ) ([]:Global.pred_id list) (get_all_preds [])

  method quantified_lemma =
    List.fold_left (fun acc x -> 
      if Pred.is_quantified_abstraction x then
        match Pred.pred_status x with
            Undet -> acc
          | Unsat -> if Global.pars.only_positive_quantified_preds then
                       acc
                     else (
                       (Pred.id x)::acc)
          | Valid -> 
                     (compl (Pred.id x))::acc 
      else
        acc
    ) ([]:Global.pred_id list) (get_all_preds [])
    


  method recent_preds =
    let return = most_recent_pred_list in
    most_recent_pred_list <- [];
    return

  (* This assumes that the terms will be removed in the reverse order they were
      added.  Will break if this is not the case.  
      f is a function that removes the predicate from the theory, if necessary
  *)
  method backtrack (f:Pred.pred -> unit) n =
    let rp () =
      match recent_pred_list with
          [] -> raise Backtrack_error
        | []::t -> recent_pred_list <- t
        | h::t -> List.iter 
(*                    (self#remove_pred f) *)
                    (remove_pred)
                    h;
                  recent_pred_list <- t
    in
    let rec bt n' = 
      if n' > 0 then
        begin
          rp();
          bt (n' - 1)
        end
    in
    bt n

  method clear =
    Hashtbl.clear pred_table;
    Hashtbl.clear lit_table


(* ***** debugging support code ***** *)

  method print_all () =
    Printf.printf "---\n";
    List.iter (fun x ->
                   (match Pred.pred_status x with
                        Valid ->
                          Printf.printf "%s\t%s\t%s\t%d\n"
                          (id_string (Pred.id x))
                          (Pred.formula x)
                          "TRUE"
                          (Pred.level x)
                      | Unsat ->
                           Printf.printf "%s\t%s\t%s\t%d\n"
                           (id_string (Pred.id x))
                           (Pred.formula x)
                           "FALSE"
                           (Pred.level x)
                      | _ -> Printf.printf "%s\t%s\t???\n" (id_string (Pred.id
                      x)) (Pred.formula x)
                   );
print_string "     POS:";
(*Hashtbl.iter (fun y _ -> Printf.printf " #%d" y) (Pred.p_set x);*)
print_string "\n";
print_string "     NEG:";
(*Hashtbl.iter (fun y _ -> Printf.printf " #%d" y) (Pred.n_set x);*)
print_string "\n";
              )(get_all_preds []);
   print_string "---\n"


  method check_all (b_status: Global.pred_id -> Global.status) (t_status: Pred.pred -> Global.status) =
    List.iter (fun x ->
      let stored =  b_status (Pred.id x) in
      let th_val = t_status x in
      if stored != th_val && Pred.is_interpreted x then
        (
          Printf.printf "PREDICATE %s %s value (%s) != theory value (%s)! @ %d/%d\n" (
          id_string (Pred.id x)) (Pred.formula x) (val_string stored) (
          val_string th_val) (State.current_level()) (State.empty_level());
          flush stdout;
          if stored != Undet then
          (
            print_string "Reason: ";
            self#print_all ();
            failwith "pred value mismatch"
          )
        );
(*      if stored = Undet then
        Printf.printf "UNDET pred: %s %s\n" (id_string (Pred.id x)) (Pred.formula x);
*)    ) (get_all_preds []);
end

