/* This file is part of cqual.
   Copyright (C) 2000-2001 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 "parser.h"
#include "AST_utils.h"
#include "expr.h"
#include "c-parse.h"
#include "constants.h"
#include "analyze.h"
#include "cqual.h"
#include "hash.h"
#include "qtype.h"
#include "util.h"
#include "pam.h"

typedef enum { lpos, rpos, apos } context;
/* What kind of position we're in. apos = & context */

static void reset_operators(void);

void warn_if_dangerous_global(data_declaration ddecl, void *arg);
void add_declarator_overlay(declarator, qtype qt);
void analyze(declaration);
void analyze_declaration(declaration);
void analyze_operator_declaration(variable_decl);
void analyze_tag_decl(tag_declaration);
void analyze_init(location *loc, qtype lhs_qtype, expression rhs);
static bool init_string(qtype lhs_qtype, qtype rhs_qtype, location *loc);
void analyze_statement(statement);
qtype analyze_expression(expression, context);
qtype analyze_unary_expression(unary, context);
qtype analyze_binary_expression(binary, context);
qtype put_id_in_context(qtype qt, context c, location *loc);
void qtype_mklhs_nonconst(location *, qtype);
bool mkNonConst_qual(qual, location *loc);
bool mkNonConst_pointer(qtype, location *loc);
bool mkNonConst_aggregate(qtype, location *loc);
bool mkConst_pointer(qtype ptr_qtype, location *loc);
static bool assign_convert(location *loc, qtype rhs_qtype, qtype lhs_qtype,
			   qtype *new_rhs_qtype, qtype *new_lhs_qtype);
bool mkleq_assign_convert(qtype rhs, qtype lhs, location *loc);
bool unify_assign_convert(qtype rhs, qtype lhs, location *loc);
bool lub_assign_convert(qtype qt1, qtype qt2, qtype *lub, location *loc);
ast_kind assign_op_kind(binary);

/* Some handy functions defined elsewhere */
void unparse_start(FILE *);                  /* unparse.c */
void prt_variable_decl(variable_decl);
void prt_expression(expression, int);
const char *binary_op_name(ast_kind);
bool is_void_parms(declaration);             /* semantics.c */

/**************************************************************************
 *                                                                        *
 * Globals                                                                *
 *                                                                        *
 **************************************************************************/

bool qerrors = FALSE;               /* TRUE if any errors were detected */
static hash_table globals = NULL;   /* Extern stuff that should match
                                       across files */

/* The current analysis state */
static enum {state_orig, state_init, state_finish} state = state_orig;


static function_decl cur_fun_decl = NULL; /* The function being analyzed */

void init_analyze(void)
{
  qerrors = FALSE;
  globals = make_string_hash_table(parse_region, 100);

  cur_fun_decl = NULL;
  reset_operators();
  state = state_init;
}

void report_qerror(location l, severity sev, const char *format, ...);

void finish_analyze(void)
{
  if (!flag_pam_mode)
    traverse_globals(warn_if_dangerous_global, NULL);

  state = state_finish;
}

/**************************************************************************
 *                                                                        *
 * Utilities                                                              *
 *                                                                        *
 **************************************************************************/

const char *context_tostring(context c)
{
  switch (c)
    {
    case lpos: return "lpos";
    case apos: return "&pos";
    case rpos: return "rpos";
    default: return "<context?>";
    }
}

/* Follow the shadow links to the outermost ddecl this ddecl shadows. */
data_declaration root_ddecl(data_declaration ddecl)
{
  assert(ddecl);
  while (ddecl->shadowed)
    ddecl = ddecl->shadowed;
  return ddecl;
}

/* Report an error at location l */
void vreport_qerror(location l, severity sev, const char *format, va_list args)
{
  if (sev == sev_err || (sev == sev_warn && warnings_are_errors))
    qerrors = TRUE;
  if (flag_pam_mode)
    {
      if (cur_fun_decl)
	pam_add_error(root_ddecl(cur_fun_decl->ddecl)->name,
		      l, sev, format, args);
      else
	pam_add_error("top level", l, sev, format, args);
    }
  else
    {
      fprintf(stderr, "%s:%ld ", l.filename, l.lineno);
      vfprintf(stderr, format, args);
      fprintf(stderr, "\n");
    }
}

void report_qerror(location l, severity sev, const char *format, ...)
{
  va_list args;

  va_start(args, format);
  vreport_qerror(l, sev, format, args);
}

/* If you use fail_loc, you must give a 3rd argument!  Pass 0 if you
   don't need anything there. */
#define fail_loc(l, s, args...) fail("(at %s:%ld) " s, ((l).filename), ((l).lineno), args)

identifier_declarator get_id_declarator(declarator d)
{
  switch (d->kind)
    {
    case kind_function_declarator:
      {
	function_declarator fd = CAST(function_declarator, d);
	return get_id_declarator(fd->declarator);
      }
      break;
    case kind_pointer_declarator:
      {
	pointer_declarator pd = CAST(pointer_declarator, d);
	return get_id_declarator(pd->declarator);
      }
      break;
    case kind_array_declarator:
      {
	array_declarator ad = CAST(array_declarator, d);
	return get_id_declarator(ad->declarator);
      }
      break;
    case kind_identifier_declarator:
      {
	identifier_declarator id = CAST(identifier_declarator, d);
	return id;
      }
      break;
    default:
      fail_loc(d->loc, "Unexpected declarator kind 0x%x\n", d->kind);
    }
}

/* Given a declarator d, find the identifier its defining and add
   an overlay for that id for qtype qt.  Assumes d has a name. */
void add_declarator_overlay(declarator d, qtype qt)
{
  identifier_declarator id = get_id_declarator(d);
  cstring name = id->cstring;
  pam_add_overlay_file(id->loc, name.data, qt);

}

/* Given a declarator, return a good location for it, i.e., the
   location of the identifier it declares (if any). */
location *location_declarator(declarator d)
{
  identifier_declarator id = get_id_declarator(d);
  return &id->loc;
}

/* Given a declaration, return a good location for it, i.e., the
   location of the identifier it declares (if any). */
location *location_declaration(declaration d)
{
  switch(d->kind)
    {
    case kind_variable_decl:
      {
	variable_decl vd = CAST(variable_decl, d);
	return location_declarator(vd->declarator);
      }
    case kind_oldidentifier_decl:
      {
	return &d->loc;
      }
    case kind_function_decl:
      {
	function_decl fd = CAST(function_decl, d);
	return location_declarator(fd->declarator);
      }
    case kind_field_decl:
      {
	field_decl fd = CAST(field_decl, d);
	if (!fd->declarator)
	  /* Anonymous field */
	  return &fd->loc;
	else
	  return location_declarator(fd->declarator);
      }
    case kind_enumerator:
      {
	enumerator e = CAST(enumerator, d);
	return &e->loc;
      }
    case kind_implicit_decl:
      {
	implicit_decl id = CAST(implicit_decl, d);
	return &id->loc;
      }
    case kind_error_decl:
      {
	return &d->loc;
      }
    default:
      fail_loc(d->loc,
	       "Unexpected decl kind 0x%x\n", d->kind);
    }
}

/* Return the range qtype of the current function */
static qtype cur_return_qtype(void)
{
  qtype fun_qtype, ret_qtype;

  assert(cur_fun_decl);
  fun_qtype = root_ddecl(cur_fun_decl->ddecl)->qtype;
  ret_qtype = return_qtype(fun_qtype);
  return ret_qtype;
}

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

typedef struct operator
{
  const char *name;
  enum sig_kind { sig_deref, sig_addr, sig_unop, sig_binop, sig_assign } sig;
  qtype qt;
} *operator;

