/********************************************************************************
*
* File: typecheck.gen
* Title: The type-checking algorithm for the relational database system SDB.
* Programmer: Leonidas Fegaras, UTA
* Date: 2/21/97
*
********************************************************************************/

#include "evaluation.h"
#include "typecheck.h"


/* DATABASE holds both the database schema and the database state */
extern database* DATABASE;


Names string_vector ( string v[] ) {
  Names res = new list<String>;
  for(short i = sizeof(v)-1; i>=0; i--) res = res->cons(&v[i]);
  return res;
};


/* Lists of operator names */
static string ar[] = { "plus", "minus", "times", "divide" };
Names arithmetic = string_vector(ar);

static string cmp[] = { "eq", "neq", "gt", "lt", "geq", "leq" };
Names comparisons = string_vector(cmp);

static string ag[] = { "min", "max", "count", "avg", "sum" };
Names aggregates = string_vector(ag);


/* a type error is a fatal error: it causes the program to abort */
type_error ( string msg, Expr e ) {
  cerr << "\n*** Type Error: " << msg << " (" << e << ")\n";
  exit(-1);
};


/* true if types x and y are compatible */
bool type_compatible ( Type x, Type y) {
  #case x
  |  string => #case y
	       |  string => return true;
	       |  char(`n) => return true;
	       |  `o => return false;
	       #end;
  |  char(`n) => #case y
		 |  char(`m) => return n->eq(m);
		 |  varchar(`m) => return n->eq(m);
		 |  string => return true;
		 |  `o => return false;
		 #end;
  |  varchar(`n) => #case y
		    |  char(`m) => return n->eq(m);
		    |  varchar(`m) => return n->eq(m);
		    |  string => return true;
		    |  `o => return false;
		    #end;
  |  `o => return x->eq(y);
  #end;
};


/* true if schemas x and y are union compatible (i.e. they have the same attribute/types) */
bool union_compatible ( Schema x, Schema y, Expr e ) {
  Names r = x->names();
  Names s = y->names();
  bool b = true;
  for( ; r->consp() && s->consp(); r=r->tl, s=s->tl)
     b = b && type_compatible(x->find(r->hd),y->find(s->hd));
  if (r->consp() || s->consp())
     { type_error("Union/intersect components have different sizes",e);
       return false;
     };
  if (!b) type_error("Incompatible types in union/intersect",e);
  return b;
};


/* typecheck a projection e equal to project(table,attribute);
*  if the table is not known in the original query, then it destructively
*  changes the table to the right table name (if there is no ambiguity) */
Type typecheck::column ( Expr e, Expr grouping ) {
  #case e
  | project(UNKNOWN,`atrb)
	 => if (atrb->variablep())
            { Expr tp = #<NONE>;
	      bool found = false;
	      for(Names r = env->names(); r->consp(); r=r->tl)
              { if (found && env->find(r->hd)->in(atrb->name()))
		   type_error("Ambiguous reference to a table attribute",e);
	        if (env->find(r->hd)->in(atrb->name()))
		{ found = true;
 		  e->arguments()->hd = variable(r->hd);		/*** DESTRUCTIVE ***/
		};
	        tp = env->find(r->hd)->find(atrb->name(),tp);
               };
	      if (!found) type_error("No such attribute",atrb);
	      return tp;
            }
	    else type_error("Expected a table attribute",atrb);
  |  project(`table,`atrb) => if (env->in(table->name()))
			      { Schema s = env->find(table->name());
				if (s->in(atrb->name()))
				   return s->find(atrb->name());
				else type_error("No such attribute in table",e);
                              }
			      else type_error("No such table in projection",e);
  #end;
  return #<int>;
};


/* typecheck an expression */
Type typecheck::expression ( Expr e, Expr grouping ) {
  #case e
  |  project(`table,`atrb) => return this->column(e,grouping);
  |  count(ALL) => return #<int>;
  |  count(`x) => { this->column(x,grouping); return #<int>; };
  |  neg(`x) => if (this->expression(x,grouping)->eq(#<int>))
		   return #<int>;
		else type_error("Expected a number in negation",e);
  |  `f(`x) => if (member(f,aggregates))
		  if (this->column(x,grouping)->eq(#<int>)) return #<int>;
  |  `f(`x,`y) => if (member(f,arithmetic))
		     { if (this->expression(x,grouping)->eq(#<int>)
			   && this->expression(y,grouping)->eq(#<int>))
			  return #<int>;
		     }
		  else type_error("Expected numbers in arithmetic operation",e);
  #end;
  if (e->integerp()) return #<int>;
  if (e->stringp()) return #<string>;
  type_error("Ill-formed expression",e);
};


/* typecheck a predicate */
typecheck::predicate ( Expr e, Expr grouping ) {
  #case e
  |  true => {};
  |  false => {};
  |  and(`x,`y) => { this->predicate(x,grouping);
		     this->predicate(y,grouping);
		   };
  |  or(`x,`y) => { this->predicate(x,grouping);
		    this->predicate(y,grouping);
		   };
  |  not(`x) => this->predicate(x,grouping);
  |  exists(`x) => this->query(x,grouping);
  |  null(`x) => this->expression(x,grouping);
  |  `f(`x,`y) => { Type ex = this->expression(x,grouping);
		    Type ey = this->expression(y,grouping);
		    if (member(f,comparisons))
		       if (!type_compatible(ex,ey))
			  type_error("Incompatible types in predicate",e);
		  };
  |  _ => type_error("Illegal predicate",e);
  #end;
};


/* typecheck a query */
Schema typecheck::query ( Expr e, Expr grp ) {
  #case e
  |  union(`x,`y) => { /* need to copy the environment because it will be	*/
		       /* modified when typechecking x				*/
		       Typecheck new_env = new typecheck(this);
		       Schema sx = this->query(x,grp);
		       Schema sy = new_env->query(y,grp);
		       union_compatible(sx,sy,e);
		       return sx;
		     };
  |  intersect(`x,`y) => { Typecheck new_env = new typecheck(this);
			   Schema sx = this->query(x,grp);
			   Schema sy = new_env->query(y,grp);
			   union_compatible(sx,sy,e);
			   return sx;
			 };
  |  sql_select(`project,from(...ts),`where,`group,`having,`order)
      => { Typecheck new_env = new typecheck(this);
	   Names tables = new list<String>;
	   /* typecheck the FROM list */
	   for(list<Expr>* r = ts; r->consp(); r=r->tl)
	      #case r->hd
	      |  as(`e,`table) => { Schema in = this->query(e,grp);
				    new_env->env = new_env->env->extend(table->name(),in);
				    tables = tables->cons(table->name());
				  };
	      |  _ => type_error("tables were expected in the 'from' list",e);
	      #end;
	   /* typecheck the WHERE predicate */
	   new_env->predicate(where,grp);
	   /* typecheck the GROUP BY attributes and the HAVING predicate */
	   #case group
	   |  columns(...cs)
		 => { for(list<Expr>* r = cs; r->consp(); r=r->tl)
		         new_env->column(r->hd,grp);
		      new_env->predicate(having,group);
		    };
	   #end;
	   /* typecheck the ORDER BY attributes */
	   #case order
	   |  columns(...cs)
		 => for(list<Expr>* r = cs; r->consp(); r=r->tl)
		       new_env->column(r->hd,grp);
	   #end;
	   /* typecheck the projection attributes */
	   Schema out_env = new binding<Expr>;
	   #case project
	   |  project(...ps)
		=> for(list<Expr>* r = ps; r->consp(); r=r->tl)
		      #case r->hd
		      |  as(project(`table,ALL),NONE)
			   => if (env->in(table->name()))
			         out_env = out_env->extend(new_env->env->find(table->name()));
			      else type_error("No such table",r->hd);
		      |  as(`e,NONE)
			   => out_env = out_env->extend(new_name(),new_env->expression(e,group));
		      |  as(`e,`name)
			   => out_env = out_env->extend(name->name(),new_env->expression(e,group));
		      #end;
	   |  ALL => for(Names r = tables; r->consp(); r=r->tl)
			out_env = out_env->extend(new_env->env->find(r->hd));
	   #end;
	   return out_env;
	 };
   | insert(`table,`atrbs,`value)  /* need to fix this to typecheck INSERT commands */
	=> return new binding<Expr>;
   | `x => if (x->variablep())
              { if (DATABASE->content->in(x->name()))
		   return DATABASE->content->find(x->name())->schema;
		else type_error("No such table",x); }
	   else type_error("Internal error",x);
   #end;
};
