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

open Basic_expression

open Theory_db

open Formula

open Expressions

let debug = Global.debug

let time_finished_parsing=ref 0.

exception No_formula_declared

exception Sort_symbol_not_declared

exception Rank_mismatch

exception Type_mismatch

exception Pred_not_declared

exception Function_not_declared

exception VarNotFound of string
exception FletNotFound of string

type bench_attribute =
    ASSUMPTION of exprtype
  | FORMULA of exprtype
  | STATUS of string
  | LOGIC of string
  | EXTRASORTS
  | EXTRAFUNS
  | EXTRAPREDS
  | NOTES
  | BENCH_ANNOTATION
  
type var_type = 
    BOUND of int*sort
  | LET of ite_wrapper*sort

let theory = cstore#theory

let term_db=Term_db.term_db

let skolemizer=new Skolemizer.skolemizer(pred_db,term_db)


(* takes expression id to be skolemized & makes a new variable of the type *)
(* returns new expression ID *)
(* name : base string name for the expression(may be empty) *)
(* typeid : id of type of expression to be replaced *)
let define_fresh_unnamed_constant sort_id =
  let nextid = theory#next_id in
  let idstr = (string_of_int nextid)^"_c" in
  let new_id = theory#decVariable idstr sort_id in
  term_db#add_term sort_id new_id;
  E(Some new_id,empty_expression_variables,sort_id,ID(new_id,idstr,[]),Escjava_label.empty_label)

let bound_var_counter= new Counter.set_counter 0

let var_table = (Hashtbl.create 100: (string,var_type)Hashtbl.t)

let get_var x = 
  try
    Hashtbl.find var_table x
  with Not_found -> raise (VarNotFound x)


let add_bound_var var_name sort=
    let var_id=bound_var_counter#next in
      Hashtbl.add var_table var_name (BOUND(var_id,sort));
      var_name