/* A list of all the function names used to define signatures for
   operators */
static 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 kind, return its signature */
static inline 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;
}

/* Given an operator function name, return its signature */
static inline 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;
}

#define is_op_name(name) (!strncmp("_op_", name, 4) && strlen(name) >= 4)

#define exists_op_kind(k) (find_op_kind(k) != NULL)

/* Reset the operator qtypes to NULL (nonexistant) */
static 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;
      qtypelist_scanner s;
      bool fmatch; /* Formals match */

      ret = return_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(points_to_qtype(arg1), ret, loc));
	  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(points_to_qtype(arg1),
				points_to_qtype(ret),
				loc));
	  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, &dummy_location);
  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, qtype arg1, qtype arg2,
			location *loc)
{
  qtype op_inst;
  qtypelist_scanner s;
  bool result;

  result = FALSE;

  op_inst = instantiate_qtype(op->qt, &dummy_location);
  result = mkeq_qtype(return_qtype(op_inst), ret, loc) || result;
  qtypelist_scan(arg_qtypes(op_inst), &s);
  result = mkeq_qtype(qtypelist_next(&s), arg1, loc) || result;
  if (arg2)
    result = mkeq_qtype(qtypelist_next(&s), arg2, loc) || result;
  else
    assert(!qtypelist_next(&s));

  return result;
}

/**************************************************************************
 *                                                                        *
 * Multi-file stuff                                                       *
 *                                                                        *
 * ``globals'' is a hash table mapping extern-scoped identifiers to their *
 * declarations.  If an identifier has an entry in globals, that ddecl    *
 * should not be used -- we would need to resolve all oldstyle and        *
 * otherwise mismatching function decls ahead of time if we wanted to do  *
 * that.                                                                  *
 *                                                                        *
 **************************************************************************/

/* Initialize a data declaration's qtype fields.  If ddecl was already
   declared in a prelude file, use the types from the prelude file.
   Otherwise verify that ddecl can be unified with what has already
   been declared.  Display an error if ddecl was already declared in
   another file but with a different type. */
void add_global_ddecl_qtype(data_declaration ddecl, bool generalize)
{
  data_declaration old_ddecl;
  location *loc;

  ddecl = root_ddecl(ddecl);
  loc = location_declaration(ddecl->ast);
  assert(ddecl->isexternalscope);

  if (ddecl->qtype)
    return;

  if (hash_table_lookup(globals, (hash_key) ddecl->name,
			(hash_data *) &old_ddecl))
    {
      /* If ddecl was previously declared in a prelude file, that
	 declaration completely overrides this one */
      if (old_ddecl->in_prelude && !ddecl->in_prelude)
	{
	  ddecl->qtype = old_ddecl->qtype;
	  return;
	}

      assert(old_ddecl->in_prelude || !ddecl->in_prelude);

      /* Otherwise, check whether the types match */
      if (match_type(ddecl->type, old_ddecl->type))
	/* They did -- just reuse old qtype */
	ddecl->qtype = old_ddecl->qtype;
      else
	{
	  /* The types differ in some way.  Create new qtypes for
	     ddecl and make sure they match the old declaration */
	  insist(add_ddecl_qtype(ddecl, generalize));

	  if (qtype_scheme(old_ddecl->qtype) || qtype_scheme(ddecl->qtype))
	    {
	      report_qerror(*loc, sev_warn,
			    "multiple polymorphic types for ``%s''"
			    " -- not checking for consistency", ddecl->name);
	    }
	  else if (unify_qtype(old_ddecl->qtype, ddecl->qtype, loc))
	    {
	      report_qerror(*loc, sev_err, "conflicting types for ``%s''",
			    ddecl->name);
	      report_qerror(old_ddecl->ast->loc, sev_inf,
			    "-- previous declaration of ``%s''", ddecl->name);
	    }
	}

      /* Check whether ddecl has been defined anywhere */
      /* Don't do this check -- too annoying
      if (old_ddecl->definition && ddecl->definition)
	report_qerror(loc, sev_warn,
		      "redefinition of extern ``%s''", ddecl->name);
      else */
      /* Tag old declaration as being defined.  Note that we don't
	 update the definition field with a valid pointer, since
	 in general we could have multiple definitions. */
      if (!old_ddecl->definition && ddecl->definition)
	old_ddecl->definition = (declaration) -1;

      /* Update isused flag */
      old_ddecl->isused = old_ddecl->isused || ddecl->isused;

      /* New declaration is shadowed by the old one. */
    }
  else
    {
      insist(add_ddecl_qtype(ddecl, generalize));
      if (ddecl->in_prelude && !ddecl->definition)
	ddecl->definition = (declaration) -1; /* See above */
      insist(hash_table_insert(globals, (hash_key) ddecl->name, ddecl));
    }
}

/* Mark that ddecl is used.  If ddecl is global, then the mark is also
   set in the corresponding ddecl in globals. */
void mark_used(data_declaration ddecl)
{
  data_declaration global_ddecl;

  ddecl = root_ddecl(ddecl);
  ddecl->isused = TRUE;
  if (ddecl->isexternalscope &&
      hash_table_lookup(globals, (hash_key) ddecl->name,
			(hash_data *) &global_ddecl))
    global_ddecl->isused = TRUE;
}

/* Here's an example of why we can't just pick one ddecl to stand for
   all of them:

   file1: void foo(void) { extern char lower(); }
   file2: char lower(char c) { return c; }

   If we analyze file1 before file2 and set lower's ddecl to be the
   oldstyle function, we'll get messed up at the definition.  On the
   other hand, if we change unify_qtype to merge extra parameters, we
   can't handle varargs oldstyle functions. */

/* 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);
    }
}
/* Return TRUE iff ddecl is used but undefined */
bool is_undefined_global(data_declaration ddecl)
{
  ddecl = root_ddecl(ddecl);
  assert(ddecl->isexternalscope);
  return (ddecl->isused && !ddecl->definition);
}

/* Return TRUE iff ddecl is declares a varargs function that was
   defined and used but not given a type in a prelude file */
bool is_unannotated_global(data_declaration ddecl)
{
  /* XXX: Also check isused flag here? */
  ddecl = root_ddecl(ddecl);
  assert(ddecl->isexternalscope);
  return (!is_undefined_global(ddecl) &&
	  ddecl->isused &&
	  qtype_function(ddecl->qtype) &&
	  qtype_varargs(ddecl->qtype) &&
	  !ddecl->in_prelude);
}

/* Display an error if ddecl is used but not defined, or if it's
   a varargs function not given a type in a prelude file */
void warn_if_dangerous_global(data_declaration ddecl, void *arg)
{
  if (is_undefined_global(ddecl))
    report_qerror(*location_declaration(ddecl->ast), sev_err,
		  "``%s'' used but not defined", ddecl->name);
  if (is_unannotated_global(ddecl))
    report_qerror(*location_declaration(ddecl->ast), sev_inf,
		  "vararg function ``%s'' does not have polymorphic type",
		  ddecl->name);
}

/**************************************************************************
 *                                                                        *
 * Tree Traversal                                                         *
 *                                                                        *
 * The code that walks over the AST and generates the constraint          *
 * graph, plus whatever info we'll need to do linking.  Think of this     *
 * as a big pattern-match.                                                *
 *                                                                        *
 **************************************************************************/

void analyze(declaration program)
{
  declaration d;

  unparse_start(stdout);
  pam_add_file(program->loc.filename);
  scan_declaration(d, program)
    analyze_declaration(d);
}

