/* This file is part of cqual.
   Copyright (C) 2002-2003 The Regents of the University of California.

cqual 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, or (at your option)
any later version.

cqual 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 cqual; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */

#include "analyze.h"
#include "cqual.h"
#include "hash.h"
#include "qerror.h"
#include "qtype.h"
#include "utils.h"
#include "pam.h"
#include "effect.h"
#include "dd_list.h"
#include "common-analyze.h"

/**************************************************************************/

/* XXX: Make static eventually */
hash_table globals = NULL;   /* Extern stuff that should match
				across files */
effect global_effect = NULL; /* Effect containing all the effects
				       of every function */
effect global_env = NULL;    /* Locations bound in global scope */

void mk_effect_leq_global_env(effect e) 
{ 
  mkleq_effect(e, global_env); 
}
void mk_effect_leq_global_effect(effect e) 
{ 
  mkleq_effect(e, global_effect); 
}


/**************************************************************************
 *
 * do_* routines, common code for handling various expressions/statements
 *
 **************************************************************************/

/* assign -- eff should include arg1.eff U arg2.eff */
einfo do_assign(einfo arg1, einfo arg2, location loc, effect eff)
{
  if (arg2.ismalloc)
    eff = effect_union(defn_effect_qtype(points_to_qtype(arg1.qt)), eff);
  
  qtype_mklhs_nonconst(loc, arg1.qt);
  mark_aloc_interesting(aloc_qtype(arg1.qt));
  mkleq_assign_convert(loc, &fi_qgate, arg2.qt, do_dereference(loc, arg1.qt), 
		       INCOMPAT_TYPES_IN_ASSIGN);
  
  return mkeinfo(points_to_qtype(arg1.qt),
		 effect_union(eff, effect_wr(aloc_qtype(arg1.qt))),
		 FALSE);
}

/* cast */
einfo do_cast(einfo arg1, bool is_lexical_cst, type cast_t, location loc, context context)
{
  qtype qt;
  effect eff;

  eff = arg1.eff;
  if (context == lpos || context == apos)
    {
      type pt;
      
      assert(!type_function(cast_t));
      assert(!type_array(cast_t));
      
      pt = make_pointer_type(cast_t);
      qt = type_to_qtype(pt, "cast", loc);
    }
  else
    qt = type_to_qtype(cast_t, "cast", loc);
  
  /* ad-hoc malloc handling in action */
  if (arg1.ismalloc)
    eff = effect_union(defn_effect_qtype(qt), eff);
  
  if (!type_void(cast_t) && /* cast to void is special -- it means,
			       ``ignore this result'' */
      !is_lexical_cst)
    /* If cast_t doesn't have explicit user-defined qualifiers, */
    mkeq_qtype_cast(loc, FWD_CAST_QGATE, arg1.qt, qt, "Incompatible qualifiers at cast");

  return mkeinfo(qt, eff, FALSE);
}

/* sizeof, sizeof type, alignof, alignof type */
einfo do_sizealign_of(const char *tag, location loc, context context)
{
  qtype qt;
  
  assert(context == rpos);
  qt = mkqtype_size_t(make_qvar(tag, loc, FALSE,FALSE));
  return mkeinfo(qt, effect_empty, FALSE);
}

/* binary < <= == != => > 
 * is_eq_or_neq indicates whether the op we're looking at is == or !=
 * dna1 is true when arg1 is definitely null (respectively dna2, arg2)
 */
