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

(* pred.ml *)
open Global

(* NOTE: STILL NEED TO CLEAR PRED SCORES ON BACKTRACK *)


let table_size = 16
let c_counter = new Counter.set_counter 0
(*let last_original = ref 0*)
type clause_id = int
type pred = { pid: Global.pred_id;
              formula: string;
              mutable quantified_abstraction: bool;
(*              mutable status: Global.status;*)
(*              mutable state: State.state;*)
              abstract: bool;    (* original = false *)
              mutable universal: bool;
              mutable interpreted: int option; (* None = false *)
(*
              mutable p_activity: int;
              mutable n_activity: int;
*)
(*              mutable num_watched: int;*)
              mutable formula_depth: int;
              mutable guard: bool;
              mutable preferred_polarity: Global.status;
              mutable predicate_label : Escjava_label.label;
              mutable subterm_label_list: (string * Escjava_label.label) list;
(*              p_set: (clause_id, clause) Hashtbl.t;
              n_set: (clause_id, clause) Hashtbl.t
*)

            }
type lit = { pred: pred;
            is_positive: bool
          }

(*************************************************************************)
(* predicate functions *)
(*************************************************************************)
let new_pred id form (*state*) abstr interp quantabs =
if debug then (print_string ("Pred.new_pred "^(id_string id^":"^form));print_string "\n";flush stdout);
                       { pid = id;
                         formula = form;
                         quantified_abstraction = quantabs;
(*                         state = state;*)
(*                         status = Undet;*)
                         abstract = abstr;
                         universal = false;
                         interpreted = if interp then Some 0
                                       else None;
(*
                         p_activity = 0;
                         n_activity = 0;
*)
(*                         num_watched = 0;*)
                         formula_depth = -max_int; (*trick so we can go up or down -- x>y means x is deeper than y *)
                         guard = false;
                         preferred_polarity = Undet;
                         predicate_label = Escjava_label.empty_label;
                         subterm_label_list = [];
(*                         p_set = Hashtbl.create table_size;
                         n_set = Hashtbl.create table_size
*)
                       }

let pred_status pred =
  Satbox.lit_value (pred.pid)
(*  if pred.status = Undet then
    Undet
  else if State.is_valid pred.state then
    pred.status
  else
    Undet
*)

(*
let pred_set_status pred state status =
  pred.state <- state;
  pred.status <- status
*)