void analyze_declaration(declaration d)
{
  switch (d->kind)
    {
    case kind_asm_decl:
      /*	report_qerror(d->loc, sev_warn,
		"warning: ignoring in-line assembly code");*/
      return;
    case kind_data_decl:
      {
	data_decl dd = CAST(data_decl, d);
	declaration decl;

	scan_declaration(decl, dd->decls)
	  analyze_declaration(decl);

	if (!dd->decls && dd->modifiers && is_tag_ref(dd->modifiers))
	    /* Special case:  Declared a tagged type but didn't define any
	       variables. */
	  analyze_tag_decl(CAST(tag_ref, dd->modifiers)->tdecl);
	return;
      };
    case kind_variable_decl:
      {
	variable_decl vd = CAST(variable_decl, d);
	data_declaration root;

	if (vd->asm_stmt)
	  fail_loc(vd->loc,
		   "Unimplemented: asm in variable_decl\n", 0);

	root = root_ddecl(vd->ddecl);
	if (is_op_name(root->name))
	  {
	    analyze_operator_declaration(vd);
	    return;
	  }

	if (root->isexternalscope)
	  add_global_ddecl_qtype(root, TRUE);
	else
	  /* You can declare things many times, so this may return either
	     true or false. */
	  add_ddecl_qtype(root, TRUE);

	/* Analyze initializer, if any */
	if (vd->arg1)
	  {
	    qtype init_qt;
	    
	    if (qtype_array(root->qtype))
	      init_qt = root->qtype;
	    else
	      init_qt = points_to_qtype(root->qtype);

	    analyze_init(&vd->loc, init_qt, vd->arg1);
	  }

	/* Add PAM markup */
	if ((flag_pam_mode || flag_print_results) &&
	    root->kind != decl_typedef)
	  add_declarator_overlay(vd->declarator, root->qtype);

	return;
      }
      break;
    case kind_function_decl:
      {
	function_decl fd = CAST(function_decl, d), old_function_decl;
	data_declaration root;
	qtype ret_qtype;

	/*** Initialization ***/

	old_function_decl = cur_fun_decl;
	root = root_ddecl(fd->ddecl);

	if (root->isexternalscope)
	  add_global_ddecl_qtype(root, FALSE); /* Can't generalize defns */
	else
	  /* You can declare things many times, so this may return
           either true or false. */
	  add_ddecl_qtype(root, FALSE);

	if (qtype_scheme(root->qtype))
	  {
	    report_qerror(fd->loc, sev_warn,
			  "Ignoring definition of polymorphic function");
	    return;
	  }

	if (flag_pam_mode || flag_print_results)
	  add_declarator_overlay(fd->declarator, root->qtype);

	cur_fun_decl = fd;
	ret_qtype = return_qtype(root->qtype);

	/*** Scan argument list ***/

	{
	  declaration arg;
	  qtypelist_scanner old_qtypes;
	  int i;

	  i = 1;
	  qtypelist_scan(arg_qtypes(root->qtype), &old_qtypes);

	  if (!is_void_parms(fd->fdeclarator->parms))
	    scan_declaration(arg, fd->fdeclarator->parms)
	      /* Ignore ...'s */
	      if (!is_ellipsis_decl(arg))
		{
		  data_declaration root_vd;
		  variable_decl argvd;
		  oldidentifier_decl oid;
		  qtype old_qtype, arg_qt;
		  
		  /* Construct type of parameter */
		  if (arg->kind == kind_data_decl)
		    {
		      data_decl argd = CAST(data_decl, arg);

		      argvd = CAST(variable_decl, argd->decls);
		      assert(!argvd->next);    /* Only var_decl per data_decl.
						   multi var_decls are for
						   things like int a, b. */
		      oid = NULL;
		      root_vd = root_ddecl(argvd->ddecl);
		    }
		  else
		    {
		      oid = CAST(oldidentifier_decl, arg);
		      argvd = NULL;
		      root_vd = root_ddecl(oid->ddecl);
		    }

		  insist(add_ddecl_qtype(root_vd, TRUE));
		  assert(root_vd->qtype);
	
		  /* Match up parameter type with function type */
		  old_qtype = qtypelist_next(&old_qtypes);
		  arg_qt = points_to_qtype(root_vd->qtype);
		      
		  if ((old_qtype || arg->kind == kind_data_decl) &&
		      (unify_qtype(old_qtype, arg_qt, &arg->loc)))
		    report_qerror(arg->loc, sev_err,
				  "type of parameter %d doesn't match "
				  "previous uses",
				  i);

		  /* NOTE:  No checking done for oldstyle identifiers!
		     This matches gcc's beavhior. */

		  if (flag_pam_mode || flag_print_results)
		    {
		      if (arg->kind == kind_data_decl)
			add_declarator_overlay(argvd->declarator,
					       root_vd->qtype);
		      else
			pam_add_overlay_file(oid->loc,
					     oid->cstring.data,
					     root_vd->qtype);
		    }
		  
		  i++;
		}
	  assert(!old_qtypes);
	}

	/*** Evaluate body ***/

	assert(is_compound_stmt(fd->stmt));
	analyze_statement(fd->stmt);
	cur_fun_decl = old_function_decl;
	return;
      };
    case kind_extension_decl:
      {
	extension_decl ed = CAST(extension_decl, d);
	return analyze_declaration(ed->decl); /* Ignore __extnesion__ */
      };
    default:
      fail_loc(d->loc,
	       "Unexpected decl kind 0x%x\n", d->kind);
    }
}

void analyze_operator_declaration(variable_decl vd)
{
  data_declaration root;
  operator op;

  root = root_ddecl(vd->ddecl);
  assert(is_op_name(root->name));
  if (!root->isexternalscope)
    {
      report_qerror(vd->loc, sev_err,
		    "Operator not declared at top level");
      return;
    }

  add_global_ddecl_qtype(root, TRUE);

  op = find_op_name(root->name);
  if (op && op->qt)
    report_qerror(vd->loc, sev_err,
		  "redefinition of operator signature");
  else if (op)
    {
      /* It's an operator definition */
      if (add_op_signature(op, root->qtype, &vd->loc))
	report_qerror(vd->loc, sev_err,
		      "definition of operator with incorrect signature");
      
      /* Reset qtype to fully constrained qtype */
      root->qtype = op->qt;      
    }
  else
    report_qerror(vd->loc, sev_err,
		  "definition of non-existent operator signature");
  
  /* Add PAM markup */
  if ((flag_pam_mode || flag_print_results) &&
      root->kind != decl_typedef)
    add_declarator_overlay(vd->declarator, root->qtype);
}

/* Analyze a field declaration */
qtype analyze_field_declaration(const char *name, field_declaration fd)
{
  qtype result;

  result = get_fdecl_qtype(name, fd);
  if ((flag_pam_mode || flag_print_results) && fd->name)
    /* fields can be anonymous */
    add_declarator_overlay(fd->ast->declarator, result);
  return result;
}

/* Analyze a tag declaration. */
void analyze_tag_decl(tag_declaration tdecl)
{
  if (tdecl->kind == kind_struct_ref || tdecl->kind == kind_union_ref)
    /* XXX: Enable this if you want all structure fields to get types,
       no matter if they're actually used or not.
       type_to_qtype(make_tagged_type(tdecl), NULL, NULL); */
    ;
  else
    {
      tag_ref tr;
      declaration d;

      tr = tdecl->ast;
      scan_declaration(d, tr->fields)
	{
	  enumerator e = CAST(enumerator, d);
	  
	  if (add_ddecl_qtype(root_ddecl(e->ddecl), FALSE) &&
	      (flag_pam_mode || flag_print_results))
	    pam_add_overlay_file(e->loc,
				 e->cstring.data,
				 root_ddecl(e->ddecl)->qtype);
	}
    }
}