einfo do_boolop(location loc, bool is_eq_or_neq, bool dna1, bool dna2,
		einfo arg1, einfo arg2, effect eff, operator op)
{
  qtype qt;
  einfo result;
  
  qt = mkqtype_bool(make_qvar("__boolop", loc, FALSE,FALSE));
  
  /* XXX: Ick! */
  if (is_eq_or_neq &&
      ((file_pointer_qtype(arg1.qt) && dna2) ||
       (dna1 && file_pointer_qtype(arg2.qt))))
    /* We'll do an assign in the flow-sensitive pass, so add an
       effect here */
    {
      aloc al;
      
      if (file_pointer_qtype(arg1.qt))
	al = aloc_qtype(arg1.qt);
      else
	al = aloc_qtype(arg2.qt);
      
      mark_aloc_interesting(al);
      eff = effect_union(eff, effect_wr(al));
    }
  
  result = mkeinfo(qt, eff, FALSE);
  if (op)
    add_op_constraints(op, result.qt, arg1.qt, arg2.qt, loc, 
		       "Operands incompatible with operator definition");
  return result;

}

/* change type of exp to t - put new qtype for exp in *qt */
sinfo do_change_type(einfo exp, type t, qtype *qt, location loc)
{
  qtype new_qt;
  aloc al;
  
  qtype_mklhs_nonconst(loc, exp.qt);
  
  new_qt = type_to_qtype(t, "__change", loc);
  if (qt)
    {
      assert(!*qt);
      *qt = new_qt;
    }
  al = aloc_qtype(exp.qt);
  
  mark_aloc_interesting(al);
  
  assert(qtype_pointer(exp.qt));
  mkleq_qtype(loc, &fi_qgate, points_to_qtype(exp.qt), new_qt, 
	      "new type incompatible with previous type");

  return mksinfo(effect_union(exp.eff, effect_wr(al)));
}

/* assert type */
sinfo do_assert_type(einfo exp, type t, qtype *qt, location loc, location tloc)
{
  qtype assert_qt;
  
  assert_qt = type_to_qtype(t, "assert", tloc);
  if (qt)
    {
      assert(!*qt);
      *qt = assert_qt;
    }
  
  mkleq_qtype(loc, &fi_qgate, exp.qt, assert_qt, "unsatisfiable assertion");
  
  /* Pretend we have the effect of exp, so that in 3rd pass
     we'll be able to retrieve exp from the store, if necessary */
  return mksinfo(exp.eff);
}

qtype do_dereference(location loc, qtype p)
{
  operator op;
  qtype pt;

  assert (qtype_pointer(p));
  pt = points_to_qtype (p);

  op = find_op_kind(kind_dereference);
  if (op)
    {
      add_op_constraints(op, pt, p, NULL, loc, 
			 "Operands incompatible with operator definition");
    }

  return pt;
}

/**************************************************************************/

/* Given the type of an identifier, convert it to the right type in
   the current context. */
einfo put_id_in_context(location loc, einfo ei, context c)
{
  qtype result_qt;
  effect result_eff;

  result_eff = ei.eff;
  if (qtype_error(ei.qt))
    result_qt = error_qtype;
  else if (qtype_array(ei.qt)) {
    /* Arrays are always in r-positions, and when they're used,
       they're actually pointers.  Well, not when they're used in
       sizeof and as the target of &, but you can't take & of an
       array, and in the other places we don't care (see C9X).
       EXCEPT you can take the address of an array, so that
       is considered an apos.  Yuck. */
    if (c == rpos)
      result_qt = default_conversion_qtype(loc, ei.qt);
    else if (c == apos)
      {
	char *refname = rsprintf(parse_region, "&%s", name_qual(qual_qtype(ei.qt)));
	result_qt = mkqtype_pointer(loc, make_qvar(refname, loc, FALSE, FALSE),
				    ei.qt,
				    array_aloc_qtype(ei.qt));
      }
    else
      fail("Unexpected context %d\n", c);
  }
  else if (qtype_function(ei.qt)) {
    assert(c == rpos);
    /* Function are promoted to function pointers.  Hack: If we
       are in an & context, then still return a pointer.  The &
       only changes an l-type to an r-type by doing nothing, thus
       it will not change the fun ptr type! */
    
    /* Polymorphism -- instantiate functions at syntactic occurrences */
    if (flag_poly)
      {
	/* Make a copy of the function type with fresh qualifier variables,
	   fresh stores, and a fresh abstract location for the function. */
	result_qt = copy_qtype_poly(ei.qt, loc);

	/* Add instantiation edges */
	mkinst_qtype(loc, &open_qgate, ei.qt, result_qt, p_pos, NULL);

	result_qt = default_conversion_qtype(loc, result_qt);
      }
    else
      result_qt = default_conversion_qtype(loc, ei.qt);
  }
  else if (c == lpos || c == apos)
    result_qt = ei.qt;
  else if (c == rpos)
    {
      if (qtype_pointer(ei.qt))
        {
          result_qt = do_dereference(loc, ei.qt);
          result_eff = effect_union(result_eff, /* Implicit deref */
                                    effect_r(aloc_qtype(ei.qt)));
        }
      else
        fail("Unexpected qtype\n");

    }
  else fail_loc(loc, "Unexpected context %d\n", c);

  return mkeinfo(result_qt, result_eff, FALSE);
}

