(*
This file is part of the dpll(t) engine sammy
Copyright (C) 2004  The University of Iowa
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.
*)
                                                                                


open Global
(*open Sys_state*)
let pred_db=Sys_state.pred_db
let cstore=Sys_state.cstore

type command_type =
  ASSERT_CMD | QUERY_CMD | SIGNATURE_CMD | AXIOM_CMD | OTHER_CMD | NON_CMD

(* generate a new priority queue based on the current pred list *)
let create_pqueue () =
  let predlist = List.fold_left (fun acc x ->
                       if Pred.pred_status x == Global.Undet then
                         x::acc
                       else
                         acc
                 ) [] (pred_db#all_preds)
  in
  Pqueue.create_queue (Array.of_list predlist) State.initial_state



(* performs initial BCP as well as creating the new clauses *)
(* returns a list of the new clauses to be added *)
(* NOTE: this does NOT guarantee that the final cset will not contain 
   some clauses that have already simplified to unit, sat, or unsat! *)
let augment_clause_set f skolemizer = 
  let stime = Sys.time() in
  let litlist = Convert.convert_formula_to_lit_lists f pred_db skolemizer in
(*  (List.iter (fun x -> List.iter (fun y -> (if Pred.is_positive y then Printf.printf "+" else Printf.printf "-")) x; Printf.printf "\n") litlist);*)
  let n = List.length litlist in
(*  if Global.pars.Global.verbose then
    Printf.printf "CNF conversion: %f seconds\n" (Sys.time() -. stime);*)
  List.iter (fun x -> 
(*        (*Pred.cset_add*) (Pred.new_clause x);*)
        Satbox.insert_clause (List.map (fun y -> Pred.lit_id y) x)
        (*Dpllt.update_clauses (List.map (fun y -> Pred.lit_id y) x)*)
    ) litlist;
  cstore#theory#check_consistency;
(*  if Global.pars.Global.verbose then
    Printf.printf "Added clauses: %f seconds\n" (Sys.time() -. stime);*)
  n


(* backtracks the system to a previous base_state *)
let sys_backtrack n1 = 
  Sys_state.backtrack_base_state n1;
  cstore#backtrack (State.current_state ());
  ()

(* calls dpllt on the current clause set *)
(* returns TRUE if f is SATISFIABLE *)
let call_dpllt_satisfiable pq skolemizer iset =
  try
    Dpllt.satisfiable pq cstore pred_db skolemizer iset
  with Theory.Incons -> 
      if Global.pars.Global.verbose then
        Printf.printf "\nInconsistent Context in Dpllt\n";
      false
  | Satbox.SBI_Incons -> 
      if Global.pars.Global.verbose then
        Printf.printf "\nConflict in BCP\n";
      false


(* the signature may consist of new formula (exprtype) *)
(* most of this work is done when modifying the pred_db earlier *)
(* note: if an exception is raised, no new clauses will be generated
   and the base state will NOT advance! *)
let sys_add_assertion (f:Formula.exprtype option) skolemizer = 
  Sys_state.add_base_state [] 0;
  let newp = pred_db#recent_preds in
  let newc = match f with
      Some f' -> 
                 augment_clause_set f' skolemizer
    | None -> 0
  in
  Sys_state.augment_base_state newp newc

  
let call_dpllt pl cl skolemizer = 
  Sys_state.augment_base_state pl cl;
  let my_base_state = State.current_state() in
  let continue = ref true in
  let restart_depth = ref 0 in
  let end_result = ref false in
  let iset = new Iset.iset in
  Dpllt.initial_bcp();
  cstore#theory#mark_base_level;
    while !continue do
      begin
        Sys_state.pred_db#mark_point;
        Sys_state.add_base_state [] 0;
        let pq = create_pqueue () in
        try 
          let result = not (call_dpllt_satisfiable pq skolemizer iset) in
if debug then (Printf.printf ("Api_native.call_dpllt with result");print_string "\n";flush stdout);
          sys_backtrack 1;
          cstore#theory#return_to_base_level;
if debug then (Printf.printf ("Api_native.call_dpllt after backtrack");print_string "\n";flush stdout);
          continue := false;
          end_result := result
        with Dpllt.Timeout
        | Dpllt.DontKnow ->
if adebug then (Printf.printf  "DONTKNOW";print_string "\n";flush stdout);
          if Global.pars.verbose then
            Printf.printf "Don't Know -- restarting search\n";
          sys_backtrack 1;
          cstore#theory#return_to_base_level;
          restart_depth := !restart_depth + 1;
          skolemizer#reset;
          (try
            skolemizer#deepen;
          with Skolemizer.Dontknow -> raise Dpllt.DontKnow);
          Satbox.restart_search();()
      end
    done;
  !end_result
  
(* returns TRUE if query's negation is UNSATISFIABLE *)
let sys_query f skolemizer =
  Sys_state.add_base_state [] 0;
  let f' = 
    if Global.pars.negate_queries then
      Convert.negate_formula f
    else
      f
  in
  let newp = pred_db#recent_preds in
(*  Reduce.set_preds cstore pred_db (newp); (* if INCONS, no new state *)*)
  let newc = augment_clause_set f' skolemizer in
  if debug then (Printf.printf "\ncall_dpllt with this expression: (%s)\n" (Formula.debugging_exprtype_to_string f');flush stdout);
  skolemizer#finish_initial_registration;
  call_dpllt newp newc skolemizer


(* re-sets the system *)  
let sys_reset () = 
  Sys_state.clear_base_states ();
  Parsing.clear_parser ();
  cstore#theory#reset;
  Parser_helper.clear_parser_tables ();
  pred_db#clear

(* The API has 3 basic states: SYS_START, STS_FLAGS, and SYS_STEP 

   SYS_START is the initial and final state and indicates a "clean" system

   SYS_FLAGS is where system flags may be changed; this may only be done
   prior to any assertions, definitions, or queries (as it may affect certain
   behaviors that should be consistent across all assertions, definitions, 
   and queries

   SYS_STEP(n) indicates a linear series of interactions with the user
*)
type sys_stateType =
  SYS_START | SYS_FLAGS | SYS_STEP of int

let sys_state = ref SYS_START

(**************)


exception Incorrect_state
exception Backtrack_error

let start_solver () =
  Sys_state.add_base_state [] 0;
  Satbox.satbox_init ();
  if !sys_state = SYS_START then
    sys_state := SYS_FLAGS
  else
    raise Incorrect_state

  
let set_flag flag_value = 
  if !sys_state = SYS_FLAGS then
    set_param flag_value
  else
    raise Incorrect_state


let declarations f_option skolemizer =
  begin
    match !sys_state with
        SYS_FLAGS -> sys_state := SYS_STEP 1
      | SYS_STEP n -> sys_state := SYS_STEP (n+1)
      | _ -> raise Incorrect_state
  end;
  sys_add_assertion f_option skolemizer

let add_assertion f skolemizer =
  begin
    match !sys_state with
        SYS_FLAGS -> sys_state := SYS_STEP 1
      | SYS_STEP n -> sys_state := SYS_STEP (n+1)
      | _ -> raise Incorrect_state
  end;
  sys_add_assertion (Some f) skolemizer
  
let add_axiom f skolemizer =
  add_assertion f skolemizer

let backtrack n =
  match !sys_state with
      SYS_STEP lvl ->
        begin
          let new_lvl = lvl - n in
          if new_lvl < 0 then raise Backtrack_error
          else
            begin
              sys_backtrack n;
              if new_lvl == 0 then
                sys_state := SYS_FLAGS
              else
                sys_state := SYS_STEP new_lvl
            end
        end
    | _ -> raise Incorrect_state

(* returns TRUE if f is VALID *)
let query f skolemizer =
  begin
    match !sys_state with
        SYS_FLAGS -> sys_state := SYS_STEP 1
      | SYS_STEP n -> sys_state := SYS_STEP (n+1)
      | _ -> raise Incorrect_state
  end;
  sys_query f skolemizer

let stop_solver () =
  sys_state := SYS_START;
  sys_reset ()