/* XXX Init */
/* Analyze the initialization of lhs_qtype and lhs_dqtype (r-types)
   with rhs, in initial store in. */
void analyze_init(location *loc, qtype lhs_qtype, expression rhs)
{
  if (rhs->kind == kind_string && (qtype_string(lhs_qtype)))
    {
      /* Special case for strings.  The rhs is a char ptr, but the
	 quals should flow into the array quals, anyhow. */

      qtype arg1;
      assert(qtype_string(lhs_qtype));
      /* assert(!rhs->next); not always true -- init arrays of strings */
      arg1 = analyze_expression(rhs, rpos);
      /* Hack:  rhs is a string, so no side effects. */
      if (init_string(lhs_qtype, arg1, &rhs->loc))
	report_qerror(rhs->loc, sev_err, "incompatible initializer");
      return;
    }

  if (rhs->kind == kind_init_list && (qtype_array(lhs_qtype)))
    {
      /* Initialize the array contents qtype with each rhs */
      init_list il = CAST(init_list, rhs);
      qtype lhs_contents_qtype;
      expression e;

      assert(qtype_array(lhs_qtype));

      lhs_contents_qtype = array_of_qtype(lhs_qtype);
      scan_expression(e, il->args)
	if (e->kind == kind_init_index)
	  {
	    /* Handle this case here -- only arrays can be initialized
	       this way. */
	    init_index ii = CAST(init_index, e);
	    qtype arg1, arg2;

	    arg1 = analyze_expression(ii->arg1, rpos);
	    if (ii->arg2)
	      arg2 = analyze_expression(ii->arg2, rpos);
	    analyze_init(loc, lhs_contents_qtype, ii->init_expr);
	  }
	else
	  analyze_init(loc, lhs_contents_qtype, e);
      return;
     }

   if (rhs->kind == kind_init_list && (qtype_struct(lhs_qtype)))
     {
       /* Initialize each of the field qtypes with each rhs */
       init_list il = CAST(init_list, rhs);
       field_scanner fs;
       qtype fqt;
       expression e;

       fqt = NULL;
       field_scan(lhs_qtype, &fs);

       scan_expression(e, il->args)
	 {
	   expression init_expr;
	   
	   if (e->kind == kind_init_field)
	     {
	       /* Handle specific field initialization here -- only
		  structures/unions can be initialized this way.
		  Adding a label changes where we start initializing
		  the struct/union. */
	       init_field ifd = CAST(init_field, e);
	       field_scan_at(lhs_qtype, ifd->word1->cstring, &fs);
	       if (!fs)
		 {
		   report_qerror(*loc, sev_err,
			      "unknown field `%s' in aggregate initialization",
				 ifd->word1->cstring);
		   break;
		 }
	       init_expr = ifd->init_expr;
	     }
	   else
	     init_expr = e;

	   fqt = field_next(&fs);
	   if (!fqt)
	     {
	       report_qerror(*loc, sev_err,
			  "aggregate initailized with wrong number of fields");
	       break;
	     }

	   /* Unless we're initializing an array, get the contents of the
	      ref.  Note we can't be initializing a function -- not C++. */
	   if (!qtype_array(fqt))
	     fqt = points_to_qtype(fqt);
	   
	   analyze_init(loc, fqt, init_expr);
	 }
      /* OK to initialize aggregate with too few fields
	 err = (field_next(&fs) || err); */
       return;
     }

  /* Default case.  Note we don't do a substitute_store, because variables
     can't be used before they're initialized. */
   {
     qtype arg1;

     arg1 = analyze_expression(rhs, rpos);

     if (mkleq_assign_convert(arg1, lhs_qtype, loc))
       report_qerror(*loc, sev_err,
		     "incompatible right-hand side in initialization");
     return;
   }
}

static bool init_string(qtype lhs_qtype, qtype rhs_qtype, location *loc)
{
  bool result = FALSE;
  qtype lhs_contents_qtype, rhs_contents_qtype;

  lhs_contents_qtype = array_of_qtype(lhs_qtype);
  rhs_contents_qtype = points_to_qtype(rhs_qtype);
  result = mkleq_qual(qual_qtype(rhs_contents_qtype),
		      qual_qtype(lhs_contents_qtype),
		      loc) || result;
  result = mkleq_qual(qual_qtype(rhs_qtype),
		      qual_qtype(lhs_qtype),
		      loc) || result;
  return result;

}

void analyze_statement(statement s)
{
  switch (s->kind)
    {
    case kind_asm_stmt:
      /*      report_qerror(s->loc, sev_warn,
	      "warning: ignoring in-line assembly code");*/
      break;
    case kind_compound_stmt:
      {
	compound_stmt cs = CAST(compound_stmt, s);
	declaration decl;
	statement stmt;

	/* Analyze the declarations. */
	scan_declaration(decl, cs->decls)
	  {
	    assert(decl->kind != kind_asm_decl); /*asm_decl only at toplevel */
	    analyze_declaration(decl);
	  }

	/* Analyze the body, gathering up the effects. */
	scan_statement(stmt, cs->stmts)
	  analyze_statement(stmt);
      };
      break;
    case kind_if_stmt:
      {
	if_stmt is = CAST(if_stmt, s);

	analyze_expression(is->condition, rpos);
	analyze_statement(is->stmt1);

	if (is->stmt2)
	  analyze_statement(is->stmt2);
      };
      break;
    case kind_labeled_stmt:
      {
	labeled_stmt ls = CAST(labeled_stmt, s);

	analyze_statement(ls->stmt);
      };
      break;
    case kind_expression_stmt:
      {
	expression_stmt es = CAST(expression_stmt, s);

	analyze_expression(es->arg1, rpos);
      };
      break;
    case kind_while_stmt:
      {
	while_stmt ws = CAST(while_stmt, s);

	analyze_expression(ws->condition, rpos);
	analyze_statement(ws->stmt);
      };
      break;
    case kind_dowhile_stmt:
      {
	dowhile_stmt dws = CAST(dowhile_stmt, s);

	analyze_statement(dws->stmt);
	analyze_expression(dws->condition, rpos);
      };
      break;
    case kind_switch_stmt:
      {
	switch_stmt ss = CAST(switch_stmt, s);

	analyze_expression(ss->condition, rpos);
	analyze_statement(ss->stmt);
      };
      break;
    case kind_for_stmt:
      {
	for_stmt fs = CAST(for_stmt, s);

	if (fs->arg1)
	  analyze_expression(fs->arg1, rpos);

	if (fs->arg2)
	  analyze_expression(fs->arg2, rpos);

	analyze_statement(fs->stmt);

	if (fs->arg3)
	  analyze_expression(fs->arg3, rpos);
      };
      break;
    case kind_return_stmt:
      {
	return_stmt rs = CAST(return_stmt, s);
	qtype ret_qtype;

	ret_qtype = cur_return_qtype();

	if (rs->arg1)
	  {
	    qtype arg1;

	    arg1 = analyze_expression(rs->arg1, rpos);
	    /* ret_qtype is an r-type, so no deref */
	    if (mkleq_assign_convert(arg1, ret_qtype, &rs->loc))
	      report_qerror(rs->loc, sev_err,
			    "return type incompatible with function type");
	  }
	/* Don't raise an error here -- will already be flagged by
	   parser if warn_return_type is enabled
	else
	  {
	    if (warn_return_type && !qtype_void(ret_qtype))
	      report_qerror(rs->loc, sev_err,
		    "`return' with no value, in function returning non-void");
	  }
	*/
      };
      break;
    case kind_computed_goto_stmt:
      {
	computed_goto_stmt cgs = CAST(computed_goto_stmt, s);
	analyze_expression(cgs->arg1, rpos);
      };
      break;
    case kind_break_stmt:
    case kind_continue_stmt:
    case kind_goto_stmt:
    case kind_empty_stmt:
      break;
    default:
      fail_loc(s->loc, "Unexpected statement kind 0x%x\n", s->kind);
      break;
    }
}