/**************************************************************************/
void init_string(location loc, qtype lhs_qtype, qtype rhs_qtype,
		 const char *error_message)
{
  qtype lhs_contents_qtype, rhs_contents_qtype;

  lhs_contents_qtype = array_of_qtype(lhs_qtype);
  rhs_contents_qtype = points_to_qtype(rhs_qtype);
  mkleq_qual(loc, &fi_qgate,
	     qual_qtype(rhs_contents_qtype),
	     qual_qtype(lhs_contents_qtype),
	     error_message);
  mkleq_qual(loc, &fi_qgate,
	     qual_qtype(rhs_qtype),
	     qual_qtype(lhs_qtype),
	     error_message);
}

/**************************************************************************/

/* Report an error at location l */
void vreport_qerror(location loc, severity sev, qual q, const char *format,
		    va_list args)
{
  if (sev == sev_err || (sev == sev_warn && warnings_are_errors))
    qerrors = TRUE;
  if (flag_pam_mode)
    {
      if (current_function_decl)
	pam_add_error(root_ddecl(current_function_decl->ddecl)->name,
		      loc, sev, q, format, args);
      else
	pam_add_error("top level", loc, sev, q, format, args);
    }
  else
    {
      fflush(NULL);
      if (loc)
	fprintf(stderr, "%s:%ld ", loc->filename, loc->lineno);
      vfprintf(stderr, format, args);
      if (!growbuf_empty(qual_error_detail) ||
	  !growbuf_empty(qtype_error_detail))
	{
	  fprintf(stderr, "\n");
	  if (loc)
	    fprintf(stderr, "%s:%ld ", loc->filename, loc->lineno);
	  if (!growbuf_empty(qual_error_detail))
	    fprintf(stderr, "%s", growbuf_contents(qual_error_detail));
	  else
	    fprintf(stderr, "%s", growbuf_contents(qtype_error_detail));
	}
      fprintf(stderr, "\n");
    }
  if (!growbuf_empty(qual_error_detail))
    growbuf_reset(qual_error_detail);
  if (!growbuf_empty(qtype_error_detail))
    growbuf_reset(qtype_error_detail);
}

/* Report an error at loc */
void report_qerror(location loc, severity sev, const char *format, ...)
{
  va_list args;

  va_start(args, format);
  vreport_qerror(loc, sev, NULL, format, args);
}

/* Report an error at loc */
void report_qual_error(location loc, severity sev, qual q, const char *format, ...)
{
  va_list args;

  va_start(args, format);
  vreport_qerror(loc, sev, q, format, args);
}


/******************************************
 *
 * misc
 *
 *******************************************/