let compare_sorts x y = 
  let xid = x#get_id in
  let yid = y#get_id in
  if (xid=theory#intType && yid=theory#realType) || (xid=theory#realType && yid=theory#intType) then
    true
  else
    x=y

let add_let_var var_name ite_expr sort = Hashtbl.add var_table var_name (LET(ite_expr,sort))

let del_var = Hashtbl.remove var_table

let flet_table = (Hashtbl.create 100: (string,exprtype)Hashtbl.t)

let add_flet_formula = Hashtbl.add flet_table 

let get_flet_formula x = 
  try
    Hashtbl.find flet_table x
  with Not_found -> raise (FletNotFound x)


let remove_flet_formula = Hashtbl.remove flet_table

let clear_parser_tables () =
  Hashtbl.clear var_table;
  Hashtbl.clear flet_table

let partially_clear_parser_tables (_:int list) =
  clear_parser_tables ()

  
(* This will take in a binder and an expression, and quantify the expression
  with that binder*)
let quantify_expression ((quantifier, var_name, sort_id) as bind) generate_ids =
  function
    E(Some id,expr_vars,_,expr,label) ->
        let quantified_expr_vars= 
            match quantifier with
              FORALL -> new_expr_vars (Formula.remove_var var_name expr_vars.freevars) (expr_vars.existential_bound_vars) ((var_name,sort_id)::(expr_vars.universal_bound_vars))
            | EXISTS -> new_expr_vars (Formula.remove_var var_name expr_vars.freevars) ((var_name,sort_id)::(expr_vars.existential_bound_vars)) (expr_vars.universal_bound_vars)
        in
        E(Some (make_quant_abs_pred()),quantified_expr_vars,
            bool_type_id,QUANT([bind],E(Some id,expr_vars,bool_type_id,expr,label)),Escjava_label.empty_label)
  | E(None,expr_vars,_,expr,label) -> 
        let quantified_expr_vars= 
            match quantifier with
              FORALL -> new_expr_vars (Formula.remove_var var_name expr_vars.freevars) (expr_vars.existential_bound_vars) ((var_name,sort_id)::(expr_vars.universal_bound_vars))
            | EXISTS -> new_expr_vars (Formula.remove_var var_name expr_vars.freevars) ((var_name,sort_id)::(expr_vars.existential_bound_vars)) (expr_vars.universal_bound_vars)
        in
        if(generate_ids) then
          E(Some (make_quant_abs_pred()),quantified_expr_vars,
            bool_type_id,QUANT([bind],E(None,expr_vars,bool_type_id,expr,label)),Escjava_label.empty_label)
        else
           E(None,quantified_expr_vars,
            bool_type_id,QUANT([bind],E(None,expr_vars,bool_type_id,expr,label)),Escjava_label.empty_label)

let extract_guard_from_exprlist exprl =
(* extract_guard_from_exprlist will remove the guard flag from any expression in exprl and returns the new list and true if any expressions were guarded, 
   or the original list if none of the expressions were guarded
*)
              let (stripped_expr_list,guarded) =(List.fold_left (fun (expr_acc,guard) expr -> 
                                if guard then  
                                  (* if guard has been found already, simply remove the guards from the other expression and let guard remain true *)
                                  ((set_expr_guard expr false)::expr_acc,true)
                                else
                                  if is_guarded_expr expr then
                                    (*set guard to true and remove guard from the expression *)
                                    ((set_expr_guard expr false)::expr_acc,true)
                                  else
                                    (*leave guard set to false, no modification needed *)
                                    (expr::expr_acc,false)

                             ) ([],false) exprl)
              in
              (List.rev stripped_expr_list), guarded


let rec push_down ((E(id,expr_vars1,_,inner_expr,label)) as quantified_expr) =
(*This function will take a formula and push all the quantifiers down as far as
possible,
switching from forall to exists and vice versa as the situation warrants*)
(*Printf.printf "\npush_down: ";
Formula.print_exprtype quantified_expr;
Printf.printf "\n";
*)
    let out=match inner_expr with
      QUANT([bind],expr) ->
        (match expr with
          E(id2,expr_vars2,_,QUANT(binderList,expr2),label2) ->
              (if not (id2=None) then remove_pred id2;
                 let new_label=
                     if label2#is_guard then 
                       Escjava_label.set_label_guard label true
                     else
                       label
                 in
                 push_down( E(id,expr_vars1,bool_type_id,QUANT(bind::binderList,expr2),new_label) )
                 (*consolidate any quantifiers*)
              )
        | (E(id2,expr_vars2,_,expr2,label2) as unquantified_expr) ->
            (
                let (quant_type,var_name,sort_id)=bind in
                match (quant_type,expr2) with
                  ( _,REL(_,_,_) ) ->
                  (*if the predicate doesn't contain the variable in the binder,
                    drop the quantifier*)
                    if Formula.contains_var var_name (expr_vars2.freevars) then
                      quantified_expr
                    else
                      unquantified_expr
                | ( _,PRED(_,_) ) ->
                  (*if the predicate doesn't contain the variable in the binder,
                    drop the quantifier*)
                    if Formula.contains_var var_name (expr_vars2.freevars) then
                      quantified_expr
                    else
                      unquantified_expr
                | ( FORALL, NOT(expr)) ->
                    if Formula.contains_var var_name (expr_vars2.freevars) then
                    begin
                      let new_expr_vars1=Formula.new_expr_vars expr_vars1.freevars ((var_name,sort_id)::expr_vars1.existential_bound_vars) (Formula.remove_var var_name expr_vars1.universal_bound_vars) in
                      let pushed_down_expr=
                        push_down(E(id,new_expr_vars1,bool_type_id,QUANT([EXISTS,var_name,sort_id],expr),label))
                      in
                      let new_id=match id with 
                                   None -> None
                                 | _ -> Some(make_abs_pred())
                      in
                      let new_freelist2=Formula.remove_var var_name (expr_vars2.freevars) in
                      (* reverse the polarity of the bound variables (existential to universal and vice versal) *)
                      let unquantified_expr_vars=Formula.new_expr_vars new_freelist2 (expr_vars2.universal_bound_vars) ((var_name,sort_id)::expr_vars2.existential_bound_vars) in
                      E(new_id,unquantified_expr_vars,bool_type_id,
                        NOT(pushed_down_expr),label2)
                    end
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr                    
                | ( EXISTS, NOT(expr)) ->
                    if Formula.contains_var var_name expr_vars2.freevars then
                      let new_expr_vars1=Formula.new_expr_vars expr_vars1.freevars (Formula.remove_var var_name expr_vars1.existential_bound_vars) ((var_name,sort_id)::expr_vars1.universal_bound_vars) in
                      let pushed_down_expr=
                        push_down(E(id,new_expr_vars1,bool_type_id,QUANT([FORALL,var_name,sort_id],expr),label))
                      in
                      let new_id=match id with 
                                   None -> None
                                 | _ -> Some(make_abs_pred())
                      in
                      let new_freelist2=Formula.remove_var var_name (expr_vars2.freevars) in
                      (* reverse the polarity of the bound variables (existential to universal and vice versal) *)
                      let unquantified_expr_vars=Formula.new_expr_vars new_freelist2 ((var_name,sort_id)::expr_vars2.universal_bound_vars) (expr_vars2.existential_bound_vars) in
                      E(new_id,unquantified_expr_vars,bool_type_id,
                        NOT(pushed_down_expr),label2)
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr
                | ( FORALL, AND(exprl)) ->
                    if Formula.contains_var var_name expr_vars2.freevars then
                      let new_freelist=Formula.remove_var var_name expr_vars2.freevars in
                      let generate_ids=if new_freelist =[] then
                                         true 
                                       else 
                                         false 
                      in
                      let quantified_expr_list=
                          List.map (quantify_expression bind generate_ids) exprl
                      in
                      let and_expr=
                          AND(List.map push_down quantified_expr_list)
                      in
                      let new_id=if(new_freelist=[]) then
                                   Some(make_abs_pred())
                                 else
                                   None
                      in
                      let unquantified_expr_vars=Formula.new_expr_vars new_freelist expr_vars2.existential_bound_vars ((var_name,sort_id)::(expr_vars2.universal_bound_vars)) in
                      E(new_id,unquantified_expr_vars,bool_type_id,and_expr,label2)
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr
                | (EXISTS, AND(exprl)) ->
                    if Formula.contains_var var_name expr_vars2.freevars then
                      let (has_var,not_has_var)=
                        List.partition (function E(_,{freevars=var_list},_,_,_) ->
                                          Formula.contains_var var_name var_list
                                       ) exprl
                      in
                      match has_var with
                        [E(id3,expr_vars3,_,e3,_) as expr]->
                          if not_has_var=[] then
                            let single_expr=if label2#is_guard then (* need to preserve the guard info since the AND is being dropped *)
                                              set_expr_guard expr true
                                            else
                                              expr
                            in
                            let new_freelist=Formula.remove_var var_name expr_vars3.freevars in
                            let unquantified_expr_vars=Formula.new_expr_vars new_freelist ((var_name,sort_id)::(expr_vars3.existential_bound_vars)) expr_vars3.universal_bound_vars in
                              push_down(E(Some (make_quant_abs_pred()),
                                          unquantified_expr_vars,bool_type_id,
                                          QUANT([bind],single_expr),label))
                          else
                            let new_freelist=Formula.remove_var var_name expr_vars3.freevars in
                            let unquantified_expr_vars=Formula.new_expr_vars new_freelist ((var_name,sort_id)::(expr_vars3.existential_bound_vars)) expr_vars3.universal_bound_vars in
                            let pushed_down_exprs=
                                push_down(E(id,unquantified_expr_vars,bool_type_id,
                                            QUANT([bind],expr),Escjava_label.empty_label))
                            in
                            let new_freelist'=Formula.remove_var var_name expr_vars2.freevars in
                            let new_id=if(new_freelist=[]) then
                                         Some(make_abs_pred())
                                       else
                                         None
                            in
                            let unquantified_expr_vars'= 
                                    Formula.new_expr_vars new_freelist' ((var_name,sort_id)::(expr_vars2.existential_bound_vars)) expr_vars2.universal_bound_vars 
                            in

                            E(new_id,unquantified_expr_vars',bool_type_id,
                              AND(pushed_down_exprs::not_has_var),label2)
                      | _ ->
                          if not_has_var=[] then
                            quantified_expr
                          else
                            let has_var_free_lists=
                               List.map (
                                         function E(_,{freevars=var_list},_,_,_) ->var_list
                                        ) has_var
                            in
                            let has_var_existential_lists=
                               List.map (
                                         function E(_,{existential_bound_vars=exist_list},_,_,_) ->exist_list
                                        ) has_var
                            in
                            let has_var_universal_lists=
                               List.map (
                                         function E(_,{universal_bound_vars=universal_list},_,_,_) ->universal_list
                                        ) has_var
                            in
                            let merged_free_list=
                               List.fold_left merge_free_lists [] has_var_free_lists
                            in
                            let merged_exist_list=
                               List.fold_left merge_free_lists [] has_var_existential_lists
                            in
                            let merged_universal_list=
                               List.fold_left merge_free_lists [] has_var_universal_lists
                            in
                            (* create an expression_variables variable that merges all the var data from the expressions that should remain quantified *)
                            let quantified_expr_vars=Formula.new_expr_vars merged_free_list merged_exist_list merged_universal_list in

                            (* remove the quantified var from the quantified formula's freevar list, and add it to it's existential var list *)
                            let quantified_and_expr_vars= 
                                    Formula.new_expr_vars (Formula.remove_var var_name merged_free_list) ((var_name,sort_id)::(merged_exist_list)) merged_universal_list
                            in
                            let quantified_and=
                             E(id,quantified_and_expr_vars,bool_type_id,
                               QUANT([bind], E(Some(make_abs_pred()),
                                               (quantified_expr_vars),
                                               bool_type_id,AND(has_var),Escjava_label.empty_label)),Escjava_label.empty_label)
                            in
                            let new_freelist=Formula.remove_var var_name expr_vars2.freevars in
                            let overall_and_expr_vars= 
                                    Formula.new_expr_vars new_freelist ((var_name,sort_id)::(expr_vars2.existential_bound_vars)) expr_vars2.universal_bound_vars 
                            in
                            let new_id=if(new_freelist=[]) then
                                         Some(make_abs_pred())
                                       else
                                         None
                            in
                            E(new_id,overall_and_expr_vars,bool_type_id,
                              AND(quantified_and::not_has_var),label2)
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr
                | (FORALL, OR(exprl)) ->
                    if Formula.contains_var var_name expr_vars2.freevars then
                      let (has_var,not_has_var)=
                        List.partition (function E(_,{freevars=var_list},_,_,_) ->
                                          Formula.contains_var var_name var_list
                                       ) exprl
                      in
                      match has_var with
                        [E(id3,expr_vars3,_,e3,label3) as expr]->
                          if not_has_var=[] then
                            let new_freelist=Formula.remove_var var_name expr_vars3.freevars in
                            let unquantified_expr_vars=Formula.new_expr_vars new_freelist expr_vars3.existential_bound_vars ((var_name,sort_id)::(expr_vars3.universal_bound_vars)) in
                            let single_expr=if label2#is_guard then (* need to preserve the guard info since the OR is being dropped *)
                                              set_expr_guard expr true
                                            else
                                              expr
                            in
                              push_down(E(Some (make_quant_abs_pred()),
                                          unquantified_expr_vars,bool_type_id,
                                          QUANT([bind],single_expr),label))
                          else
                            let new_freelist=Formula.remove_var var_name expr_vars3.freevars in
                            let unquantified_expr_vars=Formula.new_expr_vars new_freelist expr_vars3.existential_bound_vars ((var_name,sort_id)::(expr_vars3.universal_bound_vars)) in
                            let pushed_down_exprs=
                                push_down(E(id,unquantified_expr_vars,bool_type_id,
                                            QUANT([bind],expr),Escjava_label.empty_label))
                            in
                            let new_freelist'=Formula.remove_var var_name expr_vars2.freevars in
                            let new_id=if(new_freelist=[]) then
                                         Some(make_abs_pred())
                                       else
                                         None
                            in
                            let unquantified_expr_vars'= 
                                    Formula.new_expr_vars new_freelist' expr_vars2.existential_bound_vars ((var_name,sort_id)::(expr_vars2.universal_bound_vars)) 
                            in

                            E(new_id,unquantified_expr_vars',bool_type_id,
                              OR(pushed_down_exprs::not_has_var),label2)
                      | _ ->
                          if not_has_var=[] then
                            quantified_expr
                          else
                            let has_var_free_lists=
                               List.map (
                                         function E(_,{freevars=var_list},_,_,_) ->var_list
                                        ) has_var
                            in
                            let has_var_existential_lists=
                               List.map (
                                         function E(_,{existential_bound_vars=exist_list},_,_,_) ->exist_list
                                        ) has_var
                            in
                            let has_var_universal_lists=
                               List.map (
                                         function E(_,{universal_bound_vars=universal_list},_,_,_) ->universal_list
                                        ) has_var
                            in
                            let merged_free_list=
                               List.fold_left merge_free_lists [] has_var_free_lists
                            in
                            let merged_exist_list=
                               List.fold_left merge_free_lists [] has_var_existential_lists
                            in
                            let merged_universal_list=
                               List.fold_left merge_free_lists [] has_var_universal_lists
                            in
                            (* create an expression_variables variable that merges all the var data from the expressions that should remain quantified *)
                            let quantified_expr_vars=Formula.new_expr_vars merged_free_list merged_exist_list merged_universal_list in

                            (* remove the quantified var from the quantified formula's freevar list, and add it to it's universal var list *)
                            let quantified_or_expr_vars= 
                                    Formula.new_expr_vars (Formula.remove_var var_name merged_free_list) merged_exist_list ((var_name,sort_id)::(merged_universal_list))
                            in
                            let quantified_or=
                             E(id,quantified_or_expr_vars,bool_type_id,
                               QUANT([bind], E(Some(make_abs_pred()),
                                               (quantified_expr_vars),
                                               bool_type_id,OR(has_var),Escjava_label.empty_label)),Escjava_label.empty_label)
                            in
                            let new_freelist=Formula.remove_var var_name expr_vars2.freevars in
                            let overall_or_expr_vars= 
                                    Formula.new_expr_vars new_freelist expr_vars2.existential_bound_vars ((var_name,sort_id)::(expr_vars2.universal_bound_vars)) 
                            in
                            let new_id=if(new_freelist=[]) then
                                         Some(make_abs_pred())
                                       else
                                         None
                            in
                            E(new_id,overall_or_expr_vars,bool_type_id,
                              OR(quantified_or::not_has_var),label2)
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr

                | (EXISTS, OR(exprl)) ->
                    if Formula.contains_var var_name expr_vars2.freevars then
                      let new_freelist=Formula.remove_var var_name expr_vars2.freevars in
                      let generate_ids=if new_freelist =[] then
                                         true 
                                       else 
                                         false 
                      in
                      let quantified_expr_list=
                          List.map (quantify_expression bind generate_ids) exprl
                      in
                      let or_expr=
                          OR(List.map push_down quantified_expr_list)
                      in
                      let new_id=if(new_freelist=[]) then
                                   Some(make_abs_pred())
                                 else
                                   None
                      in
                      let unquantified_expr_vars=Formula.new_expr_vars new_freelist ((var_name,sort_id)::(expr_vars2.existential_bound_vars)) expr_vars2.universal_bound_vars in
                      E(new_id,unquantified_expr_vars,bool_type_id,or_expr,label2)
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr
                | (FORALL, IFF(e1,e2)) ->
                    if Formula.contains_var var_name expr_vars2.freevars then
                      quantified_expr
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr
                | (EXISTS, IFF(e1,e2)) ->
                    if Formula.contains_var var_name expr_vars2.freevars then
                      quantified_expr
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr
                | (FORALL, XOR(e1,e2)) ->
                    if Formula.contains_var var_name expr_vars2.freevars then
                      quantified_expr
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr
                | (EXISTS, XOR(e1,e2)) ->
                    if Formula.contains_var var_name expr_vars2.freevars then
                      quantified_expr
                    else
                      if(expr_vars2.freevars=[] && id2=None) then
                        E(Some (make_abs_pred()),expr_vars2,bool_type_id,expr2,label2)
                      else
                        unquantified_expr
                | _ -> quantified_expr
            )
            )
     |QUANT([],expr) -> (remove_pred id; push_down expr)
        (*removes any empty quantifiers*) 
     |_ -> quantified_expr
    in
(*Printf.printf "\npush_down done: ";
Formula.print_exprtype out;
Printf.printf "\n";
*)
out
;;