qtype analyze_expression(expression e, context context)
{
  /*  printf("Analyzing ");
      prt_expression(e, 0);
      printf(" in %s\n", context_tostring(context));*/

  switch(e->kind) {
  case kind_comma:
    {
      comma c = CAST(comma, e);
      expression e2;
      qtype result;

      result = NULL;
      scan_expression (e2, c->arg1)
	result = analyze_expression(e2, e2->next ? rpos : context);
      if (!result)
	fail_loc(c->loc, "Empty comma expression\n", 0);
      return result;
    };
    break;
  case kind_sizeof_type:
    {
      assert(context == rpos);
      return mkqtype_size_t(make_qvar("sizeof_type", &e->loc, FALSE));
    }
    break;
  case kind_alignof_type:
    {
      assert(context == rpos);
      return mkqtype_size_t(make_qvar("alignof_type", &e->loc, FALSE));
    }
    break;
  case kind_label_address:
    {
      assert(context == rpos);
      return mkqtype_pointer(make_qvar("&&", &e->loc, FALSE),
			     mkqtype_void(make_qvar("&&_p", &e->loc,FALSE)));
    }
    break;
  case kind_cast:
    {
      cast c = CAST(cast, e);
      qtype arg1;
      type cast_t;
      qtype result;

      arg1 = analyze_expression(c->arg1, context);
      cast_t = c->asttype->type;
      if (context == lpos || context == apos)
	{
	  type pt;

	  assert(!type_function(cast_t));
	  assert(!type_array(cast_t));

	  pt = make_pointer_type(cast_t);
	  result = type_to_qtype(pt, "cast", &c->loc);
	}
      else
	result = type_to_qtype(cast_t, "cast", &c->loc);

      if (flag_casts_preserve &&
	  !type_void(cast_t) && /* cast to void is special -- it means,
				   ``ignore this result'' */
	  !type_contains_user_quals(cast_t))
	/* If cast_t doesn't have explicit user-defined qualifiers, */
	if (mkeq_qtype_cast(result, arg1, &c->loc))
	  report_qerror(c->loc, sev_err,
			"Incompatible qualifiers at cast");
      return result;
    };
    break;
  case kind_cast_list:
    {
      /* XXX Fix! */
      cast_list cl = CAST(cast_list, e);
      qtype qt;

      assert(context == rpos);
      qt = type_to_qtype(cl->type, "castlist", &cl->loc);
      analyze_init(&cl->loc, qt, cl->init_expr);

      return default_conversion_qtype(qt);
    };
    break;
  case kind_conditional:
    {
      conditional c = CAST(conditional, e);
      qtype cond, arg1, arg2, qt;

      cond = analyze_expression(c->condition, rpos);
      if (c->arg1)
	arg1 = analyze_expression(c->arg1, context);
      else
	/* gcc extension:  if you omit the middle op, evaluates to
	   guard when guard is true, and guard is not reevaluated */
	arg1 = cond;
      arg2 = analyze_expression(c->arg2, context);
      if (lub_assign_convert(arg1, arg2, &qt, &c->loc))
	report_qerror(c->loc, sev_err,
		      "incompatible branches of conditional");
      return qt;
    };
    break;
  case kind_identifier:
    {
      identifier id = CAST(identifier, e);
      data_declaration root;
      qtype qt;

      root = root_ddecl(id->ddecl);
      if (is_op_name(root->name))
	report_qerror(id->loc, sev_err,
		      "use of built-in operator name");
      mark_used(root); /* We need this because we're marking the *root* */

      qt = root->qtype;

      if (!qt)
	{
	  /* Only functions can be implicitly declared.  But there are also
	     some special gcc identifiers, notably __FUNCTION__ and
	     __PRETTY_FUNCTION__, that also don't need to be declared. */
	  if ((type_function(id->ddecl->type) &&
	       id->ddecl->ftype == function_implicit) ||
	      !strcmp(id->ddecl->name, "__FUNCTION__") ||
	      !strcmp(id->ddecl->name, "__PRETTY_FUNCTION__") ||
	      !strcmp(id->ddecl->name, "=va_arg"))
	    {
	      if (root->isexternalscope)
		add_global_ddecl_qtype(root, FALSE);
	      else
		add_ddecl_qtype(root, FALSE);
	      qt = root->qtype;
	    }
	  else
	    fail_loc(id->loc, "Use before declaration\n", 0);
	}

      if (qtype_scheme(qt))
	qt = instantiate_qtype(qt, &id->loc);
      if (flag_pam_mode || flag_print_results)
	pam_add_overlay_file(id->loc, root->name, qt);
      if (root->kind == decl_constant)
	{
	  /* Constants are always rtypes */
	  if (context != rpos)
	    {
	      /* The front end should catch this */
	      report_qerror(id->loc, sev_err, "invalid lvalue");
	      /*qt = mkqtype_pointer(make_qvar("__err", id->loc, FALSE),
		qt);*/
	      qt = error_qtype;
	    }
	  return qt;
	}
      else
	return put_id_in_context(qt, context, &id->loc);
    };
    break;
  case kind_compound_expr:
    {
      compound_expr ce = CAST(compound_expr, e);
      compound_stmt cs = CAST(compound_stmt, ce->stmt);
      statement cur_stmt;
      declaration d;
      qtype qt;

      if (cs->id_labels)
	fail_loc(cs->loc, "Unimplemented: id_labels\n", 0);

      /* Analyze the declarations in the block */
      scan_declaration(d, cs->decls)
	{
	  assert(d->kind != kind_asm_decl); /*asm_decl only at toplevel */
	  analyze_declaration(d);
	}
      /* Analyze the statements in the block.  Analyze all but the
         last one. */
      cur_stmt = cs->stmts;
      while (cur_stmt && cur_stmt->next)
	{
	  analyze_statement(cur_stmt);
	  cur_stmt = CAST(statement, cur_stmt->next);
	}

      /* Now analyze the last statement (if there is one), and
         compute the type of the expression. */
      if (cur_stmt && is_expression_stmt(cur_stmt))
	qt = analyze_expression(CAST(expression_stmt, cur_stmt)->arg1,context);
      else
	{
	  /* Type is void */
	  qt = mkqtype_void(make_qvar("compound", &ce->loc, FALSE));
	  if (cur_stmt)
	    analyze_statement(cur_stmt);
	}

      return qt;
    };
    break;
  case kind_function_call:
    {
      function_call fc = CAST(function_call, e);
      qtype fqt;
      qtypelist args;
      expression arg;
      qtypelist_scanner args_qs;
      int i;

      /* Extract the function type of the expr in fun posn.  Note
         that arg1 must be a pointer to a function.  From C9X:

	 [#1]  The  expression  that  denotes  the called function
	 shall have  type  pointer  to  function  returning  void  or
	 returning an object type other than an array type. */

      assert(context == rpos);
      if (fc->va_arg_call)
	/* Magic call to __builtin_va_arg(args, fc->va_arg_call) */
	return type_to_qtype(fc->va_arg_call->type, "_va_arg", &fc->loc);

      fqt = analyze_expression(fc->arg1, rpos);
      fqt = points_to_qtype(fqt);
      args = arg_qtypes(fqt);

      /* Analyze each argument, making a constrant with the
	 corresponding formal paramter */
      qtypelist_scan(args, &args_qs);
      i = 1;
      scan_expression(arg, fc->args)
	{
	  qtype arg_qt;
	  qtype formal_qt;

	  arg_qt = analyze_expression(arg, rpos);
	  formal_qt = qtypelist_next(&args_qs);

	  if (!formal_qt)
	    {
	      if (!formal_qt &&  !qtype_varargs(fqt) && !qtype_oldstyle(fqt))
		report_qerror(arg->loc, sev_err,
			      "too many actual arguments for function "
			      "call.\n");

	      /* If func is varargs, then only add constraints if func
	         has a varargs qualifier. */
	      if (qtype_varargs(fqt) && vqual_qtype(fqt))
		{
		  qual vq;

		  vq = vqual_qtype(fqt);
		  if (varargs_constrain_quals_qtype(arg_qt, vq,
						    &arg->loc))
		    report_qerror(arg->loc, sev_err,
				  "type of actual argument %d doesn't match "
				  "varargs qualifier", i);
		}
	    }
	  else
	    if (mkleq_assign_convert(arg_qt, formal_qt, &arg->loc))
	      report_qerror(arg->loc, sev_err,
			    "type of actual argument %d doesn't match "
			    "type of formal", i);
	  i++;
	}
      if (qtypelist_next(&args_qs))
	fail_loc(e->loc, "Not enough actual arguments.\n", 0);

      return return_qtype(fqt);
    };
    break;
  case kind_array_ref:
    {
      array_ref ar = CAST(array_ref, e);
      expression array, plus, star_plus;

      if (type_array(ar->arg1->type))
	array = ar->arg1;
      else
	array = ar->arg2;

      array->lvalue = TRUE; /* XXX: Hack to fix problem
				  w/default_conversion */
      array->cst = NULL; /* XXX: Hack to fix problem w/default_conversion */

      plus = make_binary(ar->loc, kind_plus, ar->arg1, ar->arg2);
      star_plus = make_dereference(ar->loc, plus);

      return analyze_expression(star_plus, context);
    };
    break;
  case kind_field_ref:
    {
      /* We unify the qualifiers on the structure and the qualifiers
	 on the field.  For now.  See previous versions for other
	 approaches. */
      field_ref fr = CAST(field_ref, e);
      qtype arg1;
      qtype field_qt;

      arg1 = analyze_expression(fr->arg1, context);

      /*** Compute field qtypes ***/

      {
	qtype ag_qt;

	if (context == lpos || context == apos)
	  ag_qt = points_to_qtype(arg1);
	else
	  ag_qt = arg1;
	assert(qtype_aggregate(ag_qt));
	field_qt = field_qtype(ag_qt, fr->cstring);
      }

      pam_add_overlay_file(fr->cstring_loc, fr->cstring.data, field_qt);

      /* unify the qualifiers on the field contents and the structure value */
      /*
      if (mkeq_qual(qual_qtype(field_rqt), qual_qtype(ag_qt)))
	report_qerror(e->loc,
		      "Qualifiers on field ``%s'' incomptabile with "
		      "access path qualifiers (in r-pos)", fr->cstring);
      */
	  /*
	    if (context == lpos)
	    {
	    if (mkeq_qual(qual_qtype(qt), qual_qtype(field_qt)))
	    report_qerror(e->loc,
		      "Qualifiers on field ``%s'' incomptabile with "
		      "access path qualifiers (in l-pos)", fr->cstring);
	  */
      return  put_id_in_context(field_qt, context, &fr->loc);
    };
    break;
  case kind_init_list:
    {
      /*    init_list il = CAST(init_list, e);*/
      fail_loc(e->loc, "Unexpected init list\n", 0);
    };
    break;
  case kind_init_index:
    {
      /*    init_index ii = CAST(init_index, e);*/
      fail_loc(e->loc, "Unexpected init index\n", 0);
    };
    break;
  case kind_init_field:
    {
      fail_loc(e->loc, "Unexpected init field\n", 0);
    };
  case kind_known_cst:
    {
      /* Should check size */
      /*    signed_cst sc = CAST(signed_cst, e);*/

      assert(context == rpos);
      return type_to_qtype(e->type, "__cst", &e->loc);
    };
    break;
  case kind_lexical_cst:
    {
      lexical_cst lc = CAST(lexical_cst, e);

      assert(context == rpos);

      return type_to_qtype(lc->type, "__cst", &lc->loc);
    };
    break;
  case kind_string:
    {
      /* A list of strings, representing their concatenation. */
      /*
      string se = CAST(string, e);
      constant s;
      int len = 0;
      char *str;

      scan_constant(s, se->strings)
	{
	  len += CAST(lexical_cst, s)->cstring.length;
	}
      str = rarrayalloc(qtype_region, len+1, char);
      str[0] = '\0';
      scan_constant(s, se->strings)
	{
	  strcat(str, CAST(lexical_cst, s)->cstring.data);
	}
      return mkqtype_string(str);
      */
      /* Could use string name */

      assert(context == rpos);
      return mkqtype_pointer(make_qvar("__string", &e->loc, FALSE),
			     mkqtype_char(make_qvar("__string_p",
						    &e->loc,
						    FALSE)));
    };
    break;
  default:
    if (is_unary(e))
      return analyze_unary_expression(CAST(unary, e), context);
    else if (is_binary(e))
      return analyze_binary_expression(CAST(binary, e), context);
    else
      fail_loc(e->loc, "Unexpected expr kind 0x%x\n", e->kind);
  }
}