/* Apply f to one ddecl for each global */
void traverse_globals(void (*f)(data_declaration, void *), void *arg)
{
  hash_table_scanner hts;
  data_declaration ddecl;

  hash_table_scan(globals, &hts);
  while (hash_table_next(&hts, NULL, (hash_data *) &ddecl))
    {
      assert(!ddecl->shadowed);
      f(ddecl, arg);
    }
}
/* Apply f to one ddecl for each global, in sorted order */
void traverse_globals_sorted(void (*f)(data_declaration, void *),
			     void *arg)
{
  hash_table_scanner_sorted htss;
  data_declaration ddecl;

  hash_table_scan_sorted(globals, (keycmp_fn) strcmp, &htss);
  while (hash_table_next_sorted(&htss, NULL, (hash_data *) &ddecl))
    {
      assert(!ddecl->shadowed);
      f(ddecl, arg);
    }
}


/**************************************************************************
 *                                                                        *
 * Qtype manipulation routines                                            *
 *                                                                        *
 **************************************************************************/

/* Make the left-hand side of an assignment non-const.  Prints
   an error message if this causes an error. */
void qtype_mklhs_nonconst(location loc, qtype lhs_qtype)
{
  mkNonConst_pointer(loc, lhs_qtype, "left-hand side of assignment is const");
}

/* Make q nonconst, if nonconst is a qualifier */
void mkNonConst_qual(location loc, qual q, const char *error_message)
{
  if (nonconst_qual)
    mkleq_qual(loc, &fi_qgate, q, nonconst_qual, error_message);
}

/* Make a pointer (l-) type non-const.  Returns true if there was an
   error, false if the constraint is currently valid. */
void mkNonConst_pointer(location loc, qtype ptr_qtype, const char *error_message)
{
  qtype contents_qtype;

  if (!nonconst_qual)
    return;

  assert(qtype_pointer(ptr_qtype));
  mkNonConst_qual(loc, qual_qtype(ptr_qtype), error_message);
  contents_qtype = points_to_qtype(ptr_qtype);
  if (qtype_aggregate(contents_qtype))
    mkNonConst_aggregate(loc, contents_qtype, error_message);
}

/* Make a pointer (l-)type const.  Returns true if there was an error. */
void mkConst_pointer(location loc, qtype ptr_qtype, const char *error_message)
{
  if (!const_qual)
    return;

  assert(qtype_pointer(ptr_qtype));
  mkleq_qual(loc, &fi_qgate, const_qual, qual_qtype(ptr_qtype),
	     error_message);
  /* XXX: Do something for aggregate */
}

/* Make all the fields of an aggregate non-const, but not through pointers
   (but through arrays!).  Returns true if there was an error, false
   if the constraint is currently valid. */
void mkNonConst_aggregate(location loc, qtype ag_qtype, const char *error_message)
{
  field_scanner fields;
  qtype field_qtype, contents_qtype;
  
  if (!nonconst_qual)
    return;

  field_scan(ag_qtype, &fields);
  while ((field_qtype = field_next(&fields)))
    {
      /* const *does* propagate through arrays.  This makes sense
         because arrays nested in structs are part of the same
         struct object, whereas pointers point to other objects.
     
         So if we have an array(t) type, we move through the type
         until t is not an array. */
      if (qtype_array(field_qtype))
        {
          contents_qtype = array_of_qtype(field_qtype);
          while (qtype_array(contents_qtype))
            {
              field_qtype = contents_qtype;
              contents_qtype = array_of_qtype(field_qtype);
            }
        }
      else
        contents_qtype = points_to_qtype(field_qtype);
      
      /* Now we make field_qtype (the most deeply nested array qtype,
         or the ptr qtype) non-const, and then if the contents is
         a struct/union we recurse. */
      mkNonConst_qual(loc, qual_qtype(field_qtype), error_message);
      if (qtype_aggregate(contents_qtype))
        mkNonConst_aggregate(loc, contents_qtype, error_message);
    }
}


/**************************************************************************
 *                                                                        *
 * Manipulating einfo, sinfo, and dinfo                                   *
 *                                                                        *
 **************************************************************************/

