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

(* formula.ml *)

(* Defines a number of types and functions related to formula construction 
   and representation.
*)

let cstore=Sys_state.cstore
let pred_db=Sys_state.pred_db

let print = Printf.printf;;

let sprintf = Printf.sprintf;;

type quant = FORALL
       |EXISTS

type binder = quant * Global.var_id * Global.type_id (* mike's addition *)

type relationtype =
    GT
  | GTE
  | LT
  | LTE
  | EQ
  | NEQ

type binoptype =
    PLUS
  | MINUS
  | MULT
  | DIV
  | INTDIV
  | MOD
  | POW

type variable_list = (Global.var_id * Global.type_id) list
(** stores a list of variables with their associated type ids (used to store free variable lists, and bound variable lists) *)

type expression_variables = {freevars               : variable_list;
                             existential_bound_vars : variable_list;
                             universal_bound_vars   : variable_list}
(** used to store the information on variables in an expression *)

type exprtype =
    E of Global.pred_id option * expression_variables* Global.type_id * expression * Escjava_label.label
    (** E(pred_id,expression_variables,type_id,expression,label).
        pred_id is the id of this expression,
        expression_variables contains three lists: one which records what variables are free, one records what variables are universally bound, and one records what variables are existentially bound
        type_id is the id of the type of this expression,
        expression is the term or predicate involved in this expression
        label is the label for this expression
    *)
and expression =
    REL of relationtype * exprtype * exprtype  (*bool*) (*reals as inputs*)
  | AND of exprtype list(*bool*)
  | OR of exprtype list(*bool*)
  | NOT of exprtype(*bool*)
  | XOR of exprtype * exprtype(*bool*)
  | IFF of exprtype * exprtype(*bool*)
  | SYM of string (* either boolean or not(do a lookup)*)
  | VAR of Global.var_id
  | INT of int(*real*)
  | STRING of string
  | FUN of string * exprtype list (*non boolean(handled by us)*)
  | PRED of string * exprtype list(*boolean (handled by us)*)
  | BINOP of binoptype * exprtype * exprtype(*real*)
  | UMINUS of exprtype(*real*)
  | ID of int * string * Escjava_label.label list (*not boolean*)
  | ITE of exprtype * exprtype * exprtype (*either boolean or not*)
  | QUANT of binder list * exprtype

let reverse_variable_polarity {freevars=freelist; existential_bound_vars=existentials; universal_bound_vars=universals} =
    {freevars=freelist; existential_bound_vars=universals; universal_bound_vars=existentials}

let empty_expression_variables = {freevars = []; existential_bound_vars=[]; universal_bound_vars=[]}

(** Creates a new expression_variables var with free_vars, existential_vars and universal_vars*)
let new_expr_vars free_vars existential_vars universal_vars = 
            { freevars = free_vars; 
              existential_bound_vars=existential_vars; 
              universal_bound_vars = universal_vars }

let add_universal_var_to_expr_vars expr_vars universal_var = new_expr_vars expr_vars.freevars expr_vars.existential_bound_vars (universal_var::(expr_vars.universal_bound_vars))

let add_existential_var_to_expr_vars expr_vars existential_var = new_expr_vars expr_vars.freevars (existential_var::(expr_vars.existential_bound_vars)) expr_vars.universal_bound_vars

let string_expr str = E(None,empty_expression_variables,0,STRING(str),Escjava_label.empty_label)

let int_expr i = E(None,empty_expression_variables,0,INT(i),Escjava_label.empty_label)

let relcompl x = match x with
    GT -> LTE
  | GTE -> LT
  | LT -> GTE
  | LTE -> GT
  | EQ -> NEQ
  | NEQ -> EQ


let rec contains_var x = function
  [] -> false
  | (var,sort_id)::t -> if( var= x) then true else contains_var x t

let rec remove_var x = function
  [] -> []
  | (var,sort_id) :: t -> if var = x then t else (var,sort_id) :: remove_var x t


let rec remove_var_from_binder_list variable = function
  [] -> []
  | ( (_,var,_) as binder) :: t -> if var = variable then t else binder :: remove_var_from_binder_list variable t


let merge_free_lists freelist1 freelist2 =
    let unordered_freelist = List.fold_left
                                (fun acc freelist -> freelist::acc)
                                freelist1 freelist2
    in
    let ordered_freelist=List.sort (fun (var1,sort_id1) (var2,sort_id2) -> compare var1 var2 ) unordered_freelist in
      List.fold_left (fun acc (var_name,sort_id)-> match acc with
                                         (var,_)::t-> if(var= var_name) then 
                                                    acc
                                                  else 
                                                    (var_name,sort_id)::acc
                                         |[] ->[(var_name,sort_id)])
                     [] ordered_freelist



let term_list_to_string_of_term_ids terml = 
  let rec term_list_to_string_of_term_ids' terml str =
      match terml with
        E(Some id,{freevars=[]},_,_,_)::[] -> str ^ (string_of_int id)
      | E(Some id,{freevars=[]},_,_,_)::t -> 
        (term_list_to_string_of_term_ids' t (str ^ (string_of_int id) ^ ", "))
      | _ -> failwith "unassigned term id in term_list_to_string_of_term_ids"
  in
  term_list_to_string_of_term_ids' terml ""

let binder_to_string bind = 
  match bind with 
      (FORALL,var_id,sort_id) -> sprintf "(FORALL, %d,%d)" var_id sort_id
     |(EXISTS,var_id,sort_id) -> sprintf "(EXISTS, %d,%d)" var_id sort_id;;

let rec binder_list_to_string bind_list = match bind_list with
                                      [] -> ""
                                      |bind::[] -> binder_to_string bind
                                      |bind::bindl -> sprintf "%s, %s" (binder_to_string bind) (binder_list_to_string bindl);;

let print_binder_list bind_list = print "%s" (binder_list_to_string bind_list);;

let print_binder bind = print "%s" (binder_to_string bind);;


let variable_list_to_string var_list = 
        let str_var_list=List.fold_left (fun str_acc (var_id,sort_id) -> 
                                               Printf.sprintf "%s (%d, %d)" str_acc var_id sort_id
                                        ) "" var_list
        in
        "[ " ^ str_var_list ^ " ]"

let expression_variables_to_string expr_vars =
        Printf.sprintf "{freevars=%s,existential_vars=%s,universal_vars=%s}" (variable_list_to_string expr_vars.freevars) (variable_list_to_string expr_vars.existential_bound_vars) (variable_list_to_string expr_vars.universal_bound_vars)

(* translates an exprtype into a string with full debugging information *)
let rec debugging_exprtype_to_string expr =
  let front_str= (match expr with E(None,expr_vars,tid,_,_)-> sprintf "E(None,%s,%d," (expression_variables_to_string expr_vars) tid
                                  |E(Some n,expr_vars,tid,_,_)-> sprintf "E(Some %d,%s,%d," n (expression_variables_to_string expr_vars) tid)
  in
  let E(_,_,_,exprtype,label)=expr in
  let rear_str =
    (match exprtype with
      REL(rel,e1,e2) -> 
              let rel_str=(match rel with
                            GT -> "GT,"
                          | GTE -> "GTE,"
                          | LT -> "LT,"
                          | LTE -> "LTE,"
                          | EQ -> "EQ,"
                          | NEQ -> "NEQ,"
                          )
              in
              let first_expr_str= debugging_exprtype_to_string e1 in
              let second_expr_str= debugging_exprtype_to_string e2 in
                sprintf "REL(%s%s,%s)" rel_str first_expr_str second_expr_str
    | AND(el) -> 
              let str=List.fold_left (fun str_acc e->str_acc ^ (debugging_exprtype_to_string e) ^ ",") "AND(" el in
                str ^ ")"
    | OR(el) -> 
              let str=List.fold_left (fun str_acc e->str_acc ^ (debugging_exprtype_to_string e) ^ ",") "OR(" el in
                str ^ ")"
    | NOT(e1)-> sprintf "NOT(%s)" (debugging_exprtype_to_string e1)
    | IFF(e1,e2)-> sprintf "IFF(%s,%s)" (debugging_exprtype_to_string e1) (debugging_exprtype_to_string e2)
    | SYM(str)-> sprintf "SYM(%s)" str
    | VAR(id) -> sprintf "VAR(%d)" id
    | INT(i)-> sprintf "INT(%d)" i;
    | FUN(name,el)-> 
              let str=List.fold_left (fun str_acc e->str_acc ^ (debugging_exprtype_to_string e) ^ ",") ("FUN("^name^",") el in
                str ^ ")"
    | PRED(name,el)->
              let str=List.fold_left (fun str_acc e->str_acc ^ (debugging_exprtype_to_string e) ^ ",") ("PRED("^name^",") el in
                str ^ ")"
    | BINOP(op,e1,e2)-> 
              let op_str=(match op with
                           PLUS -> "PLUS,"
                         | MINUS -> "MINUS,"
                         | MULT -> "MULT,"
                         | DIV -> "DIV,"
                         | INTDIV -> "INTDIV,"
                         | MOD -> "MOD,"
                         | POW -> "POW,"
                        )
              in
              let first_expr_str= debugging_exprtype_to_string e1 in
              let second_expr_str= debugging_exprtype_to_string e2 in
                sprintf "BINOP(%s%s,%s)" op_str first_expr_str second_expr_str
    | UMINUS(e1)-> sprintf "UMINUS(%s)" (debugging_exprtype_to_string e1)
    | ID(i,str,_)-> sprintf "ID(%d,%s)" i str
    | ITE(e1,e2,e3)-> sprintf "ITE(%s,%s,%s)" (debugging_exprtype_to_string e1) (debugging_exprtype_to_string e2) (debugging_exprtype_to_string e3)
    | QUANT(bindl,e1)-> sprintf "QUANT(%s,%s)" (binder_list_to_string bindl) (debugging_exprtype_to_string e1)
    )
  in
  let label_str = if not (label  =  Escjava_label.empty_label) then sprintf "label=%s" (label#get_label) else sprintf "" in
    sprintf "%s %s %s)" front_str rear_str label_str



(* print out an exprtype *)
let rec print_exprtype expr =
  print "%s" (debugging_exprtype_to_string expr)
    

(* conversion of exprtype to a string representation *)
let rec exprtype_to_string (E(_,_,_,ex,_)) = 
  expr_to_string ex
and expr_to_string ex = match ex with
    REL(r,e1,e2) ->
      let s1 = exprtype_to_string e1 in
      let s2 = exprtype_to_string e2 in
      (match r with
          GT -> s1^">"^s2
        | GTE -> s1^">="^s2
        | LT -> s1^"<"^s2
        | LTE -> s1^"=<"^s2
        | EQ -> s1^"="^s2
        | NEQ -> s1^"!="^s2
      )
  | SYM(x) -> x
  | VAR(n) -> "var(" ^ (string_of_int n) ^ ")"
  | INT(n) -> string_of_int n
  | FUN(f,elist) ->
      let rec pstring x = match x with
          h::[] -> (exprtype_to_string h)
        | h::t -> (exprtype_to_string h)^","^(pstring t)
        | [] -> ""
      in
      let params = pstring elist in
      f^"("^params^")"
  | PRED(f,elist) ->
      let rec pstring x = match x with
          h::[] -> (exprtype_to_string h)
        | h::t -> (exprtype_to_string h)^","^(pstring t)
        | [] -> ""
      in
      let params = pstring elist in
      (match elist with
          [] -> f
        | _ -> f^"("^params^")"
      )
  | BINOP(o,e1,e2) ->
      let s1 = exprtype_to_string e1 in
      let s2 = exprtype_to_string e2 in
      (match o with
          PLUS -> "("^s1^"+"^s2^")"
        | MINUS -> "("^s1^"-"^s2^")"
        | MULT -> "("^s1^"*"^s2^")"
        | DIV -> "("^s1^"/"^s2^")"
        | INTDIV -> "("^s1^"DIV"^s2^")"
        | MOD -> "("^s1^"%"^s2^")"
        | POW -> "("^s1^"^"^s2^")"
      )
  | UMINUS(e1) ->
      let s1 = exprtype_to_string e1 in
      "(-"^s1^")"
  | ID(_,s1,_) -> s1
  | QUANT(blist,e1) ->
      let s1 = exprtype_to_string e1 in
      let rec pstring x = match x with
          (FORALL,n,s)::[] -> "FORALL "^(string_of_int n)^" "^(string_of_int s)
        | (EXISTS,n,s)::[] -> "EXISTS "^(string_of_int n)^" "^(string_of_int s)
        | (FORALL,n,s)::t -> "FORALL "^(string_of_int n)^" "^(string_of_int s)^","^(pstring t)
        | (EXISTS,n,s)::t -> "EXISTS "^(string_of_int n)^" "^(string_of_int s)^","^(pstring t)
        | [] -> ""
      in
      let params = pstring blist in
      params^"("^s1^")"
  | AND (l) ->
      let rec pstring x = match x with
          s::[] -> exprtype_to_string s
        | s::t -> (exprtype_to_string s)^" & "^(pstring t)
        | [] -> ""
      in
      "("^(pstring l)^")"
  | OR (l) ->
      let rec pstring x = match x with
          s::[] -> exprtype_to_string s
        | s::t -> (exprtype_to_string s)^" | "^(pstring t)
        | [] -> ""
      in
      "("^(pstring l)^")"
  | NOT (e) ->
      let s = exprtype_to_string e in
      "~("^s^")"
  | IFF (e1,e2) ->
      let s1 = exprtype_to_string e1 in
      let s2 = exprtype_to_string e2 in
      "("^s1^"<=>"^s2^")"
      
  | ITE(e1,e2,e3) ->
      let s1 = exprtype_to_string e1 in
      let s2 = exprtype_to_string e2 in
      let s3 = exprtype_to_string e3 in
      "(IF "^s1^" THEN "^s2^" ELSE "^s3^")"
  | _ -> "other_expr_type"


type polarity = POS | NEG | BOTH

let negate pol = match pol with
    NEG -> POS
  | POS -> NEG
  | BOTH -> BOTH

let flip_binder (quantifier,var,sort_id) = match quantifier with
    FORALL -> (EXISTS,var,sort_id)
  | EXISTS -> (FORALL,var,sort_id)

let is_forall=function   (FORALL,_,_)-> true
                       | _ -> false



exception Referenced_noninstantiated_variable

exception Referenced_nullterm_id

let rec term_ids = function
    [] -> []
  | (E(Some id,_,_,_,_))::[] -> [id]
  | (E(Some id,_,_,_,_))::t  -> id::(term_ids t)


let rec printlist = function
    [] -> flush stdout
  | h::[] ->  Printf.printf "%d" h; flush stdout
  | h::t -> Printf.printf "%d," h; printlist t; flush stdout


let rec printlists = function
  [] -> Printf.printf "\n"; flush stdout
  | h::[] ->  Printf.printf "["; printlist h; Printf.printf "]"; flush stdout
  | h::t -> Printf.printf "["; printlist h; Printf.printf "],"; printlists t;
  flush stdout




let is_lit f = match f with
    E(_, _, _, REL(_,_,_),_) -> true
  | E(_, _, _, PRED(_,_),_) -> true
  | E(_, _, _, QUANT(_,_),_) -> true
  | _ -> false


(* relies on sys_state.ml *)
let bool_type_id = cstore#theory#boolType

let is_term (E(_,_,type_id,_,_)) = if type_id=bool_type_id then false else true

let make_abs_pred () =
  let new_id = cstore#theory#next_id in
    pred_db#add_uninterpreted_abstract_pred new_id;
    new_id

let add_label_to_expr expr label = 
      let E(expr_id, freevars, type_id, expression, _)= expr in
        E(expr_id, freevars, type_id, expression, label)

let set_expr_guard expr guard =
  let E(expr_id,freelist,sort,expr1,label)=expr in
    let guard_label=Escjava_label.set_label_guard label guard in
      E(expr_id,freelist,sort,expr1,guard_label)

let is_guarded_expr expr =
  let E(expr_id,freelist,sort,expr1,label)=expr in
    label#is_guard

let make_not_expr expr1 =
if Global.debug then (Printf.printf "make_not_expr";print_string "\n";flush stdout);
      match expr1 with
        E(Some id1,expression_vars,_,PRED(name,exprl),label) ->
            E(Some(Global.compl id1),reverse_variable_polarity expression_vars,bool_type_id,PRED(name,exprl),label)
      | E(Some id1,expression_vars,_,REL(z,x,y),label) ->
            E(Some (Global.compl id1),reverse_variable_polarity expression_vars,bool_type_id,REL(relcompl z,x,y),label)
      | E(Some id1,expression_vars,_,expr,_)->
            let not_id=make_abs_pred() in
              E(Some not_id,reverse_variable_polarity expression_vars,bool_type_id,NOT(expr1),Escjava_label.empty_label)
      | E(None,expression_vars,_,REL(z,x,y),label) ->
            E(None,reverse_variable_polarity expression_vars,bool_type_id,REL(relcompl z,x,y),label)
      | E(None,expression_vars,_,_,_) ->
            E(None,reverse_variable_polarity expression_vars,bool_type_id,NOT(expr1),Escjava_label.empty_label)



let rec gather_labels_from_expr (E(_,_,_,expr1,label)) =
  match expr1 with  
  | VAR(_)-> if not label#is_empty then [label] else []
  | INT(_)-> if not label#is_empty then [label] else []
  | FUN(_,exprlist) ->  if not label#is_empty then label::(gather_labels_from_exprlist exprlist) else gather_labels_from_exprlist exprlist
  | BINOP(_,expr2,expr3)->  if not label#is_empty then label::(gather_labels_from_exprlist [expr2;expr3]) else gather_labels_from_exprlist [expr2;expr3]
  | UMINUS(expr) -> if not label#is_empty then label::(gather_labels_from_expr expr) else gather_labels_from_expr expr
  | ID(_,_,label_list)-> if not label#is_empty then label::label_list else label_list
  | _ -> failwith "gather_labels should only be used on terms"
and gather_labels_from_exprlist exprlist = 
  List.fold_left (fun acc expr -> List.rev_append (gather_labels_from_expr expr) acc) [] exprlist 

let register_predicate_label_from_expr expr= 
  match expr with
    E(Some n,_,_,PRED(_,_),label) -> 
      let pred=Pred.pred (pred_db#get_lit n) in
        if not label#is_empty then
          Pred.add_pred_label pred label;
  | E(Some n,_,_,REL(_,_,_),label) -> 
      let pred=Pred.pred (pred_db#get_lit n) in
        if not label#is_empty then
          Pred.add_pred_label pred label;
  | E(Some n,_,_,QUANT(_,_),label) -> 
      let pred=Pred.pred (pred_db#get_lit n) in
        if not label#is_empty then
          Pred.add_pred_label pred label;
  | E(None,_,_,_,_) ->
      failwith "register_predicate_label_from_expr requires the expression to have been declared"
  | _ -> failwith "register_predicate_label_from_expr only works on atomic predicates"