qtype analyze_unary_expression(unary e, context context)
{
  operator op;

  op = find_op_kind(e->kind);  /* Look up the signature of this operator */

  switch (e->kind)
    {
    case kind_dereference:
      {
	/* Analyze the subexpression in an r-context; this will return
	   an l-type, so either return that if we're in an l-context or
	   deref it if we're in an r-context.  Function are special --
	   *f is allowed even if f is a function and not a function
	   pointer type. */
	qtype arg1, result;

	arg1 = analyze_expression(e->arg1, rpos);
	assert(qtype_pointer(arg1));
	if (context == lpos || context == apos)
	  {
	    /* *e in an l-context silently converts a (pointer) r-type
	       to an l-type */
	    assert(qtype_pointer(arg1));
	    result = arg1;
	  }
	else if (context == rpos)
	  {
	    if (qtype_function(arg1))
	      /*return arg1_qtype;*/
	      fail_loc(e->loc, "Unexpected function in rpos", 0);
	    else
	      result = default_conversion_qtype(points_to_qtype(arg1));
	  }
	else
	  fail_loc(e->loc, "Unexpected context %d\n", context);

	if (op)
	  {
	    qtype result_rpos;

	    if (context == rpos)
	      result_rpos = result;
	    else
	      result_rpos = default_conversion_qtype(points_to_qtype(arg1));

	    if (add_op_constraints(op, result_rpos, arg1, NULL, &e->loc))
	      report_qerror(e->loc, sev_err,
			    "Operands incompatible with operator definition");

	  }

	return result;
      }
      break;
    case kind_address_of:
      {
	/* &e can only appear in an r-context.  We analyze the
	   subexpression in an l-context (thus the subexpression type
	   with have a ptr at the outside) and silently convert the
	   l-type to an r-type.  On the other hand, taking the address
	   of a function type is a no-op. */
	assert(context == rpos);
	if (type_function(e->arg1->type))
	  return analyze_expression(e->arg1, context);
	else
	  return analyze_expression(e->arg1, apos);
      }
      break;
    case kind_extension_expr:
      {
	return analyze_expression(e->arg1, context);
      }
      break;
    case kind_sizeof_expr:
      {
	assert(context == rpos);
	/*analyze_expression(e->arg1, rpos); (arg1 not evaluated) */
	return mkqtype_size_t(make_qvar("sizeof", &e->loc, FALSE));
      }
      break;
    case kind_alignof_expr:
      {

	assert(context == rpos);
	/*analyze_expression(e->arg1, rpos); (arg1 not evaluated) */
	return mkqtype_size_t(make_qvar("alignof", &e->loc, FALSE));
      }
      break;
    case kind_realpart:
    case kind_imagpart:
      {
	qtype arg1;

	assert(context == rpos);
	arg1 = analyze_expression(e->arg1, rpos);
	assert(qtype_complex(arg1));
	return complex_base_qtype(arg1);
      }
      break;
    case kind_unary_minus:
    case kind_unary_plus:
    case kind_conjugate:
    case kind_bitnot:
      {
	/* These operations don't change types.  Note we assume
	   that compatibility with these ops has already been
	   tested. */
	assert(context == rpos);
	return analyze_expression(e->arg1, rpos);
      }
      break;
    case kind_not:
      {
	assert(context == rpos);
	analyze_expression(e->arg1, rpos);
	return mkqtype_bool(make_qvar("!", &e->loc, FALSE));
      }
      break;
    case kind_preincrement:
    case kind_postincrement:
    case kind_predecrement:
    case kind_postdecrement:
      {
	qtype arg1;

	assert(context == rpos);
	arg1 = analyze_expression(e->arg1, lpos);
	qtype_mklhs_nonconst(&e->loc, arg1);
	return points_to_qtype(arg1);
      }
      break;
    default:
      fail_loc(e->loc, "Unexpected unary op kind 0x%x\n", e->kind);
    }
}