einfo mkeinfo(qtype qt, effect eff, bool ismalloc)
{
  struct einfo result;

  result.qt = qt;
  result.eff = eff;
  result.ismalloc = ismalloc;
  return result;
}

sinfo mksinfo(effect eff)
{
  struct sinfo result;

  result.eff = eff;
  return result;
}

dinfo mkdinfo(effect eff, effect alocs)
{
  struct dinfo result;

  result.eff = eff;
  result.alocs = alocs;
  result.drinfolist = NULL;
  return result;
}



/**************************************************************************
 *                                                                        *
 * Operator signatures                                                    *
 *                                                                        *
 **************************************************************************/

/* A list of all the function names used to define signatures for
   operators */
struct operator operators[] =
  {
    {"_op_uminus", sig_unop, NULL},
    {"_op_uplus", sig_unop, NULL},
    {"_op_bitnot", sig_unop, NULL},
    {"_op_not", sig_unop, NULL},
    {"_op_times", sig_binop, NULL},
    {"_op_div", sig_binop, NULL},
    {"_op_mod", sig_binop, NULL},
    {"_op_lshift", sig_binop, NULL},
    {"_op_rshift", sig_binop, NULL},
    {"_op_lt", sig_binop, NULL},
    {"_op_gt", sig_binop, NULL},
    {"_op_leq", sig_binop, NULL},
    {"_op_geq", sig_binop, NULL},
    {"_op_eq", sig_binop, NULL},
    {"_op_neq", sig_binop, NULL},
    {"_op_bitand", sig_binop, NULL},
    {"_op_bitor", sig_binop, NULL},
    {"_op_bitxor", sig_binop, NULL},
    {"_op_andand", sig_binop, NULL},
    {"_op_oror", sig_binop, NULL},
    {"_op_deref", sig_deref, NULL},
    /*{"_op_addr", sig_addr, NULL},*/
    /*{"_op_assign", sig_assign, NULL},*/
    /*{"_op_plus", sig_binop, NULL},*/
    /*{"_op_minus", sig_binop, NULL},*/
    {0, 0, NULL}};

/* Given an operator function name, return its signature */
operator find_op_name(const char *name)
{
  int i;

  for (i = 0; operators[i].name; i++)
    {
      if (!strcmp(name, operators[i].name))
        return operators+i;
    }
  return NULL;
}

/* Reset the operator qtypes to NULL (nonexistant) */
void reset_operators(void)
{
  int i;

  for (i = 0; operators[i].name; i++)
    operators[i].qt = NULL;
}

/* Return TRUE if qt matches the signature s, false otherwise */
bool match_signature(enum sig_kind k, qtype qt, location loc)
{
  if (qtype_function(qt))
    {
      qtype ret, arg1, arg2;
      store in, out;
      qtypelist_scanner s;
      bool fmatch; /* Formals match */

      ret = return_qtype(qt);
      in = store_in_qtype(qt);
      out = store_out_qtype(qt);
      qtypelist_scan(arg_qtypes(qt), &s);
      arg1 = qtypelist_next(&s);
      arg2 = qtypelist_next(&s);
      if (qtypelist_next(&s) || qtype_varargs(qt) || qtype_oldstyle(qt))
        /* Too many arguments */
        return FALSE;
      if (arg2 && (k == sig_deref || k == sig_addr || k == sig_unop))
        /* Too many arguments */
        return FALSE;

      switch (k)
        {
        case sig_deref:
          /* Note last condition only true if arg1 is a variable */
          /* XXX: Check, don't force qtypes to be equal! */
          fmatch = (qtype_var(ret) && qtype_pointer(arg1) &&
                    !mkeq_qtype(loc, &fi_qgate, points_to_qtype(arg1), ret, NULL));
          break;
        case sig_addr:
          /* Note last condition only true if ret is a variable */
          fmatch = (qtype_pointer(arg1) &&
                    qtype_var(points_to_qtype(arg1)) &&
                    qtype_pointer(ret) &&
                    !mkeq_qtype(loc,
				&fi_qgate,
                                points_to_qtype(arg1),
                                points_to_qtype(ret), NULL));
          break;
        case sig_unop:
          fmatch = qtype_int(ret) && qtype_int(arg1);
          break;
        case sig_binop:
          fmatch = qtype_int(ret) && qtype_int(arg1) && qtype_int(arg2);
          break;
        default:
          fail("Unexpected signature kind %x\n", k);
        }
      return fmatch;
    }
  else
    return FALSE;

  /* Matches */
  return TRUE;
}

