/*********************************************************************************
 *
 *  Translating ODMG OQL into monoid comprehensions
 *  Copyright (c) 1999-2003 by Leonidas Fegaras, the University of Texas at
 *     Arlington. All rights reserved.
 *  Programmer: Leonidas Fegaras
 *  Date: 10/8/98
 *
 ********************************************************************************/

#include "odl.h"
#include "typecheck.h"


list<Expr>* comparison_operators
	 = Nil->cons(#<eq>)->cons(#<neq>)->cons(#<gt>)->cons(#<lt>)->cons(#<geq>)->cons(#<leq>);

list<Expr>* aggregate_operators
	 = Nil->cons(#<count>)->cons(#<min>)->cons(#<max>)->cons(#<avg>)->cons(#<sum>);


/* alpha coersion (renaming variables to avoid name conflicts) */
Expr rename_vars ( Expr term, binding<Expr>* binds );

/* given a pattern, return a new pattern of the same shape but with fresh variables */
Expr new_patterns ( Expr pattern );

/* bind pattern variables to values; eg. pattern_binding of pair(pair(a,b),c)
*  to pair(pair(1,2),3) will bind a to 1, b to 2, and c to 3 */
binding<Expr>* pattern_bindings ( Expr pattern, Expr value );


/* translates the projection part of a select-from-where OQL clause */
Expr translate_projection ( list<Expr>* project_list, list<Expr>* from_list, list<Expr>* group_by_list ) {
  if (project_list->consp() && project_list->tl->nullp() && project_list->hd->eq(#<all>))
  {  if (group_by_list->consp())
     {  list<Expr>* r = Cons(#<bind(partition,partition)>,Nil);
	for(list<Expr>* by = group_by_list; by->consp(); by=by->tl)
	   #case by->hd
	   | bind(`v,_) => r = r->cons(#<bind(`v,`v)>);
	   | _ =>  r = r->cons(#<bind(`(new_variable()),`(by->hd))>);
	   #end;
	return #<struct(...r)>;
     };
     list<Expr>* s = Nil;
     for(list<Expr>* fl = from_list; fl->consp(); fl=fl->tl)
	#case fl->hd
	| iterate(`x,_) => s = s->cons(#<bind(`(variable(x->name())),`x)>);
	#end;
     if (s->tl->nullp())
	return s->hd->arguments()->hd;
     s = s->reverse();
     return #<struct(...s)>;
  };
  if (project_list->consp() && project_list->tl->nullp())
     #case project_list->hd
     | bind(`x,`e)
	 => return #<struct(bind(`x,`e))>;
     | _ => return project_list->hd;
     #end;
  list<Expr>* s = Nil;
  for(list<Expr>* pl = project_list; pl->consp(); pl=pl->tl)
     #case pl->hd
     | bind(`x,`e) => s = s->cons(pl->hd);
     | project(`e,`v)
	  => s = s->cons(#<bind(`v,`(pl->hd))>);
     | `e => if (e->variablep())
		s = s->cons(#<bind(`(variable(e->name())),`e)>);
	     else s = s->cons(#<bind(`(new_variable()),`e)>);
     #end;
  s = s->reverse();
  return #<struct(...s)>;
};


Expr fix_projection ( Expr e, Expr v ) {
  #case e
  | project(`x,`a)
	=> return #<project(`(fix_projection(x,v)),`a)>;
  | _ => if (e->variablep())
	    return #<project(`v,`e)>;
	 else return e;
  #end;
};


bool is_projection ( Expr e ) {
  #case e
  | project(`x,`a,...r)
	=> return is_projection(x);
  | _ => return e->variablep();
  #end;
};


Expr projection_variable ( Expr e ) {
  #case e
  | project(`x,`a,...r)
	=> return projection_variable(x);
  | _ => return e;
  #end;
};


/* fix SQL-like aggregations */
Expr fix_ugly_aggregations ( Expr e, list<Expr>* binds ) {
  #case e
 | `h[`f(`v)]
    : member(f,aggregate_operators) && v->variablep() && member(v,binds)
	=> { Expr nv = new_variable();
	     Expr nx = fix_projection(v,nv);
	     if (f->eq(#<count>))
		return fix_ugly_aggregations(#<`h[compr(sum,1,iterate(`nv,partition))]>,binds);
	     return fix_ugly_aggregations(#<`h[compr(`f,`nx,iterate(`nv,partition))]>,binds);
	   };
  | `h[project(`x,`a,...r)]
	: is_projection(x) && member(projection_variable(x),binds)
	=> { Expr nv = new_variable();
	     Expr nx = fix_projection(x,nv);
	     return fix_ugly_aggregations(#<`h[compr(set,project(`nx,`a,...r),iterate(`nv,partition))]>,binds);
	   };
  | _ => return e;
  #end;
};


/* handle the group-by part of an OQL query */
list<Expr>* make_partition ( list<Expr>* qualifiers, list<Expr>* group_by, Expr where ) {
   list<Expr>* q = Nil;
   list<Expr>* h = Nil;
   list<Expr>* bl = Nil;
   binding<Expr>* binds = new binding<Expr>;
   for(list<Expr>* s = qualifiers; s->consp(); s=s->tl)
      #case s->hd
      | iterate(`v,`e)
		=> { Expr nv = new_patterns(v);
		     binds = pattern_bindings(v,nv)->extend(binds);
		     q = q->cons(#<iterate(`nv,`(rename_vars(e,binds)))>);
		     h = h->cons(#<bind(`v,`nv)>);
		   };
      | bind(`v,`e)
		=> { Expr nv = new_patterns(v);
		     binds = pattern_bindings(v,nv)->extend(binds);
		     q = q->cons(#<bind(`nv,`(rename_vars(e,binds)))>);
		   };
      | _ => q = q->cons(rename_vars(s->hd,binds));
      #end;
   Expr w = rename_vars(where,binds);
   list<Expr>* eqs = Nil;
   for(list<Expr>* b = group_by; b->consp(); b=b->tl)
      #case b->hd
      |  bind(`v,`e)
		=> { eqs = eqs->cons(#<eq(`e,`(rename_vars(e,binds)))>);
		     bl = bl->cons(b->hd);
		   };
      |  `e => eqs = eqs->cons(#<eq(`e,`(rename_vars(e,binds)))>);
      #end;
   Expr lv = fresh_type_variable();
   q = q->reverse();
   return bl->cons(#<bind(partition,compr(`lv,struct(...h),...q,...eqs,`w))>);
};


/* convert an OQL term into a comprehension form */
Expr translate_term ( Expr e ) {
  #case e
  | struct(...r)
	=> return #<struct(...r)>;
  | construct(`x,...r)
	=> return #<construct(`x,...r)>;
  | call(`x,...r)
	=> return #<call(`x,...r)>;
  | member(`x,`s)
      => { Expr nv = new_variable();
	   return #<compr(some,eq(`x,`nv),iterate(`nv,`s))>;
	 };
  | listtoset(`x)
	=> { Expr nx = new_variable();
	     return #<compr(set,`nx,iterate(`nx,`x))>;
	   };
  | intersect(`x,`y)
      => { Expr nx = new_variable();
	   Expr ny = new_variable();
	   Expr lv = fresh_type_variable();
	   return #<compr(`lv,`nx,iterate(`nx,`x),compr(some,eq(`nx,`ny),iterate(`ny,`y)))>;
	 };
  | except(`x,`y)
      => { Expr nx = new_variable();
	   Expr ny = new_variable();
	   Expr lv = fresh_type_variable();
	   return #<compr(`lv,`nx,iterate(`nx,`x),compr(all,neq(`nx,`ny),iterate(`ny,`y)))>;
	 };
  | union(`x,`y) => Expr lv = fresh_type_variable();
		    return #<merge(`lv,`x,`y)>;
  | exists(`x,`s,`e)
      => return #<compr(some,`e,iterate(`x,`s))>;
  | exists(`s)
      => return #<compr(some,true,iterate(`(new_variable()),`s))>;
  | unique(`s)
      => return #<eq(compr(sum,1,iterate(`(new_variable()),`s)),1)>;
  | forall(`x,`s,`e)
      => return #<compr(all,`e,iterate(`x,`s))>;
  | `f(`x,some,`y)
	: member(f,comparison_operators)
	=> { Expr nv = new_variable();
	     return #<compr(some,`f(`nv,`x),iterate(`nv,`y))>;
	   };
  | `f(`x,any,`y)
	: member(f,comparison_operators)
	=> { Expr nv = new_variable();
	     return #<compr(some,`f(`nv,`x),iterate(`nv,`y))>;
	   };
  | `f(`x,all,`y)
	: member(f,comparison_operators)
	=> { Expr nv = new_variable();
	     return #<compr(all,`f(`nv,`x),iterate(`nv,`y))>;
	   };
  | group(`x,`s,NONE,...by)
           => { Expr nv = new_variable();
		list<Expr>* eqs = Nil;
		for(list<Expr>* r = by; r->consp(); r=r->tl)
		   #case r->hd
		   |  bind(_,`e) => eqs = eqs->cons(#<eq(`e,`(subst_expr(x,nv,e)))>);
		   #end;
		eqs = eqs->reverse();
		Expr lv = fresh_type_variable();
		Expr tv = fresh_type_variable();
	        return #<compr(`tv,struct(...by,bind(partition,compr(`lv,`nv,iterate(`nv,`s),...eqs))),
			       iterate(`x,`s))>;
	      };
  | group(`x,`s,struct(...with),...by)
           => { Expr nv = new_variable();
		list<Expr>* eqs = Nil;
		for(list<Expr>* r = by; r->consp(); r=r->tl)
		   #case r->hd
		   |  bind(_,`e) => eqs = eqs->cons(#<eq(`e,`(subst_expr(x,nv,e)))>);
		   #end;
		eqs = eqs->reverse();
		Expr lv = fresh_type_variable();
		Expr tv = fresh_type_variable();
		Expr uv = fresh_type_variable();
	        return #<compr(`tv,struct(...by,...with),
			       iterate(`x,`s),iterate(partition,unit(`uv,compr(`lv,`nv,iterate(`nv,`s),...eqs))))>;
	      };
  | flatten(`e)
      => { Expr nx = new_variable();
	   Expr ns = new_variable();
	   return #<compr(set,`nx,iterate(`ns,`e),iterate(`nx,`ns))>;
	 };
  | min(`e)
      => { Expr nx = new_variable();
	   return #<compr(min,`nx,iterate(`nx,`e))>;
	 };
  | max(`e)
      => { Expr nx = new_variable();
	   return #<compr(max,`nx,iterate(`nx,`e))>;
	 };
  | sum(`e)
      => { Expr nx = new_variable();
	   return #<compr(sum,`nx,iterate(`nx,`e))>;
	 };
  | avg(`e)
      => { Expr nx = new_variable();
	   Expr ny = new_variable();
	   return #<div(compr(sum,`nx,iterate(`nx,`e)),
			compr(sum,1,iterate(`ny,`e)))>;
	 };
  | count(all)
      => { Expr nx = new_variable();
	   return #<compr(sum,1,iterate(`nx,partition))>;
	 };
  | count(`e)
      => { Expr nx = new_variable();
	   return #<compr(sum,1,iterate(`nx,`e))>;
	 };
  | `f(...r) => if (member(f,Nil->cons(#<set>)->cons(#<bag>)->cons(#<list>)->cons(#<array>)))
		{  if (r->nullp())
		      return #<zero(`f)>;
		   r = r->reverse();
		   Expr res = #<unit(`f,`(r->hd))>;
		   for(list<Expr>* s = r->tl; s->consp(); s=s->tl)
		      res = #<merge(`f,unit(`f,`(s->hd)),`res)>;
		   return res;
		};
  #end;
  return e;
};


bool macrop ( Expr fname ) {
  #case get_declaration_binding(fname->name())
  | define(`name,params(...ps),`body)
	=> return true;
  | _ => return false;
  #end;
};


/* convert an OQL term into a comprehension form */
Expr translate ( Expr e ) {
  Expr u;
  #case e
  | select(`m,project(...r),from(...s),`where,groupby(...by),`having,order(...ord))
	=> { if (ord->consp())
		m = #<ordered(...ord)>;
	     list<Expr>* partition = Nil;
	     Expr p = translate_projection(r,s,by);
	     if (by->consp())
	     {  partition = make_partition(s,by,where);
		list<Expr>* range_vars = Nil;
		for(list<Expr>* c = s; c->consp(); c=c->tl)
		#case c->hd
		|  iterate(`v,`e) => range_vars = range_vars->cons(v);
		|  bind(`v,`e) => range_vars = range_vars->cons(v);
		#end;
		p = fix_ugly_aggregations(p,range_vars);
		having = fix_ugly_aggregations(having,range_vars);
	     };
	     Expr res = #<compr(`m,`p,...s,`where,...partition,`having)>;
	     return translate(res);
	   };
  | call(`f,...args)		/* macro definition */
	: macrop(f)
	=> #case get_declaration_binding(f->name())
	   | define(`name,params(...ps),`body)
		=> { Expr new_exp = body;
		     list<Expr>* r = args;
		     for(; r->consp() && ps->consp(); r=r->tl, ps=ps->tl)
			new_exp = subst_expr(ps->hd,r->hd,new_exp);
		     if (r->consp() || ps->consp())
			type_error("Wrong number of arguments in macro call",e);
		     return translate(new_exp);
		   };
	   #end;
  | `f(...r) => { list<Expr>* nr = Nil;
		  for(list<Expr>* s = r; s->consp(); s=s->tl)
		     nr = nr->cons(translate(s->hd));
		  nr = nr->reverse();
		  u = #<`f(...nr)>;
		};
  | _ => u = e;
  #end;
  return translate_term(u);
};