/* Return TRUE iff e is a form of assignment */
bool isassignment(binary e)
{
  return (e->kind == kind_plus_assign ||
	  e->kind == kind_minus_assign ||
	  e->kind == kind_modulo_assign ||
	  e->kind == kind_lshift_assign ||
	  e->kind == kind_rshift_assign ||
	  e->kind == kind_times_assign ||
	  e->kind == kind_divide_assign ||
	  e->kind == kind_bitand_assign ||
	  e->kind == kind_bitor_assign ||
	  e->kind == kind_bitxor_assign ||
	  e->kind == kind_assign);
}

qtype analyze_binary_expression(binary e, context context)
{
  qtype arg1, arg2;
  operator op;

  assert(context == rpos);
  op = find_op_kind(e->kind);  /* Look up the signature of this operator */
  if (isassignment(e))
    arg1 = analyze_expression(e->arg1, lpos);
  else
    arg1 = analyze_expression(e->arg1, rpos);
  arg2 = analyze_expression(e->arg2, rpos);

  switch (e->kind)
    {
    case kind_plus:
      {
	if (qtype_pointer(arg1) && qtype_pointer(arg2))
	  fail_loc(e->loc, "Unexpected pointer addition\n", 0);

	if (qtype_pointer(arg1) && !qtype_pointer(arg2))
	  return arg1;
	else if (!qtype_pointer(arg1) && qtype_pointer(arg2))
	  return arg2;
	else
	  {
	    /* No lub here -- when would lub ever make sense? */
	    if (mkeq_qtype(arg1, arg2, &e->loc))
	      report_qerror(e->loc, sev_err,
			    "incompatible operands of ``%s''",
			    binary_op_name(e->kind));
	    return arg1;
	  }
      }
      break;
    case kind_minus:
      {
	if (qtype_pointer(arg1) && qtype_pointer(arg2))
	  return mkqtype_ptrdiff_t(make_qvar("__ptr diff", &e->loc, FALSE));
	else if (qtype_pointer(arg1) && !qtype_pointer(arg2))
	  return arg1;
	else if (!qtype_pointer(arg1) && qtype_pointer(arg2))
	  return arg2;
	else
	  {
	    /* No lub here -- when would lub ever make sense? */
	    if (mkeq_qtype(arg1, arg2, &e->loc))
	      report_qerror(e->loc, sev_err,
			    "incompatible operands of ``%s''",
			    binary_op_name(e->kind));
	    return arg1;
	  }
      }
      break;
    case kind_modulo:
    case kind_lshift:
    case kind_rshift:
      {
	return arg1;
      }
    case kind_modulo_assign:
    case kind_lshift_assign:
    case kind_rshift_assign:
      {
	qtype_mklhs_nonconst(&e->loc, arg1);
	return points_to_qtype(arg1);
      }
    case kind_times:
    case kind_divide:
    case kind_bitand:
    case kind_bitor:
    case kind_bitxor:
      {
	/* Got rid of lub -- when would lub make sense? */
	if (mkeq_qtype(arg1, arg2, &e->loc))
	  report_qerror(e->loc, sev_err,
			"incompatible operands of ``%s''",
			binary_op_name(e->kind));
	return arg1;
      }
      break;
    case kind_leq:
    case kind_geq:
    case kind_lt:
    case kind_gt:
    case kind_eq:
    case kind_ne:
    case kind_andand:
    case kind_oror:
      {
	qtype qt;

	qt = mkqtype_bool(make_qvar("__boolop", &e->loc, FALSE));
	if (op && add_op_constraints(op, qt, arg1, arg2, &e->loc))
	  report_qerror(e->loc, sev_err,
			"Operands incompatible with operator definition");
	return qt;
      }
    case kind_plus_assign:
    case kind_minus_assign:
      if ((qtype_pointer(arg1) && qtype_pointer(arg2)))
	fail_loc(e->loc, "Unexpected pointer addition\n", 0);

      if (qtype_pointer(arg1) && !qtype_pointer(arg2))
	{
	  qtype_mklhs_nonconst(&e->loc, arg1);
	  return points_to_qtype(arg1);
	}
      /* else fall through to next case */
    case kind_times_assign:
    case kind_divide_assign:
    case kind_bitand_assign:
    case kind_bitor_assign:
    case kind_bitxor_assign:
    case kind_assign:
      {
	qtype_mklhs_nonconst(&e->loc, arg1);
	if (mkleq_assign_convert(arg2, points_to_qtype(arg1), &e->loc))
	  report_qerror(e->loc, sev_err,
			"incompatible types in assignment");

	return points_to_qtype(arg1);
      }
    default:
      fail_loc(e->loc, "Unexpected binary op kind 0x%x\n", e->kind);
    }
}

/* Given the type of an identifier, convert it to the right type in
   the current context. */