/* Add qt and dqt to op, checking first that they match op's stated
   signature kind.  Return TRUE iff an error occurs. */
bool add_op_signature(operator op, qtype qt, location loc)
{
  /* If qt or dqt were generalized, instantiate them because we're
     going to add some constraints and then generalize them again */
  if (qtype_scheme(qt))
    qt = instantiate_qtype(qt, loc);
  if (match_signature(op->sig, qt, loc))
    {
      op->qt = generalize_qtype(qt);
      return FALSE;
    }
  else
    return TRUE;
}

/* Add the constraints implied by operator signature op to ret, arg1,
   and arg2. */
bool add_op_constraints(operator op, qtype ret_qt, qtype arg1_qt, qtype arg2_qt,
                        location loc, const char *error_message)
{
  qtype op_inst;
  qtypelist_scanner s;
  bool result;

  result = FALSE;

  op_inst = instantiate_qtype(op->qt, loc);
  result = mkeq_qtype(loc, &fi_qgate, return_qtype(op_inst), ret_qt, error_message) || result;
  qtypelist_scan(arg_qtypes(op_inst), &s);
  result = mkeq_qtype(loc, &fi_qgate, arg1_qt, qtypelist_next(&s), error_message) || result;
  if (arg2_qt)
    result = mkeq_qtype(loc, &fi_qgate, arg2_qt, qtypelist_next(&s), error_message) || result;
  else
    assert(!qtypelist_next(&s));
  if (exists_effect_qual && cur_function_qtype())
    mkleq_qual(loc, &effect_qgate, 
	       qual_qtype(op_inst), 
	       qeffect_qtype(cur_function_qtype()),
	       "WARNING: function operates on illegal data.\n");

  return result;
}

/* Given an operator kind, return its signature */
operator find_op_kind(ast_kind k)
{
  operator op;

  switch (k)
    {
    case kind_unary_minus: op = operators;    break;
    case kind_unary_plus:  op = operators+1;  break;
    case kind_bitnot:      op = operators+2;  break;
    case kind_not:         op = operators+3;  break;
    case kind_times:       op = operators+4;  break;
    case kind_divide:      op = operators+5;  break;
    case kind_modulo:      op = operators+6;  break;
    case kind_lshift:      op = operators+7;  break;
    case kind_rshift:      op = operators+8;  break;
    case kind_lt:          op = operators+9;  break;
    case kind_gt:          op = operators+10; break;
    case kind_leq:         op = operators+11; break;
    case kind_geq:         op = operators+12; break;
    case kind_eq:          op = operators+13; break;
    case kind_ne:          op = operators+14; break;
    case kind_bitand:      op = operators+15; break;
    case kind_bitor:       op = operators+16; break;
    case kind_bitxor:      op = operators+17; break;
    case kind_andand:      op = operators+18; break;
    case kind_oror:        op = operators+19; break;
    case kind_dereference: op = operators+20; break;
      /*    case kind_address_of:  return operators+1; break;*/
      /*    case kind_assign:      return operators+24; break;*/
      /*    case kind_plus:        return operators+9; break;*/
      /*    case kind_minus:       return operators+10; break;*/
    default:               op = NULL;
    }

  if (op && op->qt)
    return op;
  else
    return NULL;
}
