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

exception Parsing_error
exception Empty_formula

type errtype = ERR_PARSE | ERR_EMPTY_FORMULA | ERR_STATE | ERR_BACKTRACK |
  ERR_OTHER

let debug = Global.debug


let parse_assert_string s' =
  let (f,sk) = 
    try 
      let lexbuf = Lexing.from_string s' in
      Smt_parser.do_assert Smt_lexer.token lexbuf
    with _ -> raise Parsing_error
  in
  match f with
      Some f' -> (f',sk)
    | None -> raise Empty_formula


let parse_func_declaration_string s' =
    try 
      let lexbuf = Lexing.from_string s' in
      Smt_parser.do_func_declaration Smt_lexer.token lexbuf
    with _ -> raise Parsing_error

let parse_type_declaration_string s' =
    try 
      let lexbuf = Lexing.from_string s' in
      Smt_parser.do_type_declaration Smt_lexer.token lexbuf
    with _ -> raise Parsing_error

let parse_pred_declaration_string s' =
    try 
      let lexbuf = Lexing.from_string s' in
      Smt_parser.do_pred_declaration Smt_lexer.token lexbuf
    with _ -> raise Parsing_error

let do_decl fc xr_sgt = 
  try
    Sys_state.pred_db#mark_point;
    let sk = fc xr_sgt in
    Api_native.declarations None sk;
    1
  with Api_native.Incorrect_state ->
    (-1)
  | Parsing_error ->
    Sys_state.pred_db#backtrack Sys_state.cstore#unregister_pred 1;
    (-2)
  | _ -> 
    (-32)



let parse_query_string s' =
  let (f,sk) = 
    try 
      let lexbuf = Lexing.from_string s' in
     Smt_parser.do_query Smt_lexer.token lexbuf
    with _ -> raise Parsing_error
  in
  match f with
      Some f' -> (f',sk)
    | None -> raise Empty_formula



(**************)
(* return codes:
>=0 : return value
< 0 : error code
-1 : incorrect state
-2 : parsing error
-3 : backtrack error
-32 : other error
*)


let start_solver () =
  try 
    Api_native.start_solver ();
    1
  with Api_native.Incorrect_state ->
    (-1)
  | _ -> 
    (-32)

let set_flags flags = 
  try 
          let flags_array = 
            Array.of_list ("sammy"::(Str.split (Str.regexp " +") flags)) 
          in
          let speclist = [
                ("-max_lemmas",
                 Arg.Int (fun n ->
                   Api_native.set_flag (Global.MAX_LEMMAS n)),
                 "Maximum total number of learned lemmas [512]"
                );
                ("-active_lemmas",
                 Arg.Int (fun n ->
                   Api_native.set_flag (Global.MAX_ACTIVE_LEMMAS n)),
                 "Number of active learned lemmas (=< max_lemmas) [128]"
                );
                ("-activity_cycle",
                 Arg.Int (fun n ->
                   Api_native.set_flag (Global.ACTIVITY_CYCLE n)),
                 "Length of activity cycle [60]"
                );
                ("-quiet",
                 Arg.Unit (fun () ->
                   Api_native.set_flag (Global.VERBOSE false)),
                 "Quiet mode (minimal statistics) (off)"
                );
                ("-inst_time",
                 Arg.Float (fun n ->
                   Api_native.set_flag (Global.TIMEOUT n)),
                 "Single check timout duration, in seconds [3600]"
                );
                ("-timeout",
                 Arg.Float (fun n ->
                   Api_native.set_flag (Global.GLOBAL_TIMEOUT n)),
                 "System timeout duration, in seconds [3600]"
                );
                ("-restart_cycle",
                 Arg.Int (fun n ->
                   Api_native.set_flag (Global.RESTART_CYCLE n)),
                 "Restart search after n conflicts [max_int]"
                );
                ("-max_instances",
                 Arg.Int (fun n ->
                   Api_native.set_flag (Global.MAX_INSTANCES n)),
                 "Maximum number of instances generated at once [30]"
                );
                ("-exhaustive",
                 Arg.Unit (fun () ->
                   Api_native.set_flag (Global.EXHAUSTIVE true)),
                 "Instantiate each level exhaustively(off)"
                )
               ]
          in
          let usage_msg = "" in
          Arg.parse_argv flags_array speclist (fun _ -> ()) usage_msg;
          1
  with Api_native.Incorrect_state ->
      (-1)
  | _ -> 
      (-32)

(* assumes you meant functions *)
let declaration xr_sgt =
  do_decl parse_func_declaration_string xr_sgt

let type_declaration xr_sgt = 
  do_decl parse_type_declaration_string xr_sgt

let func_declaration xr_sgt = 
  do_decl parse_func_declaration_string xr_sgt

let pred_declaration xr_sgt =
  do_decl parse_pred_declaration_string xr_sgt

let var_declaration xr_sgt = 
  do_decl parse_func_declaration_string xr_sgt

(* axiom must be of the form assign commands *)
let add_axiom xr_axiom =
  try
    Sys_state.pred_db#mark_point;
    let f,sk = parse_assert_string xr_axiom in 
    Api_native.add_axiom f sk;
    1
  with 
(*    Reduce.Incons -> Api_native.backtrack 1; 0  | *)
    Api_native.Incorrect_state ->
    (-1)
  | Parsing_error -> 
    Sys_state.pred_db#backtrack Sys_state.cstore#unregister_pred 1;
    (-2)
  | _ -> 
    (-32)

(* assertion must be of the form "ASSERT f;" *)
let add_assertion xr_asrt =
  try
    Sys_state.pred_db#mark_point;
    let f,sk = parse_assert_string xr_asrt in 
    Api_native.add_assertion f sk;
    1
  with 
(*    Reduce.Incons -> 
      Api_native.backtrack 1;
      0 (* this will not have created any new clauses *)  | *)
    Api_native.Incorrect_state ->
    (-1)
  | Parsing_error -> 
    (-2)
  | _ -> 
    (-32)


let backtrack n =
  try
    Api_native.backtrack n;
    n
  with Api_native.Incorrect_state ->
    (-1)
  | Api_native.Backtrack_error -> 
    (-3)
  | _ -> 
    (-32)


let query xr_q =
  try
    Sys_state.pred_db#mark_point;
    let f,sk = parse_query_string xr_q in
    let result = match (Api_native.query f sk) with
        true ->  1
      | false -> 0
    in
    Api_native.backtrack 1;
    result
  with
    Dpllt.DontKnow ->  Api_native.backtrack 1;2
  | Dpllt.Timeout ->  Api_native.backtrack 1;2
  | Reduce.Incons ->  Api_native.backtrack 1;
      1
  | Api_native.Incorrect_state ->
(-1)
  | Parsing_error -> 
    Sys_state.pred_db#backtrack Sys_state.cstore#unregister_pred 1;
    (-2)
  | _ -> 
    (-32)



let stop_solver () =
  try 
    Api_native.stop_solver ();
    1
  with _ -> 
    (-32)