qtype put_id_in_context(qtype qt, context c, location *loc)
{
  if (qtype_array(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)
      return default_conversion_qtype(qt);
    else if (c == apos)
      return mkqtype_pointer(make_fresh_qvar(loc), qt);
    else
      fail("Unexpected context %d\n", c);
  }
  else if (qtype_function(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! */
    return default_conversion_qtype(qt);
  }
  else if (c == lpos || c == apos)
    return qt;
  else if (c == rpos)
    {
      if (qtype_pointer(qt))
	return points_to_qtype(qt);
      else
	fail("Unexpected qtype\n");

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

/* rhs_qtype and lhs_qtype are rtypes.  Return in new_rhs_qtype and
   new_lhs_qtype qtypes so that lhs and rhs are assignment compatible.
   The conversions performed include:

   * If either lhs or rhs is a void * and the other is any pointer qtype,
     convert the other to a void *.

   * If either lhs or rhs is an integer and the other is any pointer
     qtype, convert the other to an integer.  (This is for conversion
     from pointer to integer, esp. 0.)

   Note that we do not allow nested conversions.  (E.g., char ** is
   not compatible with void **.)

   We don't worry about converting primitive types, because we don't
   check for that class of errors.

   Returns TRUE iff a conversion error occurs, which can only happen
   if flag_casts_preserve is TRUE.
*/
static bool assign_convert(location *loc,
			   qtype rhs_qtype,
			   qtype lhs_qtype,
			   qtype *new_rhs_qtype,
			   qtype *new_lhs_qtype)
{
  if (qtype_void_pointer(lhs_qtype) &&
      !qtype_void_pointer(rhs_qtype) &&
      qtype_pointer(rhs_qtype))
    {
      *new_lhs_qtype = lhs_qtype;
      *new_rhs_qtype = pointer_to_void_pointer_qtype(rhs_qtype);
      return (flag_casts_preserve &&
	      mkeq_qtype_cast(rhs_qtype, *new_rhs_qtype, loc));
    }


  if (!qtype_void_pointer(lhs_qtype) &&
      qtype_pointer(lhs_qtype) &&
      qtype_void_pointer(rhs_qtype))
    {
      *new_lhs_qtype = pointer_to_void_pointer_qtype(lhs_qtype);
      *new_rhs_qtype = rhs_qtype;
      return (flag_casts_preserve &&
	      mkeq_qtype_cast(lhs_qtype, *new_lhs_qtype, loc));
    }

  if (qtype_pointer(lhs_qtype) && qtype_integral(rhs_qtype))
    {
      *new_lhs_qtype = pointer_to_unsigned_int_qtype(lhs_qtype);
      *new_rhs_qtype = rhs_qtype;
      return (flag_casts_preserve &&
	      mkeq_qtype_cast(lhs_qtype, *new_lhs_qtype, loc));
    }

  if (qtype_integral(lhs_qtype) && qtype_pointer(rhs_qtype))
    {
      *new_lhs_qtype = lhs_qtype;
      *new_rhs_qtype = pointer_to_unsigned_int_qtype(rhs_qtype);
      return (flag_casts_preserve &&
	      mkeq_qtype_cast(rhs_qtype, *new_rhs_qtype, loc));
    }

  if (qtype_transparent(lhs_qtype) &&
      !match_qtype(lhs_qtype, rhs_qtype, NULL, NULL))
    {
      field_scanner fields;
      qtype field_qtype;
      qtype candidate, marginal_candidate;

      /* Looks like we're assigning into a transparent union. */
      candidate = NULL;
      marginal_candidate = NULL;
      field_scan(lhs_qtype, &fields);
      while ((field_qtype = field_next(&fields)))
	{
	  qtype field_rqtype;

	  if (qtype_array(field_qtype) || qtype_function(field_qtype))
	    field_rqtype = field_qtype;
	  else
	    field_rqtype = points_to_qtype(field_qtype);

	  if (match_qtype(field_rqtype, rhs_qtype, NULL, NULL))
	    {
	      candidate = field_rqtype;
	      break;
	    }

	  if ((qtype_void_pointer(field_rqtype) && qtype_pointer(rhs_qtype)) ||
	      (qtype_pointer(field_rqtype) && qtype_void_pointer(rhs_qtype)) ||
	      (qtype_pointer(field_rqtype) && qtype_integral(rhs_qtype)) ||
	      (qtype_integral(field_rqtype) && qtype_pointer(rhs_qtype)))
	    marginal_candidate = field_rqtype;
	}
      if (!candidate && marginal_candidate)
	return assign_convert(loc, rhs_qtype, marginal_candidate,
			      new_rhs_qtype, new_lhs_qtype);
      else if (candidate)
	{
	  *new_lhs_qtype = candidate;
	  *new_rhs_qtype = rhs_qtype;
	  return FALSE;
	}
    }

  /* Default case */
  *new_lhs_qtype = lhs_qtype;
  *new_rhs_qtype = rhs_qtype;
  return FALSE;
}

bool mkleq_assign_convert(qtype rhs_qtype, qtype lhs_qtype, location *loc)
{
  bool result;

  result = FALSE;
  result = assign_convert(loc, rhs_qtype, lhs_qtype, &rhs_qtype, &lhs_qtype)
    || result;
  result = mkleq_qtype(rhs_qtype, lhs_qtype, loc) || result;
  return result;
}

/* Same logic as above */
bool unify_assign_convert(qtype rhs_qtype, qtype lhs_qtype, location *loc)
{
  bool result;

  result = FALSE;
  result = assign_convert(loc, rhs_qtype, lhs_qtype, &rhs_qtype, &lhs_qtype)
    || result;
  result = unify_qtype(rhs_qtype, lhs_qtype, loc) || result;
  return result;
}

/* Same logic as above, but for taking lubs */
bool lub_assign_convert(qtype qt1, qtype qt2, qtype *lub, location *loc)
{
  bool result;

  result = FALSE;
  result = assign_convert(loc, qt1, qt2, &qt1, &qt2) || result;
  result = lub_qtype(qt1, qt2, lub, loc) || result;
  return result;
}

/* Return the kind of operation used in an assignment statement */
ast_kind assign_op_kind(binary e)
{
  switch(e->kind)
    {
    case kind_plus_assign: return kind_plus;
    case kind_minus_assign: return kind_minus;
    case kind_times_assign: return kind_times; 
    case kind_divide_assign: return kind_divide; 
    case kind_modulo_assign: return kind_modulo; 
    case kind_lshift_assign: return kind_lshift; 
    case kind_rshift_assign: return kind_rshift; 
    case kind_bitand_assign: return kind_bitand; 
    case kind_bitor_assign: return kind_bitor; 
    case kind_bitxor_assign: return kind_bitxor; 
    default:
      fail_loc(e->loc, "Unexpected assign_op_kind kind 0x%x\n", e->kind);
    }
}

/**************************************************************************
 *                                                                        *
 * 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)
{
  if (mkNonConst_pointer(lhs_qtype, loc))
    report_qerror(*loc, sev_err,
		  "left-hand side of assignment is const");
}

/* Make q nonconst, if nonconst is a qualifier */
bool mkNonConst_qual(qual q, location *loc)
{
  if (!nonconst_qual)
    return FALSE;
  return mkleq_qual(q, nonconst_qual, loc);
}

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

  if (!nonconst_qual)
    return FALSE;
  assert(qtype_pointer(ptr_qtype));
  result = mkNonConst_qual(qual_qtype(ptr_qtype), loc) || result;
  contents_qtype = points_to_qtype(ptr_qtype);
  if (qtype_aggregate(contents_qtype))
    result = mkNonConst_aggregate(contents_qtype, loc) || result;
  return result;
}

/* Make a pointer (l-)type const.  Returns true if there was an error. */
bool mkConst_pointer(qtype ptr_qtype, location *loc)
{
  bool result = FALSE;

  if (!const_qual)
    return FALSE;
  assert(qtype_pointer(ptr_qtype));
  result = mkleq_qual(const_qual, qual_qtype(ptr_qtype), loc);
  /* XXX: Do something for aggregate */
  return result;
}

/* 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. */
bool mkNonConst_aggregate(qtype ag_qtype, location *loc)
{
  field_scanner fields;
  qtype field_qtype, contents_qtype;
  bool result = FALSE;
  
  if (!nonconst_qual)
    return FALSE;

  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. */
      result = mkNonConst_qual(qual_qtype(field_qtype), loc) || result;
      if (qtype_aggregate(contents_qtype))
  	result = mkNonConst_aggregate(contents_qtype, loc) || result;
    }
  return result;
}