(* inserts clause into this pred's list *)
(*
let p_insert (c:clause) (pred:pred) =
  pred.num_watched <- pred.num_watched + 1;
  Hashtbl.replace pred.p_set c.cid c
*)

(*
let n_insert (c:clause) (pred:pred) =
  pred.num_watched <- pred.num_watched + 1;
  Hashtbl.replace pred.n_set c.cid c
*)
(*
(* removes clause from this pred's list *)
let p_remove (c:clause) (pred:pred) =
  pred.num_watched <- pred.num_watched - 1;
  Hashtbl.remove pred.p_set c.cid
*)
(*
let n_remove (c:clause) (pred:pred) =
  pred.num_watched <- pred.num_watched - 1;
  Hashtbl.remove pred.n_set c.cid
*)
(* identifies abstract/original & interpreted/boolean properties *)
let is_abstract p =
  p.abstract

let is_universal p =
  p.universal

let is_interpreted p =
  match p.interpreted with
    Some _ -> true
  | None -> false

let is_quantified_abstraction p =
  p.quantified_abstraction

let set_quantified_abstraction p q =
  p.quantified_abstraction <- q

(* other accessor functions *)
let formula p =
  p.formula

let id p =
  p.pid

let level p =
  Satbox.lit_level (p.pid)
(*  State.level p.state*)

let set_universal p u =
  p.universal <- u

let set_interpreted p i =
  if i then 
    p.interpreted <- Some 0
  else
    p.interpreted <- None

(*
let p_set p =
  p.p_set
*)
(*
let n_set p =
  p.n_set
*)

let pred_string p =
  p.formula

let is_watched p =
  Satbox.lit_is_watched p.pid

let set_formula_depth p d =
  if Global.pars.favor_depth then
    begin
      if Global.pars.favor_min_depth && abs(p.formula_depth) > d then 
        (* only update if we've found a higher level version of this *)
        (* note tha abs(-max_int) is deeper than anything else *)
        p.formula_depth <- d
      else if p.formula_depth < d then 
        (* only update if we have found a deeper level version *)
        p.formula_depth <- d
    end

let get_formula_depth p =
  p.formula_depth

let is_guard p =
  p.guard

let set_guard p =
  if Global.pars.favor_ite_guards then
    p.guard <- true

let add_pred_label p label = p.predicate_label <- label

let add_subterm_label p label = p.subterm_label_list <- label::p.subterm_label_list

let get_preferred_polarity p =
  p.preferred_polarity

let set_preferred_polarity p s =
  if Global.pars.use_favored_polarity then
    p.preferred_polarity <- s

(* returns a score,status pair for pqueue sorting purposes *)
(* score is the highest associated score (taking special orderings into
 account) *)
(* for now, we will treat quant abstract literals as having a score 100000 
   higher *)
(* note: migt want to include factor of  +/- activity in this... *)
(* also -- _must_ reorder on a restart!  *)
let get_score_and_status p =
  let pid = p.pid in
  let n_activity = Satbox.get_literal_weight (compl pid) in
  let p_activity = Satbox.get_literal_weight (pid) in
  let total_score = n_activity + p_activity in
  let (score,status) =
    if (Global.pars.activity_behavior land 32) != 0 then
      begin
        (* favor negative quant_abstract literals *)
        if p.quantified_abstraction then (* always try Unsat, but favor those
                              that will make a clause valid *)
          (total_score(*+200000*),Unsat)
        else if ((not Global.pars.split_on_abstract) && p.abstract) then
          (0,Valid)
        else if n_activity > p_activity then
          (total_score(*p.n_activity*),Unsat)
        else if n_activity < p_activity then
          (total_score(*p.p_activity*),Valid)
        (* true/false activities tied *)
        else if (get_preferred_polarity p) == Valid then
          (total_score(*p.n_activity*),Valid)
        else  
          (total_score(*p.n_activity*),Unsat)
      end
    else
      begin
        (* favor negative abstract literals *)
        if p.quantified_abstraction then (* always try Unsat, but favor those
                              that will make a clause valid *)
          (total_score(*+200000*),Unsat)
        else if ((not Global.pars.split_on_abstract) && p.abstract) then
          (0,Valid)
        else if n_activity > p_activity then
          (n_activity,Unsat)
        else if n_activity < p_activity then
          (p_activity,Valid)
        (* true/false activities tied *)
        else if (get_preferred_polarity p) == Valid then
          (total_score(*p.n_activity*),Valid)
        else
          (n_activity,Unsat)
      end
  in
  let offset =
(*    if is_watched p then
      100000
    else
*)
      0
  in
  (score+offset,status)

(*
let status_string pred =
  match pred.status with
      Valid -> "V"
    | Unsat -> "u"
    | _ -> "?"
*)

(*
let print_set_strings p =
  Hashtbl.iter (fun x _ -> Printf.printf "%d " x) p.p_set; Printf.printf "\n";
  Hashtbl.iter (fun x _ -> Printf.printf "%d " x) p.n_set; Printf.printf "\n"
*)

(*************************************************************************)
(* literal functions *)
(*************************************************************************)

let new_pos_lit pred = { pred = pred;
                         is_positive = true
                       }

let new_neg_lit pred =
                       { pred = pred;
                         is_positive = false
                       }

let is_positive lit =
  lit.is_positive

let pred lit =
  lit.pred

let lit_id lit = 
  let id = lit.pred.pid in
  if lit.is_positive then
    id
  else
    compl id

let lit_status lit =
  let status = pred_status lit.pred in
  if lit.is_positive then
    status
  else
    Global.status_complement status

let lit_string l =
  let p = pred l in
  "("^(if is_positive l then "" else "-")^
  (p.formula)^","^
  (match lit_status l (*Satbox.lit_value (lit_id l)*) with
     Unsat -> "u"
   | Valid -> "V"
   | Undet -> "?"
  )^","^
  (string_of_int (level p))^")"

(*
let get_activity l =
  if l.is_positive then
    (pred l).p_activity
  else
    (pred l).n_activity

let set_activity l a =
  if l.is_positive then
    (pred l).p_activity <- a
  else
    (pred l).n_activity <- a

let increase_activity l n =
  if l.is_positive then
    (pred l).p_activity <- (pred l).p_activity + n
  else
    (pred l).n_activity <- (pred l).n_activity + n
*)


(*************************************************************************)
(* clause functions *)
(*************************************************************************)
(*
exception Empty_clause
exception Valid_clause

let cset = Hashtbl.create 1


(* string representation of clauses *)
let clause_string c = 
  try
  List.fold_right (fun x y ->
    (match lit_status x with 
      _(*Undet*) -> ((id_string (lit_id x))^(lit_string x)^" ")
     | Unsat -> ""
     | Valid -> "T ")^y
(*    (lit_string x)^
      (if (C_array.get c.lits 0 = x || C_array.get c.lits 1 = x) then "*" else "")^" "^y*)
  ) c.lit_list ("\t #"^(string_of_int c.cid))
  with Valid_clause -> "VALID"

let dimacs_string c = List.fold_right (fun x y ->
    let p = pred x in 
    (id_string (if is_positive x then id p else -(id p)))^" "^y
  ) c.lit_list "0"


let set_new_watched_lits c i =
  C_array.set_start c.lits i
(*;
  let lit_0 = C_array.get c.lits 0 in
    (* insert c in the clause set of the literals' predicates *)
    if lit_0.is_positive then
      p_insert c lit_0.pred
    else
      n_insert c lit_0.pred;
  let lit_1 = C_array.get c.lits 1 in
    if lit_1.is_positive then
      p_insert c lit_1.pred
    else
      n_insert c lit_1.pred
*)


let new_clause lit_list =
  let lits = C_array.of_list lit_list in
  let c = { cid = c_counter#next;
            lits =  lits;
            lit_list = lit_list;
            len = C_array.length lits
          }
  in
    set_new_watched_lits c 0;
    c

let temp_clause lit_list =
  let lits = C_array.of_list lit_list in
  let c = { cid = c_counter#next;
            lits =  lits;
            lit_list = lit_list;
            len = C_array.length lits
          }
  in
    c


let dummy_clause () =
  let c = { cid = c_counter#next;
            lits = C_array.of_list [];
            lit_list = [];
            len = 0
          }
  in
    c

let remove_clause c =
  if c.len > 0 then (* dummy clauses have no outside links *)
    begin
Hashtbl.remove cset c.cid(*;
      let lit_0 = C_array.get c.lits 0 in
      if lit_0.is_positive then
        p_remove c lit_0.pred
      else
        n_remove c lit_0.pred;
      let lit_1 = C_array.get c.lits 1 in
      if lit_1.is_positive then
        p_remove c lit_1.pred
      else
        n_remove c lit_1.pred
*)
    end

exception Empty_clause
exception Valid_clause

type response = ClauseEmpty (*of int*)
              | ClauseValid of int
              | ClauseUndet of int

(*
let simplify_clause c =
  let lits = c.lits in
  (* [check_lit i] checks for i <= k < clause_len, the status of literal
     k in the array, returning (Some k) if k is the position of the first
     undet literal found, and None if all literals are unsat.
     Raises the exception Valid_clause as soon as it finds a Valid lit.
  *)
  (* also keeps track of unsat lit with highest level *)
  let rec check_lit i =
    if i = c.len then
      begin (* note to most recently set lit as 0 *)
        ClauseEmpty
      end
    else
      let lit = C_array.get lits i in
      match lit_status lit with
          Valid -> ClauseValid i
        | Undet -> ClauseUndet i
        | Unsat -> (* remove c from the clause set of the lits' preds *)
(*            if lit.is_positive then
              p_remove c lit.pred
            else
              n_remove c lit.pred;
*)
              check_lit (i+1)
  in
  match check_lit 0 with
      ClauseEmpty  ->
        (* simplified to empty clause *)
        (* make 1st 2 lits watched for backtracking *)
        set_new_watched_lits c 0;
        raise Empty_clause
    | ClauseValid i ->
        set_new_watched_lits c i;
        None; raise Valid_clause
    | ClauseUndet i ->
        let lit_i = C_array.get lits i in
        (* one undet lit found *)
        match check_lit (i+1) with (* don't care about max level here *)
            ClauseEmpty ->
              set_new_watched_lits c i;
              Some lit_i
          | ClauseValid j ->
              set_new_watched_lits c j;
              None; raise Valid_clause
          | ClauseUndet j ->
              let k = j-1 in
              let lit_k = C_array.get lits k in
              C_array.set lits i lit_k;
              C_array.set lits k lit_i;
              set_new_watched_lits c k;
              None
*)

let clause_pred_ids c =
  List.map (fun l -> id (pred l)) c.lit_list

let check_valid_lits c =
  let lits = c.lits in
  let rec check_lit i found =
    if i = c.len then
      found
    else
      let lit = C_array.get lits i in
      match lit_status lit with
          Valid -> if not (is_abstract (pred lit)) then
                     None
                   else
                     check_lit (i+1) (Some lit)
        | _ -> check_lit (i+1) found
  in
    check_lit 0 None

let max_clause_num () = c_counter#value

let clause_id c = c.cid

let clause_lit_list c = c.lit_list (* re-do this *)

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

let print_curry_clause c =
    Printf.printf "%s" (
      List.fold_right (fun x y ->
                         (if is_interpreted (pred x) then
                           (if is_positive x then "" else "!")^(pred x).formula
                         else
                           ((pred x).formula)^(if is_positive x then "=TRUE"
                           else "=FALSE")
                         )^" OR "^y)
       c.lit_list " AND\n")

let cset_add c = Hashtbl.add cset c.cid c;if debug then (print_string (clause_string c);print_string "\n";flush stdout);c

let check_cset t_status =
Printf.printf "Checking cset at level %d\n" (State.current_level());
  let simplify c =
    let lits = c.lits in
    let rec check_lit i =
      if i = c.len then
        ClauseEmpty (*0*)
      else
        let lit = C_array.get lits i in
        match lit_status lit with
            Valid -> ClauseValid i
          | Undet ->
            begin
              let lit_status' = if is_positive lit then
                                  t_status (pred lit)
                                else
                                  Global.status_complement (t_status (pred lit))
              in
              match lit_status' with
                  Valid -> Printf.printf "Missed theory-valid lit %s in %s\n" (
                  lit_string lit) (clause_string c);
                           ClauseValid i
                | Undet -> ClauseUndet i
                | Unsat -> Printf.printf "May have missed theory-unsat lit %s in
                %s\n" (lit_string lit) (clause_string c);
                    check_lit (i+1)
            end
          | Unsat ->
              check_lit (i+1)
    in
    check_lit 0
  in
  Hashtbl.iter (fun _ c ->
(*Printf.printf "checking %s\n" (clause_string c);print_string "\n";flush stdout;*)
                 if (lit_status (C_array.get c.lits 0) = Unsat &&
                 lit_status(C_array.get c.lits 1) = Unsat) then
                   Printf.printf "POSSIBLY LOST: %s\n" (clause_string c);
                 match simplify c with
                     ClauseEmpty (*_*) ->
                       Printf.printf "Failed to catch empty clause %s at level
                       %d\n" (clause_string c) (State.current_level ());
                       failwith "Missed conflict"
                   | ClauseValid _ -> ()
                   | _ -> Printf.printf "possibly MISSED clause %s at level
                   %d\n" (clause_string c) (State.current_level());
  ) cset

let print_cset () =
  Hashtbl.iter (fun _ c ->
    try (*simplify_clause c;*)
        Printf.printf "cset: %s\n" (clause_string c)
    with _ -> ()
(*    Printf.printf "%s" (
      List.fold_right (fun x y -> ((if is_positive x then "" else "-")^(pred x).
      formula)^" "^y) c.lit_list " 0\n")*)
  ) cset;
  Printf.printf "CSET done\n"

let ll_string (ll:lit list) =
  let rec lls ll' s =
    match ll' with
        [] -> s
      | h::t -> lls t (s^(lit_string h)^" ")
  in
  lls ll ""

*)
