/********************************************************************************
*
* The code generator for evaluating physical plans produced by the OQL optimizer.
* The generated code contains calls to the evaluator functions (evaluator/eval.h)
*
* Copyright (c) 1999-2003 by Leonidas Fegaras, the University of Texas at
*     Arlington. All rights reserved.
* Programmer: Leonidas Fegaras, UTA
* Date: 10/20/98
*
*********************************************************************************/

#include "odl.h"
#include "typecheck.h"
#include "constant.h"
#include <math.h>


/* flag to indicate whether we are compiling or interpreting queries */
bool interpreterp = false;


/* initial_offset is the offset of the first attribute in an ODL class */
class test_for_size { public: int x; };
static test_for_size test_for_size_var;
const int initial_offset = ((char*) &test_for_size_var.x) - ((char*) &test_for_size_var);


/* return the variables of a pattern */
list<Expr>* pattern_variables ( Expr pattern );


extern binding<Expr>* global_lvars;


extern String current_module_name;
extern ofstream fout;


/* global environment for group-by vars */
GEnv gvars = new list<pair<Expr,Expr>*>;
Schema gbinds = new binding<Expr>;


/* a type_of function that uses the global environment for variable binding */
Expr type ( Expr &e, Schema sch ) {
  Schema cvars = sch;
  Expr tp = typecheck(e,cvars,global_lvars,gvars);
  e = eliminate_type_vars(e,global_lvars,false,true);
  return eliminate_type_vars(tp,global_lvars,false,true);
};


/* finds an evaluation function stored in the function table (defined in eval.cc) */
int find_function ( const char* function_name );


typedef struct { char* name;
		 void* address;
		 short args;
		 short fncs;
} function_table_element;

const int function_table_size = 1000;

extern int function_table_top;

extern function_table_element function_table[function_table_size];


/* find an internal function */
Expr internal ( const char* fname, list<Expr>* args ) {
  int loc = find_function(fname);
  if (loc<0)
  {  Schema sch = new binding<Expr>;
     String s = new string(fname);
     for(list<pair<String,method_info*>*>* n = internal_methods->env; n->consp(); n=n->tl)
        if (n->hd->first->eq(s))
	   return #<internal_call(`(variable(n->hd->second->name)),`(integer(n->hd->second->location)),boolean,...args)>;
     odmg_error("couldn't find the internal function",function(variable(new string(fname)),args));
  };
  return #<call(`(variable(new string(fname))),`(integer(loc)),...args)>;
};


/* A stack of environments; each environment binds names to values or streams
 * that are active in the current plan */
list<binding<Expr>*>* active_environment = Cons(new binding<Expr>,new list<binding<Expr>*>);

void new_active_stream () {
  active_environment = Cons(new binding<Expr>,active_environment);
};

Expr new_environment_stream ( Expr stream ) {
  if (active_environment->nullp())
     odmg_error("Wrong nested active streams",#<none>);
  Expr v = new_variable();
  active_environment->hd = active_environment->hd->extend(v->name(),stream);
  return #<stream(`v)>;
};

Expr new_stream ( Expr e, bool materializep ) {
   Expr s = new_environment_stream(e);
   if (materializep)
      s = new_environment_stream(internal("materialize_stream",Cons(s,Nil)));
   return s;
};

Expr close_active_stream ( Expr return_value ) {
  list<Expr>* res = Nil;
  if (active_environment->nullp())
     odmg_error("Wrong nested active streams",#<none>);
  binding<Expr>* last_env = active_environment->hd;
  for(Names nms = last_env->names(); nms->consp(); nms=nms->tl)
  {  #case last_env->find(nms->hd)
     | bind(...r) => res = Cons(#<bind(...r)>,res);
     | `v => res = Cons(#<bind(`(variable(nms->hd)),`v,stream)>,res);
     #end;
  };
  active_environment = active_environment->tl;
  if (res->nullp())
     return return_value;
  #case return_value
  | xassign(...bs,`v)
	=> return #<assign(...bs,...res,`v)>;
  | _ => return #<assign(...res,`return_value)>;
  #end;
};


/* does e generate a collection? */
bool bulk_operation ( Expr e ) {
  #case e
  | `f(`m,...r)
	: member(f,Nil->cons(#<ZERO>)->cons(#<MERGE>)->cons(#<UNIT>)->cons(#<NEST>)
		      ->cons(#<GROUP_BY>)->cons(#<REDUCE>))
	=> return collectionp(m);
  | `f(...r)
	=> return member(f,Nil->cons(#<TABLE_SCAN>)->cons(#<MERGE_JOIN>)->cons(#<NESTED_LOOP>)->cons(#<BLOCK_NESTED_LOOP>)
			      ->cons(#<INDEXED_LOOP>)->cons(#<MAP>)->cons(#<UNNEST>));
  | _ => return false;
  #end;
};


/* if e is module:...:class, retrieve the class name */
Expr class_name ( Expr e ) {
  char* r = (char*) GC_malloc(strlen(e->name()->content())+1);
  int j = 0;
  for(int i = 0; i<e->name()->length(); i++, j++)
     if (e->name()->content()[i] == ':')
	j = -1;
     else r[j] = e->name()->content()[i];
  return variable(new string(r));
};


Expr find_binary_function ( const char* name, Expr type, Expr x, Expr y ) {
  Schema sch = new binding<Expr>;
  if (type->eq(#<set>))
     type = #<long>;
  int loc = find_internal_method(new string(name),Cons(type,Cons(type,Nil)),sch)->second;
  if (loc<0)
     odmg_error("Incompatible types for primitive operation",#<`(variable(new string(name)))(`type,`type)>);
  for(list<pair<String,method_info*>*>* n = internal_methods->env; n->consp(); n=n->tl)
  {  method_info* m = n->hd->second;
     if (m->location == loc)
	return #<internal_call(`(variable(m->name)),`(integer(loc)),`(m->parameters->hd),`x,`y)>;
  };
};


list<Expr>* expr_variables ( Expr e ) {
  for(Names s = gbinds->names(); s->consp(); s=s->tl)
     if (gbinds->find(s->hd)->eq(e))
	return Cons(variable(s->hd),Nil);
  #case e
  |  project(`x,`a,_)
	=> return expr_variables(x);
  |  `f(...r) => { list<Expr>* s = Nil;
		   for(; r->consp(); r=r->tl)
		      s = s->append(expr_variables(r->hd));
		   return s;
		 };
  |  true => return Nil;
  |  false => return Nil;
  |  `v => if (v->variablep())
	      return Cons(v,Nil);
  #end;
  return Nil;
};


/* defined below */
Expr translate_expr ( Expr e, Schema sch, Schema stuple, int size );
Expr translate_opr ( Expr e, Schema &sch, Schema &stuple, Expr stream_prefix, bool materializep = false, bool streamp = true );
Expr translate_tuple ( Expr e, Schema sch, Schema stuple, int size );
int size_in_bytes ( Expr tp, bool is_raw_data = false );


Expr make_element ( Expr e, Schema sch, Schema stuple ) {
  Expr tp = type(e,sch);
  Expr ne = translate_expr(e,sch,stuple,stuple->length());
  if (is_class(tp))
     return #<new_tuple_reference(`ne)>;
  else return #<new_tuple_value(`ne)>;
};


/* translate a '%for each' loop (in stream-based fashion);
   sch is the typechecking schema,
   stuple is the schema of the input stream variables */
Expr translate_stream_opr ( Expr x, Schema &sch, Schema &stuple, bool materializep = false, bool streamp = true ) {
   new_active_stream();
   Expr stream_prefix = #<NULL>;
   if (stuple->length() > 0)
   {  Names n = stuple->names();
      stream_prefix = make_element(variable(n->hd),sch,stuple);
      for(n=n->tl; n->consp(); n=n->tl)
	 stream_prefix = internal("concat_tuples",Cons(stream_prefix,Cons(make_element(variable(n->hd),sch,stuple),Nil)));
   };
   return close_active_stream(translate_opr(x,sch,stuple,stream_prefix,materializep,streamp));
};


/* large values (>4B) are alligned at the beginning of words */
int round_size ( int n ) {
  return ((n-1) | 3) + 1;
};

int add_sizes ( int n, int m ) {
  return (m >= 4) ? (((n-1) | 3) + 1)+m : n+m;
};


/* generate an equality test between x and y (of type tp) */
Expr generate_equality ( Expr tp1, Expr tp2, Expr x, Expr y ) {
  #case tp1
  | scope(`etp)
	=> return generate_equality(get_declaration_binding(etp->name()),tp2,x,y);
  | void(`etp)
	=> if (is_class(etp))
	      return generate_equality(etp,tp2,x,y);
	   else return generate_equality(etp,tp2,#<value(`x,`etp)>,#<value(`y,`etp)>);
  | struct(...r)
	=> {  list<Expr>* s = Nil;
	      for(int i = 0; r->consp(); r=r->tl, i++)
	         #case r->hd
		 | bind(`v,`etp)
		      => s = s->cons(generate_equality(etp,etp,
						#<project(`x,`v,`(integer(i)),`etp,`tp1)>,
						#<project(`y,`v,`(integer(i)),`etp,`tp1)>));
		 #end;
	      if (s->nullp())
		 return #<true>;
	      Expr res = s->hd;
	      for(list<Expr>* n = s->tl; n->consp(); n=n->tl)
		 res = find_binary_function("and",#<boolean>,res,n->hd);
	      return res;
	  };
  | enum(`nm,...r)
	=> return internal("enum_equality",Cons(x,Cons(y,Nil)));
  | union(`nm,`tp,...cases)
	=> {  Expr res = #<false>;
	      int n = sizeof(type_tag);
	      for(list<Expr>* r=cases; r->consp(); r=r->tl)
		 #case r->hd
		 | case(`ctp,`decl,...tags)
			=> {  Expr cond = generate_equality(tp,tp,#<union_tag(`x)>,
							    translate_expr(tags->hd,new binding<Expr>,new binding<Expr>,0));
			      for(list<Expr>* s=tags->tl; s->consp(); s=s->tl)
				 cond = find_binary_function("or",#<boolean>,cond,
						generate_equality(tp,tp,#<union_tag(`x)>,
							translate_expr(s->hd,new binding<Expr>,new binding<Expr>,0)));
			      Expr eq = generate_equality(ctp,ctp,#<union_case(`x,`decl,`ctp,`(integer(round_size(n))))>,
								  #<union_case(`y,`decl,`ctp,`(integer(round_size(n))))>);
			      n = add_sizes(n,size_in_bytes(ctp,true));
			      res = #<if(`cond,`eq,`res)>;
			   };
		 #end;
	      return #<if(`(generate_equality(tp,tp,#<union_tag(`x)>,#<union_tag(`y)>)),`res,false)>;
	   };
  | class(...r)
      => return #<eq_oid(`x,`y)>;
  | `f(`etp)
	: collectionp(f)
	=> { Expr eq = generate_equality(etp,etp,#<value(x,`etp)>,#<value(y,`etp)>);
	     Expr eqf = #<lambda(bool,bind(x,`etp),bind(y,`etp),`eq)>;
	     #case f
	     | set => return internal("set_equality",Cons(x,Cons(y,Cons(eqf,Nil))));
	     | bag => return internal("bag_equality",Cons(x,Cons(y,Cons(eqf,Nil))));
	     | list => return internal("list_equality",Cons(x,Cons(y,Cons(eqf,Nil))));
	     | _ => return #<false>;
	     #end;
	   };
  | _ : is_class(tp1)
      => return #<eq_oid(`x,`y)>;
  | `v : v->variablep() && !get_declaration_binding(v->name())->eq(#<none>) && !get_scoped_type(v)->eq(v)
	=> return generate_equality(get_scoped_type(v),tp2,x,y);
  | _ => return find_binary_function("eq",tp1,x,y);
  #end;
};


int size_in_bytes_1 ( Expr tp, bool is_raw_data ) {
  #case tp
  | scope(`nm)
	=> return size_in_bytes_1(nm,is_raw_data);
  | void(`tp) => return size_in_bytes_1(tp,is_raw_data);
  | struct(...r)
	=> { int i = 0;
	     for(; r->consp(); r=r->tl)
		#case r->hd
		| bind(_,`etp)
			=> i = add_sizes(i,size_in_bytes_1(etp,is_raw_data));
		#end;
	     return i;
	   };
  | set(`etp)
	=> if (is_raw_data)
	      return sizeof(raw_sequence);
	   else return sizeof(sm_sequence);
  | bag(`etp)
	=> if (is_raw_data)
	      return sizeof(raw_sequence);
	   else return sizeof(sm_sequence);
  | list(`etp)
	=> if (is_raw_data)
	      return sizeof(raw_sequence);
	   else return sizeof(sm_sequence);
  | union(`nm,`tp,...cases)
	=> {  int size = sizeof(type_tag);
	      int i = size;
	      for(list<Expr>* r=cases; r->consp(); r=r->tl)
		 #case r->hd
		 | case(`ctp,`decl,...tags)
			=> i = add_sizes(i,size_in_bytes_1(ctp,is_raw_data));
		 #end;
	      return i;
	   };
  | enum(...r)
	=> return sizeof(type_tag);
  | string => if (is_raw_data)
		 return sizeof(raw_string);
	      else return sizeof(sm_string);
  | integer => return sizeof(long);
  | long => return sizeof(long);
  | short => return sizeof(long);
  | unsigned_long => return sizeof(unsigned long);
  | unsigned_short => return sizeof(unsigned short);
  | real => return sizeof(float);
  | float => return sizeof(float);
  | double => return sizeof(double);
  | boolean => return sizeof(bool);
  | `v  : v->variablep()
	=> #case get_declaration_binding(v->name())
	   | none => return 4;
	   | class(...r)
		=> if (is_raw_data)
		      return sizeof(raw_ref);
		   else return sizeof(sm_ref);
	   | typedef(`tp,_) => return size_in_bytes_1(tp,is_raw_data);
	   | union(...r) => return size_in_bytes_1(#<union(...r)>,is_raw_data);
	   | `etp => return 4;
	   #end;
  | _ => return 4;
  #end;
};


int size_in_bytes ( Expr tp, bool is_raw_data ) {
  return size_in_bytes_1(tp,is_raw_data);
};


Expr expand_type ( Expr tp ) {
  #case tp
  | scope(`nm)
	=> return expand_type(nm);
  | void(`nm)
	=> return expand_type(nm);
  | _ => return get_scoped_type(tp);
  | `v  : v->variablep()
	=> #case get_declaration_binding(v->name())
	   | typedef(`tp,_) => return expand_type(tp);
	   | union(...r) => return #<union(...r)>;
	   | struct(...r) => return #<struct(...r)>;
	   | _ => return tp;
	   #end;
  #end;
};


Expr import_value ( Expr e, Expr tp ) {
  return e;
/*
  #case tp
  |  string => return internal("import_string",Cons(e,Nil));
  |  scope(`nm)
	=> return import_value(e,expand_type(nm));
  |  struct(...binds)
	=> { list<Expr>* nbinds = Nil;
	     Expr nv = new_variable();
	     for(list<Expr>* r=binds->reverse(); r->consp(); r=r->tl)
		#case r->hd
		| bind(`v,`etp)
			=> nbinds = Cons(#<bind(`v,project(`nv,`v,`etp))>,nbinds);
		#end;
	     Expr res = translate_expr(#<struct(`tp,...nbinds)>,
				       new binding<Expr>(nv->name(),tp),new binding<Expr>(),0);
	     return #<block(define(`nv,`e,`tp),`res)>;
	   };
  |  `f(`etp)
	: collectionp(f)
	=> return internal("import_sequence",Cons(e,Cons(integer(round_size(size_in_bytes(etp))),
		Cons(#<lambda(void,bind(x,void),`(import_value(#<x>,etp)))>,Nil))));
  | `v : v->variablep() && is_class(v)
       => return internal("import_ref",Cons(e,Nil));
  | _ => return e;
  #end;
*/
};


Expr get_scoped_binding ( String name );
String scoped_name ( Expr e );

list<Expr>* get_class_components ( String cname ) {
  #case get_scoped_binding(cname)
  | class(`name,scope(...exc),inherits(...inhr),extent(...ext),keys(...keys),...body)
	=> { list<Expr>* res = Nil;
	     for(; body->consp(); body=body->tl)
		#case body->hd
		| attribute(`type,`copies,...vars)
			=> for(; vars->consp(); vars=vars->tl)
			      res = res->cons(#<attribute(`(vars->hd),`type)>);
		| relationship(`tp,`name,...r)
			=> res = res->cons(#<relationship(`name,`tp,...r)>);
		#end;
	     res = res->reverse();
	     if (exc->consp())
		res = get_class_components(scoped_name(#<scope(...exc)>))->append(res);
	    return res;
	};
  | _ => return Nil;
  #end;
};


Expr simple_type_to_key ( Expr e, Expr tp );

Expr translate_key ( Expr relation, list<Expr>* attributes, Schema sch, Schema stuple, int len );


Expr make_projection ( Expr e, Expr A, Expr tp ) {
  #case e
  | struct(...r)
	=> for(; r->consp(); r=r->tl)
	      #case r->hd
	      | bind(`v,`u)
		   : v->eq(A)
		   => return u;
	      #end;
	   return #<null>;
  | null => return #<null>;
  | _ => return #<project(`e,`A,`tp)>;
  #end;
};


/* Make a simple assignment and enforce relationships (update the inverse part of the relationship */
list<Expr>* make_complete_assignment ( Expr dest, Expr source, Expr tp, Schema sch, Schema stuple, int size ) {
  Expr x = translate_expr(dest,sch,stuple,size);
  Expr y = translate_expr(source,sch,stuple,size);
  if (x->eq(#<null>) || y->eq(#<null>))
     return Nil;
  list<Expr>* res = Cons(#<update(`x,`y,`tp)>,Nil);
  #case x
  | project(`e,`A,_,_,`C)
      : C->variablep() && classp(C->name())
      => #case get_declaration_binding(A->name(),C->name())
         | relationship(set(_),_,inverse(`D,`B))
	      => #case get_declaration_binding(B->name(),D->name())
                 | relationship(set(_),_,inverse(_,_))
                      => {  Expr zb = translate_expr(#<project(z,`B,set(`C))>,sch->extend(#<z>->name(),D),stuple,size);
			    zb = import_value(zb,#<set(`C)>);
			    return Cons(#<map(z,`D,sequence_insert(`zb,`e),`y)>,res);
			  };
                 | relationship(_,_,inverse(_,_))
                      => {  Expr zb = translate_expr(#<project(z,`B,`C)>,sch->extend(#<z>->name(),D),stuple,size);
			    return Cons(#<map(z,`D,update(`zb,`e,`C),`y)>,res);
	                 };
                 #end;
         | relationship(_,_,inverse(`D,`B))
	      => #case get_declaration_binding(B->name(),D->name())
                 | relationship(set(_),_,inverse(_,_))
                       => {  Expr yb = translate_expr(#<project(`source,`B,set(`C))>,sch,stuple,size);
			     yb = import_value(yb,#<set(`C)>);
			     return Cons(#<sequence_insert(`yb,`e)>,res);
			  };
                 | relationship(_,_,inverse(_,_))
                         => {  Expr yb = translate_expr(#<project(`source,`B,`C)>,sch,stuple,size);
			       return Cons(#<update(`yb,`e,`C)>,res);
			    };
                 #end;
         | _ => return res;
         #end;
  | _ => return res;
  #end;
};


/* Make a composite assignment */
list<Expr>* make_assignment ( Expr dest, Expr source, Expr tp, Schema sch, Schema stuple, int size ) {
  #case expand_type(tp)
  | struct(...comps)
	=> { list<Expr>* s = Nil;
	     for(list<Expr>* r=comps; r->consp(); r=r->tl)
		#case r->hd
		| bind(`v,`etp)
			=> s = s->append(make_assignment(make_projection(dest,v,etp),make_projection(source,v,etp),
							 etp,sch,stuple,size));
		#end;
	     return s;
	   };
  | union(_,`ttp,...comps)
	=> { Expr ts = translate_expr(source,sch,stuple,size);
	     Expr res = #<null>;
	     for(list<Expr>* r=comps; r->consp(); r=r->tl)
		#case r->hd
		| case(`etp,`v,...n)
			=> {  Expr cond = generate_equality(ttp,ttp,#<union_tag(`ts)>,
						translate_expr(n->hd->arguments()->hd,sch,stuple,size));
			      for(list<Expr>* s=n->tl; s->consp(); s=s->tl)
				 cond = find_binary_function("or",#<boolean>,cond,
						generate_equality(ttp,ttp,#<union_tag(`ts)>,
							translate_expr(s->hd->arguments()->hd,sch,stuple,size)));
			      list<Expr>* k = make_assignment(make_projection(dest,v,etp),make_projection(source,v,etp),
							      etp,sch,stuple,size);
			      if (res->eq(#<null>))
				 res = #<block(...k,0)>;
			      else res = #<if(`cond,block(...k,0),`res)>;
			   };
		#end;
	     return Cons(#<set_union_tag(`(translate_expr(dest,sch,stuple,size)),
					 union_tag(`ts))>,Cons(res,Nil));
	   };
  | _ => return make_complete_assignment(dest,source,tp,sch,stuple,size);
  #end;
};


/* Make an insertion and enforce relationships (update the inverse part of the relationship */
list<Expr>* make_insertion ( Expr dest, Expr source, Expr tp, Schema sch, Schema stuple, int size ) {
  Expr x = translate_expr(dest,sch,stuple,size);
  Expr y = translate_expr(source,sch,stuple,size);
  if (x->eq(#<null>) || y->eq(#<null>))
     return Nil;
  list<Expr>* res = Cons(#<sequence_insert(`x,`y)>,Nil);
  #case x
  | project(`e,`A,_,_,`C)
      : C->variablep() && classp(C->name())
      => #case get_declaration_binding(A->name(),C->name())
         | relationship(set(_),_,inverse(`D,`B))
	      => #case get_declaration_binding(B->name(),D->name())
                 | relationship(set(_),_,inverse(_,_))
                      => {  Expr yb = translate_expr(#<project(`source,`B,set(`C))>,sch,stuple,size);
			    yb = import_value(yb,#<set(`C)>);
			    return Cons(#<sequence_insert(`yb,`e)>,res);
			  };
                 | relationship(_,_,inverse(_,_))
                      => {  Expr yb = translate_expr(#<project(`source,`B,`C)>,sch,stuple,size);
			    return Cons(#<update(`yb,`e,`C)>,res);
	                 };
                 #end;
         | _ => return res;
         #end;
  | _ => return res;
  #end;
};


/* Make a deletion and enforce relationships (update the inverse part of the relationship */
list<Expr>* make_deletion ( Expr dest, Expr source, Expr tp, Schema sch, Schema stuple, int size ) {
  Expr x = translate_expr(dest,sch,stuple,size);
  Expr y = translate_expr(source,sch,stuple,size);
  if (x->eq(#<null>) || y->eq(#<null>))
     return Nil;
  list<Expr>* res = Cons(#<sequence_remove(`x,`y)>,Nil);
  #case x
  | project(`e,`A,_,_,`C)
      : C->variablep() && classp(C->name())
      => #case get_declaration_binding(A->name(),C->name())
         | relationship(set(_),_,inverse(`D,`B))
	      => #case get_declaration_binding(B->name(),D->name())
                 | relationship(set(_),_,inverse(_,_))
                      => {  Expr yb = translate_expr(#<project(`source,`B,set(`C))>,sch,stuple,size);
			    yb = import_value(yb,#<set(`C)>);
			    return Cons(#<sequence_remove(`yb,`e)>,res);
			  };
                 | relationship(_,_,inverse(_,_))
                      => {  Expr yb = translate_expr(#<project(`source,`B,`C)>,sch,stuple,size);
			    return Cons(#<update(`yb,null,`C)>,res);
	                 };
                 #end;
         | _ => return res;
         #end;
  | _ => return res;
  #end;
};


/* Translate an OQL non-bulk operation e into intermediate code;
   sch is the typechecking schema,
   stuple is the schema of the input stream variables,
   size is used in binary operators to index either the left (positive size)
       or right (negative size) input stream variables */
Expr translate_expr ( Expr e, Schema sch, Schema stuple, int size ) {
  for(Names s = gbinds->names(); s->consp(); s=s->tl)
     if (gbinds->find(s->hd)->eq(e))
	return translate_expr(variable(s->hd),sch,stuple,size);
  #case e
  | struct(...r)
	: interpreterp
	=> { list<Expr>* s = Nil;
	     for(; r->consp(); r=r->tl)
		#case r->hd
		| bind(`v,`u)
		     => s = s->cons(#<bind(`v,`(translate_expr(u,sch,stuple,size)))>);
		#end;
	     s = s->reverse();
	     Expr tp = type(e,sch);
	     return #<struct(`tp,`(integer(stuple->names()->nullp())),...s)>;
	   };
  | struct(...r)
	=> { list<Expr>* s = Nil;
	     Expr nd = new_variable();
	     Expr tp = type(e,sch);
	     Schema new_sch = sch->extend(nd->name(),tp);
	     Schema tsch = type_to_schema(tp);
	     for(; r->consp(); r=r->tl)
		#case r->hd
		| bind(`v,`u)
		     => { Expr etp = expand_type(tsch->find(v->name()));
			  if (true || etp->variablep())
			     s = s->append(make_assignment(make_projection(nd,v,etp),u,etp,new_sch,stuple,size));
			  else {
			     Expr nu = translate_expr(u,sch,stuple,size);
			     Expr ns = new_variable();
			     s = s->append(Cons(#<define(`ns,`nu,`etp)>,
						make_assignment(make_projection(nd,v,etp),ns,etp,
								new_sch->extend(ns->name(),etp),stuple,size)));
			  };
			};
		#end;
	     return #<block(define(`nd,make_struct(`tp),`tp),...s,`nd)>;
	   };
  | union_construction(`nm,`tag,`attr,`value,`etp,`tp)
	=> { Expr nv = new_variable();
	     #case expand_type(tp)
	     | union(_,_,...cs)
		=> for(list<Expr>* r=cs; r->consp(); r=r->tl)
		      #case r->hd
		      | case(`ctp,`a,...s)
			    : a->eq(attr)
			    => { list<Expr>* s = make_assignment(make_projection(nv,attr,etp),value,
								 ctp,sch->extend(nv->name(),tp),stuple,size);
				 return #<block(define(`nv,make_union(`tp,`tag),`tp),...s,`nv)>;
			       };
		       #end;
	     #end;
	     return #<null>;
	   };
  | `c(`cname,...attributes)
	: (c->eq(#<persistent_construct>) || c->eq(#<construct>))
	=> {  bool persistentp = c->eq(#<persistent_construct>);
	      list<Expr>* body = Nil;
	      Expr ext = estring(get_class_extent(cname)->name());
	      Expr sz = integer(round_size(initial_offset+size_in_bytes(class_type(cname->name()),true)));
	      Expr obj = (persistentp) ? internal("new_persistent_object",Cons(ext,Cons(sz,Nil)))
				       : internal("new_transient_object",Cons(sz,Nil));
	      String name = new_name();
	      Expr vname = variable(name);
	      Schema as = type_to_schema(#<struct(...attributes)>);
	      Schema new_sch = sch->extend(vname->name(),cname);
	      int n = initial_offset;
	      for(list<Expr>* r=get_class_components(cname->name()); r->consp(); r=r->tl)
		 #case r->hd
		 | `f(`nm,`tp,...s)
			=> {  if (as->in(nm->name()))
			      {  Expr nu = translate_expr(as->find(nm->name()),sch,stuple,size);
				 Expr ns = new_variable();
				 body = body->append(Cons(#<define(`ns,`nu,`tp)>,
						       make_assignment(make_projection(vname,nm,tp),ns,
								       tp,new_sch->extend(ns->name(),tp),stuple,size)));
			      } else #case tp
			      | `g(`etp) : collectionp(g)
					=> body = Cons(#<update(project(`vname,`nm,`(integer(n)),`tp,`cname),
								empty_collection(`etp,`(integer(round_size(size_in_bytes(etp,true))))),
								`tp)>,
						       body);
			      #end;
			      n = add_sizes(n,size_in_bytes(tp,true));
			   };
		 #end;
	      /* if persistent object, update indexes ... */
	      if (persistentp)
		 #case get_declaration_binding(new string("_class_indexes"),cname->name())
	         |  index(...r)
			=> for(; r->consp(); r=r->tl)
			      #case get_declaration_binding(r->hd->name())
			      | index(_,`unique,...attrs)
					=> { for(list<Expr>* s=attrs; s->consp(); s=s->tl)
						if (!member(s->hd,as->names()))
						   odmg_error("indexed attributes must have a value in construction",e);
					     Expr key = translate_key(vname,attrs,new binding<Expr>(name,cname),
								      new binding<Expr>(name,cname),-1);
					     body = body->append(Cons(internal("insert_into_index",Cons(estring(r->hd->name()),
								      Cons(key,Cons(vname,Nil)))),Nil));
					   };
			      #end;
		 | _ => odmg_error("No class indexes");
		 #end;
	      return #<block(define(`vname,`obj,`cname),...body,`vname)>;
	   };
  | project(`x,`a,`rtp)
	=> #case expand_type(type(x,sch))
	   | `v : v->variablep() && is_class(v)
		=> #case class_type(v->name())
		   | struct(...r)
			=> {  for(int n = initial_offset; r->consp(); r=r->tl)
				 #case r->hd
				 | bind(`w,_)
					: w->eq(a)
					=> return import_value(#<project(`(translate_expr(x,sch,stuple,size)),`a,
									 `(integer(round_size(n))),`rtp,`v)>,rtp);
				 | bind(_,`etp)
					=> n = add_sizes(n,size_in_bytes(etp,true));
				 #end;
			      odmg_error("No such attribute in class",e);
			   };
		   | _ => odmg_error("Ill-formed class",e);
		   #end;
	   | struct(...args)
		=> {  int n = 0;
		      int i = 0;
		      for(list<Expr>* r=args; r->consp(); r=r->tl, i++)
			 #case r->hd
			 | bind(`v,_)
				: v->eq(a)
				=> return import_value(#<project(`(translate_expr(x,sch,stuple,size)),`a,
								 `(integer(round_size(n))),`rtp,struct(...args),`(integer(i)))>,rtp);
			 | bind(_,`etp)
				=> n = add_sizes(n,size_in_bytes(etp,true));
			 #end;
		       return #<null>;
		   };
	   | union(`nm,`etp,...cs)
		=> { int n = sizeof(type_tag);
		     for(list<Expr>* r=cs; r->consp(); r=r->tl)
		        #case r->hd
		        | case(`tp,`dcl,...cs)
				: dcl->eq(a)
				=> return import_value(#<union_case(`(translate_expr(x,sch,stuple,size)),`a,`tp,
								    `(integer(round_size(n))))>,rtp);
		        | case(`tp,`dcl,...cs)
				=> n = add_sizes(n,size_in_bytes(tp,true));
		        #end;
		     odmg_error("No such attribute in union",e);
		   };
	   | `tp => return import_value(#<project(`(translate_expr(x,sch,stuple,size)),`a,0,`rtp,`tp)>,rtp);
	   #end;
  | cases(`e,...cs)
	=> { Expr res = #<null>;
	     #case cs->hd
	     | case(`action,default)
		   => {  res = translate_expr(action,sch,stuple,size);
			 cs = cs->tl;
		      };
	     #end;
	     Expr tp;
	     #case expand_type(type(e,sch))
	     | union(_,`etp,...r) => tp = etp;
	     | `etp => odmg_error("expected a union value in case statement",e);
	     #end;
	     Expr x = translate_expr(e,sch,stuple,size);
	     for(list<Expr>* r=cs; r->consp(); r=r->tl)
		#case r->hd
		| case(`action,...tags)
			=> {  Expr cond = generate_equality(tp,tp,#<union_tag(`x)>,
							    translate_expr(tags->hd,new binding<Expr>,new binding<Expr>,0));
			      for(list<Expr>* s=tags->tl; s->consp(); s=s->tl)
				 cond = find_binary_function("or",#<boolean>,cond,
						generate_equality(tp,tp,#<union_tag(`x)>,
							translate_expr(s->hd,new binding<Expr>,new binding<Expr>,0)));
			      Expr a = translate_expr(action,sch,stuple,size);
			      if (res->eq(#<null>))
				 res = a;
			      else res = #<if(`cond,`a,`res)>;
			   };
		#end;
	      return res;
	    };
  | and() => return #<true>;
  | and(`e)
	=> return translate_expr(e,sch,stuple,size);
  | and(`e,...r)
	=> return find_binary_function("and",#<boolean>,
			translate_expr(e,sch,stuple,size),
			translate_expr(#<and(...r)>,sch,stuple,size));
  | or() => return #<false>;
  | or(`e)
	=> return translate_expr(e,sch,stuple,size);
  | or(`e,...r)
	=> return find_binary_function("or",#<boolean>,
			translate_expr(e,sch,stuple,size),
			translate_expr(#<or(...r)>,sch,stuple,size));
  | OID(`e)
	=> return translate_expr(e,sch,stuple,size);
  | like(`e,`pat)
	=> {  String npat = pat->info.Estring;
	      char* nc = new (GC) char[npat->length()+1];
	      strcpy(nc,npat->content());
	      for(int i = npat->length()-1; i>=0; i--)
		 if (nc[i] == (char) 37)
		    nc[i] = '*';
		 else if (nc[i] == '_')
		    nc[i] = '?';
	      return internal("string_match",Cons(estring(new (GC) string(nc)),
						  Cons(translate_expr(e,sch,stuple,size),Nil)));
	   };
  | method(`o,`name,...r)
	: interpreterp
	=> #case expand_type(type(o,sch))
	   | `tp : tp->variablep() && is_class(tp)
		=> { int loc = find_function(fform("_F_%s_%s_%s",current_module_name->content(),
					     tp->name()->content(),name->name()->content()));
		     list<Expr>* s = Nil;
		     for(; r->consp(); r=r->tl)
			s = s->cons(translate_expr(r->hd,sch,stuple,size));
		     s = Cons(translate_expr(o,sch,stuple,size),s->reverse());
		     if (loc>0)
		        return #<call(`(integer(r->length()+1)),`(integer(loc)),...s)>;
		     else {
			String nm = new string(*tp->name()+"::_"+*name->name());
			return #<method_call(`(variable(nm)),...s)>;
			#case get_declaration_binding(nm);
			| none => odmg_error("There is no implementation for method",e);
			| `body => return #<method_call(`(variable(nm)),...s)>;
			#end;
		     };
		   };
	   #end;
  | method(`o,`name,...r)
	=> { list<Expr>* s = Nil;
	     for(; r->consp(); r=r->tl)
		s = s->cons(translate_expr(r->hd,sch,stuple,size));
	     s = s->reverse();
	     return #<message(`(type(o,sch)),`(type(e,sch)),`(translate_expr(o,sch,stuple,size)),`name,...s)>;
	   };
  | call(reduce,`merge,`zero,`x)
	=> #case type(x,sch)
	   | list(`atp)
		=> { Expr btp = type(e,sch);
		     Expr ex = translate_expr(x,sch,stuple,size);
		     return #<call(reduce_list,`btp,
				   lambda(`btp,bind(x,`atp),bind(y,`btp),function_call(`merge,`btp,x,y)),
				   `zero,`ex)>;
		   };
	   | _ => return #<error>;
	   #end;
  | call(`name,...r)
	=> { list<Expr>* s = Nil;
	     for(; r->consp(); r=r->tl)
		s = s->cons(translate_expr(r->hd,sch,stuple,size));
	     s = s->reverse();
	     return #<function_call(`name,`(type(e,sch)),...s)>;
	   };
  | pair(`x,`y)
	=> return internal("concat",Cons(translate_expr(x,sch,stuple,size),
					 Cons(translate_expr(y,sch,stuple,size),Nil)));
  | eq(`x,`y)
	=> return generate_equality(type(x,sch),type(y,sch),
				    translate_expr(x,sch,stuple,size),
				    translate_expr(y,sch,stuple,size));
  | neq(`x,`y)
	=> return internal("not",Cons(generate_equality(type(x,sch),type(y,sch),
						        translate_expr(x,sch,stuple,size),
						        translate_expr(y,sch,stuple,size)),
				      Nil));
  | if(`pred,`x,`y)
	=> return #<if(`(translate_expr(pred,sch,stuple,size)),`(translate_expr(x,sch,stuple,size)),
		       `(translate_expr(y,sch,stuple,size)))>;
  | scope(`e)
	=> return translate_expr(e,sch,stuple,size);
  | simple_type_to_key(`e,`tp)
	=> return simple_type_to_key(translate_expr(e,sch,stuple,size),tp);
  | simple_type_to_cmp(`x,`y,`tp)
	=> return internal(fform("%s_cmp",tp->name()->content()),
			   Cons(translate_expr(x,sch,stuple,size),Cons(translate_expr(y,sch,stuple,size),Nil)));
  | concat_keys(`x,`y)
	=> return internal("concat_keys",Cons(translate_expr(x,sch,stuple,size),Cons(translate_expr(y,sch,stuple,size),Nil)));
  | merge_cmp(`x,`y)
	=> internal("merge_cmp",Cons(translate_expr(x,sch,stuple,size),Cons(translate_expr(y,sch,stuple,size),Nil)));
  | vector_access(`u,`n)
	=> { Expr tp = type(e,sch);
	     Expr ret;
	     #case translate_stream_opr(u,sch,stuple)
	     | assign(...r,`x)
		  => ret = #<assign(...r,`(import_value(internal("nth_element",Cons(x,Cons(translate_expr(n,sch,stuple,size),Nil))),tp)))>;
	     | `x => ret = import_value(internal("nth_element",Cons(x,Cons(translate_expr(n,sch,stuple,size),Nil))),tp);
	     #end;
	     if (is_class(tp))
		return #<tuple_reference(`ret,0,`tp)>;
	     else return #<tuple_value(`ret,0,`tp)>;
	   };
  | referencep(`x)
	=> #case translate_expr(x,sch,stuple,size)
	   | tuple_reference(`v,`n,_)
		=> return internal("referencep",Cons(v,Cons(n,Nil)));
	   | _ => odmg_error("wrong reference testing",e);
	   #end;
  | valuep(`x)
	=> #case translate_expr(x,sch,stuple,size)
	   | tuple_value(`v,`n,_)
		=> return internal("valuep",Cons(v,Cons(n,Nil)));
	   | _ => odmg_error("wrong value testing",e);
	   #end;
  | element(`u)
	=> { Expr tp = type(e,sch);
	     Expr ret;
	     #case translate_stream_opr(u,sch,stuple)
	     | assign(...r,`x)
		 => ret = import_value(#<assign(...r,`(internal("single_element",Cons(x,Nil))))>,tp);
	     | `x => ret = import_value(internal("single_element",Cons(x,Nil)),tp);
	     #end;
	     if (is_class(tp))
		return #<tuple_reference(`ret,0,`tp)>;
	     else return #<tuple_value(`ret,0,`tp)>;
	   };
  | first(`u)
	=> { Expr tp = type(e,sch);
	     Expr ret;
	     #case translate_stream_opr(u,sch,stuple)
	     | assign(...r,`x)
		 => ret = import_value(#<assign(...r,`(internal("first_element",Cons(x,Nil))))>,tp);
	     | `x => ret = import_value(internal("first_element",Cons(x,Nil)),tp);
	     #end;
	     if (is_class(tp))
		return #<tuple_reference(`ret,0,`tp)>;
	     else return #<tuple_value(`ret,0,`tp)>;
	   };
  | last(`u)
	=> { Expr tp = type(e,sch);
	     Expr ret;
	     #case translate_stream_opr(u,sch,stuple)
	     | assign(...r,`x)
		 => ret = import_value(#<assign(...r,`(internal("last_element",Cons(x,Nil))))>,tp);
	     | `x => ret = import_value(internal("last_element",Cons(x,Nil)),tp);
	     #end;
	     if (is_class(tp))
		return #<tuple_reference(`ret,0,`tp)>;
	     else return #<tuple_value(`ret,0,`tp)>;
	   };
  | assign(...binds,`e)
	=> {  new_active_stream();
	      for(list<Expr>* r = binds; r->consp(); r=r->tl)
		 #case r->hd
		 | bind(`v,`u,`tp)
			=> {  sch = sch->extend(v->name(),tp);
			      active_environment->hd = active_environment->hd->extend(v->name(),
					#<bind(`v,`(translate_expr(u,sch,stuple,stuple->length())),`tp)>);
			   };
		 | bind(`v,`u)
			=> {  Expr tp = type(u,sch);
			      sch = sch->extend(v->name(),tp);
			      active_environment->hd = active_environment->hd->extend(v->name(),
					#<bind(`v,`(translate_expr(u,sch,stuple,stuple->length())),`tp)>);
			   };
		 #end;
	      return close_active_stream(translate_expr(e,sch,stuple,stuple->length()));
	   };
  | update(project(`x,`a,`rtp),`source)
	=> { Expr dest = translate_expr(x,sch,stuple,size);
	     Expr sour = translate_expr(source,sch,stuple,size);
	     Expr tp = type(x,sch);
	     Expr nd = new_variable();
	     Expr ns = new_variable();
	     Schema nenv = sch->extend(nd->name(),tp)->extend(ns->name(),rtp);
	     list<Expr>* al = make_assignment(#<project(`nd,`a,`rtp)>,ns,rtp,nenv,stuple,size);
	     return #<block(define(`nd,`dest,`tp),define(`ns,`sour,`rtp),...al)>;
	   };
  | insert(project(`x,`a,`f(`rtp)),`source)
	=> { Expr sour = translate_expr(source,sch,stuple,size);
	     Expr tp = type(x,sch);
	     Expr ns = new_variable();
	     Schema nenv = sch->extend(ns->name(),rtp);
	     list<Expr>* al = make_insertion(#<project(`x,`a,`f(`rtp))>,ns,#<`f(`rtp)>,nenv,stuple,size);
	     return #<block(define(`ns,`sour,`rtp),...al)>;
	   };
  | delete(project(`x,`a,`f(`rtp)),`source)
	=> { Expr sour = translate_expr(source,sch,stuple,size);
	     Expr tp = type(x,sch);
	     Expr ns = new_variable();
	     Schema nenv = sch->extend(ns->name(),rtp);
	     list<Expr>* al = make_deletion(#<project(`x,`a,`f(`rtp))>,ns,#<`f(`rtp)>,nenv,stuple,size);
	     return #<block(define(`ns,`sour,`rtp),...al)>;
	   };
  | `f(...r)
	: internal_methods->in(f->name())
	=> {  list<Expr>* types = Nil;
	      for(list<Expr>* ar = r; ar->consp(); ar=ar->tl)
	 	 types = types->cons(type(ar->hd,sch));
	      types = types->reverse();
	      int loc = find_internal_method(f->name(),types,sch)->second;
	      if (loc<0)
		 odmg_error("Incompatible types for internal operation",#<`f(...types)>);
	      Expr name = f;
	      Expr tp = #<bool>;
	      for(list<pair<String,method_info*>*>* n = internal_methods->env; n->consp(); n=n->tl)
	      {  method_info* m = n->hd->second;
		 if (m->location == loc)
		 {  name = variable(m->name);
		    tp = m->parameters->hd;
		 };
	      };
	      list<Expr>* s = Nil;
	      for(; r->consp(); r=r->tl)
		 s = s->cons(translate_expr(r->hd,sch,stuple,size));
	      s = s->reverse();
	      return #<internal_call(`name,`(integer(loc)),`tp,...s)>;
	   };
  | `f(...r)
	: member(f,Nil->cons(#<REDUCE>)->cons(#<NEST>)->cons(#<MERGE>)->cons(#<UNIT>)->cons(#<ZERO>))
        => { Expr se = translate_stream_opr(e,sch,stuple,false,false);
	     Expr ne = se;
	     bool streamp = false;
	     #case se
	     | stream(_) => streamp = true; ne = se;
	     | assign(...r,stream(`s)) => streamp = true; ne = #<stream(`s)>;
	     #end;
	     if (!streamp)
		return ne;
	     Expr tp = type(e,sch);
	     #case tp
	     | `f(scope(`etp)) => tp = #<`f(`etp)>;
	     #end;
	     Expr res;
	     #case tp
	     | `f(`etp)
		: collectionp(f)
		=> {  Expr size = integer(round_size(size_in_bytes(etp)));
		      Expr eq = generate_equality(etp,etp,#<value(x,`etp)>,#<value(y,`etp)>);
		      Expr eqf = #<lambda(bool,bind(x,`etp),bind(y,`etp),`eq)>;
		      Expr up = (f->eq(#<set>)) ? #<true> : #<false>;
		      if (is_class(etp))
			 res = internal("collect_references",Cons(ne,Cons(up,Cons(eqf,Nil))));
		      else res = internal("collect_values",Cons(ne,Cons(size,Cons(up,Cons(eqf,Nil)))));
		   };
	     #end;
	     #case se
	     | assign(...r,stream(_)) => return #<assign(...r,`res)>;
	     | _ => return res;
	     #end;
	   };
  | `f(...r)
	=> { list<Expr>* s = Nil;
	     for(; r->consp(); r=r->tl)
		s = s->cons(translate_expr(r->hd,sch,stuple,size));
	     s = s->reverse();
	     return #<`f(...s)>;
	   };
  | _ : (e->variablep() && constantp(e))
      => {  #case get_declaration_binding(e->name())
	    | constant(scope(`type),`cname,`value)
		=> return translate_expr(value,sch,stuple,size);
	    | constant(`type,`cname,`value)
		=> return translate_expr(value,sch,stuple,size);
	    #end;
	 };
  | _ => if (e->variablep())
	 {  if (size < 0)
	       #case type(e,sch)
	       | void(`etp)
		   => return #<value(`e,`etp)>;
	       | _ => return e;
	       #end;
	    int i = 0;
	    for(Names n = stuple->names(); n->consp(); n=n->tl, i++)
	       if (n->hd->eq(e->name()))
	       {  Expr index = integer((i<size) ? i : i-size);
		  Expr source = (i<size) ? #<x> : #<y>;
		  Expr tp = type(e,sch);
		  if (is_class(tp))
		     return #<tuple_reference(`source,`index,`tp)>;
		  else return #<tuple_value(`source,`index,`tp)>;
	       };
	    #case find_scoped_variable(e->name())
	    | none => return e;
	    | `tp => return #<scoped_variables(`(integer(scoped_variable_location(e->name()))),`tp)>;
	    #end;
	 }
	 else return e;
  #end;
};


Expr generate_predicate ( Expr pred, Schema sch, Schema stuple, int size ) {
  Expr pred_code = translate_expr(pred,sch,stuple,size);
  list<Expr>* fv = expr_variables(pred);
  Expr test = #<true>;
  int i = 0;
  for(list<String>* s = stuple->names(); s->consp(); s=s->tl, i++)
     if (member(variable(s->hd),fv))
     {  Expr vtype = stuple->find(s->hd);
	Expr v = variable(s->hd);
	if (is_class(vtype))
	   if (test->eq(#<true>))
	      test = #<referencep(`v)>;
	   else test = find_binary_function("and",#<boolean>,test,#<referencep(`v)>);
	else if (test->eq(#<true>))
	      test = #<valuep(`v)>;
	   else test = find_binary_function("and",#<boolean>,test,#<valuep(`v)>);
     };
  if (test->eq(#<true>))
     return pred_code;
  else return #<if(`(translate_expr(test,sch,stuple,size)),`pred_code,false)>;
};


Expr transl_tuple ( Expr e, Schema sch, Schema stuple, int size ) {
   Expr nt = internal("null_tuple",Nil);
   #case e
   | pair(`x,`y)
	=> return internal("concat_tuples",
			   Cons(transl_tuple(x,sch,stuple,size),
				Cons(transl_tuple(y,sch,stuple,size),Nil)));
   | _  : (e->variablep() && stuple->in(e->name()))
	=> {  Expr ne = translate_expr(e,sch,stuple,size);
	      Expr at = (is_class(type(e,sch))) ? #<new_tuple_reference(`ne)> : #<new_tuple_value(`ne)>;
	      #case ne
	      | tuple_reference(`x,`n,...r)
			=> return #<if(`(internal("referencep",Cons(x,Cons(n,Nil)))),`at,`nt)>;
	      | tuple_value(`x,`n,...r)
			=> return #<if(`(internal("valuep",Cons(x,Cons(n,Nil)))),`at,`nt)>;
	      | `e => odmg_error("invalid tuple",e);
	      #end;
	   };
   | project(`x,...r)
	: (x->variablep() && stuple->in(x->name()))
	=> {  Expr ne = translate_expr(e,sch,stuple,size);
	      Expr at = (is_class(type(e,sch))) ? #<new_tuple_reference(`ne)> : #<new_tuple_value(`ne)>;
	      #case ne
	      | `f(...m,tuple_reference(`x,`n,...s),...r)
			=> return #<if(`(internal("referencep",Cons(x,Cons(n,Nil)))),`at,`nt)>;
	      | `f(...m,tuple_value(`x,`n,...s),...r)
			=> return #<if(`(internal("valuep",Cons(x,Cons(n,Nil)))),`at,`nt)>;
	      | `e => return at;
	      #end;
	   };
   | _  => { Expr tp = type(e,sch);
	     Expr ne = translate_expr(e,sch,stuple,size);
	     if (is_class(tp))
	        return #<new_tuple_reference(`ne)>;
	     else return #<new_tuple_value(`ne)>;
	   };
   #end;
};


Expr translate_tuple ( Expr e, Schema sch, Schema stuple, int size ) {
  return transl_tuple(e,sch,stuple,size);
};


Expr type_key ( Expr tp, Expr e, Schema sch, Schema stuple, int len ) {
   #case tp
   |  integer => return #<simple_type_to_key(`e,`tp)>;
   |  short => return #<simple_type_to_key(`e,`tp)>;
   |  long => return #<simple_type_to_key(`e,`tp)>;
   |  real => return #<simple_type_to_key(`e,`tp)>;
   |  float => return #<simple_type_to_key(`e,`tp)>;
   |  boolean => return #<simple_type_to_key(`e,`tp)>;
   |  string => return #<simple_type_to_key(`e,`tp)>;
   |  scope(`tp) : is_class(tp)
	   => return #<simple_type_to_key(`e,`tp)>;
   |  scope(`v) : v->variablep()
	   => return type_key(get_declaration_binding(v->name()),e,sch,stuple,len);
   |  `f(`etp)
	   : collectionp(f)
	   => { Expr nv = new_variable();
		Expr nw = new_variable();
		Expr head = type_key(etp,nv,sch->extend(nv->name(),etp),(new binding<Expr>)->extend(nv->name(),etp),1);
		return #<REDUCE(concat,TABLE_SCAN(list,`e,`nv,and()),`nw,`head,and())>;
	      };
   |  struct(...r)
	   => { Expr res = NULL;
		for(; r->consp(); r=r->tl)
		   #case r->hd
		   | bind(`v,`etp)
			=> { Expr ns = type_key(etp,#<project(`e,`v,`etp)>,sch,stuple,len);
			     if (res)
			        res = #<concat_keys(`res,`ns)>;
			     else res = ns;
			   };
		   #end;
		return res;
	      };
   |  union(`nm,`etp,...r)
	   => { list<Expr>* ns = Nil;
		for(; r->consp(); r=r->tl)
		   #case r->hd
		   | case(`etp,`dcl,...cs)
			=> { list<Expr>* tags = Nil;
			     for(; cs->consp(); cs=cs->tl)
				tags = tags->cons(cs->hd->arguments()->hd);
			     Expr ne = type_key(etp,#<project(`e,`dcl,`etp)>,sch,stuple,len);
			     ns = Cons(#<case(`ne,...tags)>,ns);
			   };
		   #end;
		return #<cases(`e,...ns)>;
	      };
   |  none => odmg_error("Sorry, I don't know how to handle this type as a key",tp);
   |  `v : is_class(v)
	   => return #<simple_type_to_key(`e,`tp)>;
   |  `v : v->variablep()
	   => return type_key(get_declaration_binding(v->name()),e,sch,stuple,len);
   |  _ => odmg_error("Sorry, I don't know how to handle this type as a key",tp);
   #end;
};


Expr simple_type_to_key ( Expr e, Expr tp ) {
   #case tp
   |  integer => return internal("int_to_key",Cons(e,Nil));
   |  short => return internal("int_to_key",Cons(e,Nil));
   |  long => return internal("int_to_key",Cons(e,Nil));
   |  real => return internal("real_to_key",Cons(e,Nil));
   |  float => return internal("real_to_key",Cons(e,Nil));
   |  boolean => return internal("bool_to_key",Cons(e,Nil));
   |  string => return internal("string_to_key",Cons(e,Nil));
   |  scope(`tp) : is_class(tp)
	   => return internal("oid_to_key",Cons(e,Nil));
   |  `v : is_class(v)
	   => return internal("oid_to_key",Cons(e,Nil));
   |  _ => odmg_error("Sorry, I don't know how to handle this type as a key",tp);
   #end;
};


Expr map_to_key ( Expr e, Schema sch, Schema stuple, int len ) {
  #case e
  | pair(`x,`y)
	=> return internal("concat_keys",Cons(map_to_key(x,sch,stuple,len),Cons(map_to_key(y,sch,stuple,len),Nil)));
  | _ => return translate_expr(type_key(type(e,sch),e,sch,stuple,len),sch,stuple,len);
  #end;
};


Expr map_to_key_desc ( Expr e, Schema sch, Schema stuple, int len ) {
  return internal("inverse_string",Cons(map_to_key(e,sch,stuple,len),Nil));
};


/* create a search key */
Expr translate_key ( Expr order, Schema sch, Schema stuple, int len ) {
  #case order
  | order(...r)
	=> { Expr res;
	     #case r->hd
	     | desc(`e)
		  => res = map_to_key_desc(e,sch,stuple,len);
	     | `e => res = map_to_key(e,sch,stuple,len);
	     #end;
	     for(r=r->tl; r->consp(); r=r->tl)
		#case r->hd
		| desc(`e)
		     => res = internal("concat_keys",Cons(res,Cons(map_to_key_desc(e,sch,stuple,len),Nil)));
		| `e => res = internal("concat_keys",Cons(res,Cons(map_to_key(e,sch,stuple,len),Nil)));
		#end;
	     return res;
	   };
  | _ => odmg_error("no such order",order);
  #end;
};


Expr type_cmp ( Expr tp, Expr x, Expr y, Schema sch, Schema stuple, int len ) {
   #case tp
   |  integer => return #<simple_type_to_cmp(`x,`y,int)>;
   |  short => return #<simple_type_to_cmp(`x,`y,int)>;
   |  long => return #<simple_type_to_cmp(`x,`y,int)>;
   |  real => return #<simple_type_to_cmp(`x,`y,float)>;
   |  float => return #<simple_type_to_cmp(`x,`y,float)>;
   |  boolean => return #<simple_type_to_cmp(`x,`y,bool)>;
   |  string => return #<simple_type_to_cmp(`x,`y,string)>;
   |  scope(`tp) : is_class(tp)
	   => return #<simple_type_to_cmp(`x,`y,oid)>;
   |  scope(`v) : v->variablep()
	   => return type_cmp(get_declaration_binding(v->name()),x,y,sch,stuple,len);
   |  `f(`etp)
	   : collectionp(f)
	   => { Expr nv = new_variable();
		Expr nw = new_variable();
                return #<simple_type_to_cmp(REDUCE(sum,TABLE_SCAN(list,`x,`nv,and()),`nw,1,and()),
                                            REDUCE(sum,TABLE_SCAN(list,`y,`nv,and()),`nw,1,and()),int)>;
	      };
   |  struct(...r)
	   => { Expr res = NULL;
		for(; r->consp(); r=r->tl)
		   #case r->hd
		   | bind(`v,`etp)
			=> { Expr ns = type_cmp(etp,#<project(`x,`v,`etp)>,#<project(`y,`v,`etp)>,sch,stuple,len);
			     if (res)
			        res = #<merge_cmp(`ns,`res)>;
			     else res = ns;
			   };
		   #end;
		return res;
	      };
   |  union(`nm,`etp,...r)
	   => { list<Expr>* ns = Nil;
		for(; r->consp(); r=r->tl)
		   #case r->hd
		   | case(`etp,`dcl,...cs)
			=> { list<Expr>* tags = Nil;
			     for(; cs->consp(); cs=cs->tl)
				tags = tags->cons(cs->hd->arguments()->hd);
			     Expr ne = type_cmp(etp,#<project(`x,`dcl,`etp)>,#<project(`y,`dcl,`etp)>,sch,stuple,len);
			     ns = Cons(#<case(`ne,...tags)>,ns);
			   };
		   #end;
		return #<cases(`x,...ns)>;
	      };
   |  none => odmg_error("Sorry, I don't know how to handle this type as a key",tp);
   |  `v : is_class(v)
	   => return #<simple_type_to_cmp(`x,`y,oid)>;
   |  `v : (v->variablep() && !v->eq(get_declaration_binding(v->name())))
	   => return type_cmp(get_declaration_binding(v->name()),x,y,sch,stuple,len);
   |  _ => odmg_error("Sorry, I don't know how to handle this type as a key",tp);
   #end;
};


/* create a sort comparison */
Expr translate_compare ( Expr xorder, Expr yorder, Schema sch, Schema stuple, int len ) {
  #case xorder
  | order(...r)
     => #case yorder
	| order(...s)
	=> { Expr res = NULL;
	     for(; r->consp() && s->consp(); r=r->tl, s=s->tl)
	     {  Expr nx = r->hd;
		Expr ny = s->hd;
		#case r->hd
		| desc(`e) => nx = e;
		#end;
		#case s->hd
		| desc(`e) => ny = e;
		#end;
		Expr tp = type(nx,sch);
		Expr xx = translate_expr(nx,sch,stuple,stuple->length());
		Expr yy = translate_expr(ny,sch,stuple,0);
		Expr vx = new_variable();
		Expr vy = new_variable();
		Schema nsch = sch->extend(vx->name(),tp)->extend(vy->name(),tp);
		Expr ne = type_cmp(tp,vx,vy,nsch,stuple,len);
		if (!nx->eq(r->hd))
		   ne = #<minus(`ne)>;
		Expr nres = subst_expr(vy,yy,subst_expr(vx,xx,translate_expr(ne,nsch,stuple,len)));
		if (res)
		   res = internal("merge_cmp",Cons(res,Cons(nres,Nil)));
		else res = nres;
	     };
	     return res;
	   };
	|  _ => odmg_error("no such order",yorder);
	#end;
  | _ => odmg_error("no such order",xorder);
  #end;
};


Expr translate_geq ( Expr xorder, Expr yorder, Schema sch, Schema stuple, int len ) {
  Expr cmp = translate_compare(xorder,yorder,sch,stuple,len);
  return find_binary_function("geq",#<int>,cmp,#<0>);
};


Expr translate_key ( Expr relation, list<Expr>* attributes, Schema sch, Schema stuple, int len ) {
  list<Expr>* s = Nil;
  int i = 0;
  for(list<Expr>* r = attributes; r->consp(); r=r->tl, i++)
  {  Expr e = #<project(`relation,`(r->hd))>;
     Expr tp = type(e,sch);
     s = s->cons(#<project(`relation,`(r->hd),`tp)>);
  };
  s = s->reverse();
  return translate_key(#<order(...s)>,sch,stuple,len);
};


Expr generate_groupby_var_equality ( Expr pat, Schema sch, Schema stuple ) {
  #case pat
  | pair(`x,`y)
	=> return find_binary_function("and",#<boolean>,
			generate_groupby_var_equality(x,sch,stuple),
			generate_groupby_var_equality(y,sch,stuple));
  | _ => { Expr tp = type(pat,sch);
	   if (is_class(tp))
	      return #<eq_oid(`(translate_expr(pat,sch,stuple,stuple->length())),
			      `(translate_expr(pat,sch,stuple,0)))>;
	   return generate_equality(tp,tp,
			translate_expr(pat,sch,stuple,stuple->length()),
			translate_expr(pat,sch,stuple,0));
	 };
  #end;
};


Expr translate_head_function ( list<Expr>* groups, Schema sch, Schema stuple ) {
  Expr res, s;
  Expr nt = internal("null_tuple",Nil);
  short i = 0;
  Schema aggrs = new binding<Expr>;
  for(list<Expr>* r = groups; r->consp(); r=r->tl, i++)
     #case r->hd
     | groupby(`m,`w,`hd)
	=> { Expr tp = type(hd,sch);
	     s = translate_expr(hd,sch,stuple,stuple->length());
	     if (is_class(tp))
		s = #<new_tuple_reference(`s)>;
	     else s = #<new_tuple_value(`s)>;
	     list<Expr>* fv = expr_variables(hd);
	     Expr test = #<true>;
	     int i = 0;
	     for(list<String>* k = stuple->names(); k->consp(); k=k->tl, i++)
		if (member(variable(k->hd),fv))
		{  Expr vtype = stuple->find(k->hd);
		   Expr v = variable(k->hd);
		   if (is_class(vtype))
		      if (test->eq(#<true>))
			 test = #<referencep(`v)>;
		      else test = find_binary_function("and",#<boolean>,test,#<referencep(`v)>);
		   else if (test->eq(#<true>))
			  test = #<valuep(`v)>;
		   else test = find_binary_function("and",#<boolean>,test,#<valuep(`v)>);
		};
	     if (!test->eq(#<true>))
		s = #<if(`(translate_expr(test,sch,stuple,stuple->length())),`s,`nt)>;
	     res = (r==groups) ? s : internal("concat_tuples",Cons(res,Cons(s,Nil)));
	   };
     #end;
  return res;
};


Expr translate_merge_function ( list<Expr>* groups, Schema sch, Schema stuple ) {
  Expr res, s;
  short i = 0;
  Expr test = #<true>;
  Schema aggrs = new binding<Expr>;
  for(list<Expr>* r = groups; r->consp(); r=r->tl, i++)
     #case r->hd
     | groupby(`m,`w,`hd)
	=> { Expr tp = type(hd,sch);
	     list<Expr>* args = Cons(#<x>,Cons(integer(i),Nil));
	     tp = collectionp(m) ? #<`m(`tp)> : tp;
	     list<Expr>* d;
	     #case tp
	     | `f(`et)
		: is_class(et) && collectionp(f)
		=> {  d = Cons(#<tuple_reference(x,`(integer(i)),`et)>,
			    Cons(#<tuple_value(y,`(integer(i)),`tp)>,Nil));
		      if (test->eq(#<true>))
			 test = internal("referencep",args);
		      else test = find_binary_function("and",#<boolean>,test,internal("referencep",args));
	           };
	     | `f(`et)
		: collectionp(f)
	        => {  d = Cons(#<tuple_value(x,`(integer(i)),`et)>,
			     Cons(#<tuple_value(y,`(integer(i)),`tp)>,Nil));
		      if (test->eq(#<true>))
			 test = internal("valuep",args);
		      else test = find_binary_function("and",#<boolean>,test,internal("valuep",args));
	           };
	     | _ => {  d = Cons(#<tuple_value(x,`(integer(i)),`tp)>,
			     Cons(#<tuple_value(y,`(integer(i)),`tp)>,Nil));
		      if (test->eq(#<true>))
			 test = internal("valuep",args);
		      else test = find_binary_function("and",#<boolean>,test,internal("valuep",args));
	           };
	     #end;
	     if (!collectionp(m))
		s = internal(fform("%s_merge",
			(tp->eq(#<float>))
			? fform("f%s",m->name()->content())
			: m->name()->content()),d);
	     else #case tp
		  | set(`etp)
			=> { Expr eq = generate_equality(etp,etp,#<x>,#<y>);
			     s = internal(fform("%s_merge",m->name()->content()),
					  d->append(Cons(#<lambda(bool,bind(x,`etp),bind(y,`etp),`eq)>,Nil)));
			   };
		  | _ => s = internal(fform("%s_merge",m->name()->content()),d);
		  #end;
	     s = #<new_tuple_value(`s)>;
	     res = (r==groups) ? s : internal("concat_tuples",Cons(res,Cons(s,Nil)));
	   };
     #end;
  return #<if(`test,`res,y)>;
};


/* group-by uses this zero function to group records */
Expr translate_zero_function ( list<Expr>* groups, Schema sch ) {
  Expr res, s;
  Schema aggrs = new binding<Expr>;
  for(list<Expr>* r = groups; r->consp(); r=r->tl)
     #case r->hd
     | groupby(`m,`w,`hd)
	=> { Expr tp = type(hd,sch);
	     if (collectionp(m))
		s = #<empty_collection(`tp,`(integer(round_size(size_in_bytes(tp,false)))))>;
	     else s = internal(fform("%s_zero",m->name()->content()),Nil);
	     s = #<new_tuple_value(`s)>;
	     res = (r==groups) ? s : internal("concat_tuples",Cons(res,Cons(s,Nil)));
	   };
     #end;
  return res;
};


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


Schema merge ( Schema x, Schema y ) {
  return x->extend(y);
};


/* translate a scoped collection variable */
Expr scan_collection_variable ( Expr e, Expr tp, Expr prefix ) {
  Expr nt;
  Expr etp;
  #case tp
  | `f(scope(`tp)) : is_class(tp)
	=> { nt = #<new_tuple_reference>;
	     etp = tp;
	   };
  | `f(scope(`tp))
	=> { nt = #<new_tuple_value>;
	     etp = tp;
	   };
  | `f(`tp) : is_class(tp)
	=> { nt = #<new_tuple_reference>;
	     etp = tp;
	   };
  | `f(`tp)
	=> { nt = #<new_tuple_value>;
	     etp = tp;
	   };
  #end;
  Expr nv = variable(new_name());
  Expr fn = (is_class(etp))
	    ? internal("access_collection_ref",Cons(#<new_tuple_value(`nv)>,Cons(#<y>,Nil)))
	    : internal("access_collection_value",Cons(nv,Cons(#<y>,Nil)));
  Expr res = internal((interpreterp ? "nested_collection_stream_with_closure" : "nested_collection_stream"),
		      Cons(#<lambda(tuple,bind(x,tuple),bind(y,int),`fn)>,Cons(prefix,Nil)));
  return #<assign(bind(`nv,`e,`tp),`res)>;
};


Expr translate_opr ( Expr e, Schema &sch, Schema &stuple, Expr stream_prefix, bool materializep, bool streamp ) {
  Expr res;
  #case e
  |  ZERO(`m,...r)
	=> res = #<invalid_data()>;
  |  UNIT(_,`x)
	=> {  Expr ne = translate_expr(x,sch,stuple,stuple->length());
	      #case type(x,sch)
	      | `v : v->variablep() && classp(v->name())
			=> return new_stream(internal("residual_ref_stream",Cons(ne,Nil)),materializep);
	      | _ => return new_stream(internal("residual_value_stream",Cons(ne,Nil)),materializep);
	      #end;
	   };
  |  MERGE(_,`x,`y)
	=> {  Schema sx = stuple;
	      Expr nx = translate_opr(x,sch,stuple,stream_prefix);
	      Expr ny = translate_opr(y,sch,sx,stream_prefix);
	      res = #<merge(`nx,`ny)>;
	   };
  |  TABLE_SCAN( `M, `table, `v, `pred )
	=> {  Expr tp = type(table,sch);
	      #case tp
	      | `f(`Aclass)
		    : Aclass->variablep() && collectionp(f)
		    => stuple = stuple->extend(new binding<Expr>(v->name(),class_name(Aclass)));
	      | `f(`etp)
		    : collectionp(f)
		    => stuple = stuple->extend(new binding<Expr>(v->name(),etp));
	      #end;
	      sch = sch->extend(stuple);
	      int len = stuple->length();
	      if (table->variablep() && extentp(table))
	      {  Expr tbl = estring(find_in_module(table)->name());
	         Expr strn = new_stream(internal("materialized_stream",Cons(tbl,Cons(stream_prefix,Nil))),false);
	         Expr fpred = translate_expr(pred,sch,stuple,len);
	         res = #<table_scan(`strn,lambda(bool,bind(x,tuple),`fpred))>;
	      } else {
	         Expr ne = translate_opr(table,sch,stuple,stream_prefix);
		 #case ne
		 | stream(_) => res = ne;
		 | _ => Expr prefix = subst_expr(#<x>,#<global_tuple>,stream_prefix);
			res = new_stream(internal("suspended_stream",
						  Cons(scan_collection_variable(ne,tp,prefix),Nil)),
					 materializep);
		 #end;
		 #case pred
		 | and() => return res;
		 | _ => { Expr fpred = translate_expr(pred,sch,stuple,len);
			  res = #<table_scan(`res,lambda(bool,bind(x,tuple),`fpred))>;
			};
		 #end;
	      };
	   };
  |  INDEX_SCAN( `M, `table, `v, `pred, `index, `low, `high )
	=> {  #case type(table,sch)
	      | `f(`Aclass)
		    : Aclass->variablep() && collectionp(f)
		    => stuple = stuple->extend(new binding<Expr>(v->name(),class_name(Aclass)));
	      | `f(`tp)
		    : collectionp(f)
		    => stuple = stuple->extend(new binding<Expr>(v->name(),tp));
	      #end;
	      sch = sch->extend(stuple);
	      int len = stuple->length();
	      Expr vlow = (low->eq(#<none>)) ? #<NULL> : map_to_key(low,sch,stuple,len);
	      Expr vhigh = (high->eq(#<none>)) ? #<NULL> : map_to_key(high,sch,stuple,len);
	      Expr strn = new_stream(internal("indexed_stream",
					      Cons(internal("find_index",
							    Cons(estring(index->name()),Nil)),
						   Cons(#<false>,
							Cons(vlow,Cons(vhigh,Cons(stream_prefix,Nil)))))),
				     false);
	      Expr fpred = translate_expr(pred,sch,stuple,len);
	      res = #<index_scan(`strn,lambda(bool,bind(x,tuple),`fpred))>;
	   };
  |  NESTED_LOOP( `M, `x, `y, `pred, `outer )
	=> {  Schema sx = stuple;
	      Schema sy = stuple;
	      Expr nx = translate_opr(x,sch,sx,stream_prefix);
	      Expr ny = translate_opr(y,sch,sy,stream_prefix,true);
	      stuple = merge(sx,sy);
	      sch = sch->extend(stuple);
	      Expr fpred = generate_predicate(pred,sch,stuple,sx->length());
	      Expr outers = (outer->eq(#<none>)) ? #<false> : #<true>;
	      Expr fkeep = #<true>;
	      if (!outer->eq(#<none>))
		 fkeep = generate_groupby_var_equality(outer,sch,stuple);
	      res = #<nested_loop(`nx,`ny,
				  lambda(bool,bind(x,tuple),bind(y,tuple),`fpred),
				  `outers,
				  lambda(bool,bind(x,tuple),bind(y,tuple),`fkeep))>;
	   };
  |  BLOCK_NESTED_LOOP( `M, `x, `y, `pred, `outer )
	=> {  Schema sx = stuple;
	      Schema sy = stuple;
	      Expr nx = translate_opr(x,sch,sx,stream_prefix);
	      Expr ny = translate_opr(y,sch,sy,stream_prefix,true);
	      stuple = merge(sx,sy);
	      Expr rx = new_stream(internal("residual_buffer",Cons(#<1000>,Cons(stream_prefix,Nil))),false);
	      sch = sch->extend(stuple);
	      Expr fpred = generate_predicate(pred,sch,stuple,sx->length());
	      Expr outers = (outer->eq(#<none>)) ? #<false> : #<true>;
	      Expr fkeep = #<true>;
	      if (!outer->eq(#<none>))
		 fkeep = generate_groupby_var_equality(outer,sch,stuple);
	      res = #<block_nested_loop(`nx,`rx,`ny,
					lambda(bool,bind(x,tuple),bind(y,tuple),`fpred),
					`outers,
					lambda(bool,bind(x,tuple),bind(y,tuple),`fkeep))>;
	   };
  |  MAP( `M, `x, `var, `pred, `outer, `path )
	=> {  Expr nx = translate_opr(x,sch,stuple,stream_prefix);
	      Expr fmap = translate_tuple(path,sch,stuple,stuple->length());
	      stuple = stuple->extend(new binding<Expr>(var->name(),type(path,sch)));
	      sch = sch->extend(stuple);
	      Expr fpred = generate_predicate(pred,sch,stuple,stuple->length());
	      Expr outers = (outer->eq(#<none>)) ? #<false> : #<true>;
	      Expr fkeep = #<true>;
	      if (!outer->eq(#<none>))
		 fkeep = generate_groupby_var_equality(outer,sch,stuple);
	      res = #<map(`nx,
			  lambda(tuple,bind(x,tuple),`fmap),
			  lambda(bool,bind(x,tuple),`fpred),
			  `outers,
			  lambda(bool,bind(x,tuple),bind(y,tuple),`fkeep))>;
	   };
  |  INDEXED_LOOP( `M, `x, INDEX_SCAN( _, `table, `v, ...r ), `pred, `outer, `index, `key )
	=> {  Expr nx = translate_opr(x,sch,stuple,stream_prefix);
	      int len = stuple->length();
	      Expr strn = new_stream(internal("indexed_stream",
				   Cons(internal("find_index",
				       Cons(estring(index->name()),Nil)),
					    Cons(#<false>,Cons(#<NULL>,Cons(#<NULL>,
						 Cons(stream_prefix,Nil)))))),
			 false);
	      #case type(table,sch)
	      | `f(`Aclass)
		    : Aclass->variablep() && collectionp(f)
		    => stuple = stuple->extend(new binding<Expr>(v->name(),class_name(Aclass)));
	      | `f(`tp)
		    : collectionp(f)
		    => stuple = stuple->extend(new binding<Expr>(v->name(),tp));
	      #end;
	      sch = sch->extend(stuple);
	      Expr fpred = generate_predicate(pred,sch,stuple,len);
	      Expr outers = (outer->eq(#<none>)) ? #<false> : #<true>;
	      Expr fkeep = #<true>;
	      if (!outer->eq(#<none>))
		 fkeep = generate_groupby_var_equality(outer,sch,stuple);
	      Expr fkey = translate_key(key,sch,stuple,stuple->length());
	      res = #<indexed_nested_loop(`nx,`strn,
					lambda(key,bind(x,tuple),`fkey),
					lambda(bool,bind(x,tuple),bind(y,tuple),`fpred),
					`outers,
					lambda(bool,bind(x,tuple),bind(y,tuple),`fkeep))>;
	   };
  |  MERGE_JOIN( `M, `x, `y, `pred, `left_key, `xorder, `yorder )
	=> {  Schema sx = stuple;
	      Schema sy = stuple;
	      Expr nx = translate_opr(x,sch,sx,stream_prefix);
	      Expr ny = translate_opr(y,sch,sy,stream_prefix);
	      stuple = merge(sx,sy);
	      sch = sch->extend(stuple);
	      Expr fpred = generate_predicate(pred,sch,stuple,sx->length());
	      Expr geq = translate_geq(xorder,yorder,sch,stuple,sx->length());
	      res = #<merge_join(`nx,`ny,
				 lambda(bool,bind(x,tuple),bind(y,tuple),`fpred),
				 lambda(bool,bind(x,tuple),bind(y,tuple),`geq),
				 `left_key)>;
	   };
  |  UNNEST( `M, `x, `v, `path, `pred, `outer )
	=> {  Expr nx = translate_opr(x,sch,stuple,stream_prefix);
	      Expr outers = (outer->eq(#<none>)) ? #<false> : #<true>;
	      Expr fkeep = #<true>;
	      if (!outer->eq(#<none>))
		 fkeep = generate_groupby_var_equality(outer,sch,stuple);
	      Expr pv = project_var(path);
	      Expr fnullp = (pv->variablep())
			    ? internal("null_element",
				       Cons(translate_expr(pv,sch,stuple,stuple->length()),Nil))
			    : #<false>;
	      Expr ctp = type(path,sch);
	      Expr tp = ctp->arguments()->hd;
	      #case tp
	      | scope(`etp) => tp = etp;
	      #end;
	      Expr fpath = (is_class(tp))
				? translate_tuple(path,sch,stuple,stuple->length())
				: translate_expr(path,sch,stuple,stuple->length());
	      stuple = stuple->extend((new binding<Expr>)->extend(v->name(),tp));
	      sch = sch->extend(stuple);
	      Expr fpred = generate_predicate(pred,sch,stuple,stuple->length());
	      Expr vpath = new_variable();
	      Expr fn = (is_class(tp))
			 ? internal("access_collection_ref",Cons(vpath,Cons(#<y>,Nil)))
			 : internal("access_collection_value",Cons(vpath,Cons(#<y>,Nil)));
	      Expr ftest = find_binary_function("eq",#<integer>,#<y>,#<0>);
	      Expr btp = (is_class(tp)) ? #<tuple> : ctp;
	      res = #<unnest(`nx,
			     lambda(tuple,bind(x,tuple),bind(y,int),assign(static_bind(`vpath,`fpath,`ftest,`btp),`fn)),
			     lambda(bool,bind(x,tuple),`fpred),
			     `outers,
			     lambda(bool,bind(x,tuple),`fnullp),
			     lambda(bool,bind(x,tuple),bind(y,tuple),`fkeep))>;
	   };
  |  NEST( `M, `x, `v, `head, `vars, `bpred, `apred )
	=> {  Expr ne = e;
	      list<Expr>* s = Nil;
	      list<Expr>* bpreds = Nil;
	      list<Expr>* apreds = Nil;
	      list<Expr>* fnullps = Nil;
	      bool stop = false;
	      do { #case ne
		   | NEST( `m, `u, `w, `hd, `vars2, and(...r), and(...l) )
			: vars->eq(vars2)
			=> { s = s->cons(#<groupby(`m,`w,`hd)>);
			     bpreds = bpreds->append(r);
			     apreds = apreds->append(l);
			     ne = u;
			   };
		   | _ => stop = true;
		   #end;
	      } while (!stop);
	      Expr nx = translate_opr(ne,sch,stuple,stream_prefix);
	      gbinds = new binding<Expr>;
	      Expr fkey = translate_tuple(vars,sch,stuple,stuple->length());
	      Expr fhead = translate_head_function(s,sch,stuple);
	      Schema new_stuple = new binding<Expr>;
	      list<Expr>* pvars = pattern_variables(vars);
	      for(list<Expr>* r = pvars->reverse(); r->consp(); r=r->tl)
		 if (r->hd->variablep())
		 {  if (!new_stuple->in(r->hd->name()))
		       new_stuple = new_stuple->extend(r->hd->name(),sch->find(r->hd->name()));
		 }
		 else {  Expr tp = type(r->hd,sch);
			 String nv = new_name();
			 new_stuple = new_stuple->extend(nv,tp);
			 gvars = Cons(Pair(r->hd,tp),gvars);
			 gbinds = gbinds->extend(nv,r->hd);
		      };
	      #case type(x,sch)
	      | `f(`tp)
		   : collectionp(f)
		   => for(Names r = type_to_schema(tp)->names(); r->consp(); r=r->tl)
		      {  Expr v = variable(r->hd);
			 if (!member(v,pvars) && sch->in(r->hd))
			 {  if (is_class(sch->find(r->hd)))
			       fnullps = fnullps->cons(#<referencep(`v)>);
			    else fnullps = fnullps->cons(#<valuep(`v)>);
			 };
		      };
	      #end;
	      Expr fnullp = translate_expr(#<and(...fnullps)>,sch,stuple,stuple->length());
	      sch = sch->extend(new_stuple);
	      Expr feq = generate_groupby_var_equality(vars,sch,new_stuple);
	      for(list<Expr>* r = s; r->consp(); r=r->tl)
		 #case r->hd
		 | groupby(`m,`w,`hd)
			=> {  Expr tp = type(hd,sch);
			      tp = collectionp(m) ? #<`m(`tp)> : tp;
			      new_stuple = new_stuple->extend(new binding<Expr>(w->name(),tp));
			   }
		 #end;
	      Expr fmerge = translate_merge_function(s,sch,stuple);
	      Expr fzero = translate_zero_function(s,sch);
	      Expr fbpred = generate_predicate(#<and(...bpreds)>,sch,stuple,stuple->length());
	      stuple = new_stuple;
	      sch = sch->extend(stuple);
	      Expr fapred = generate_predicate(#<and(...apreds)>,sch,stuple,stuple->length());
	      res = #<nest(`nx,
			   lambda(tuple,bind(x,tuple),`fhead),
			   lambda(tuple,bind(x,tuple),`fkey),
			   lambda(bool,bind(x,tuple),bind(y,tuple),`feq),
			   lambda(bool,bind(x,tuple),`fbpred),
			   lambda(bool,bind(x,tuple),`fapred),
			   lambda(bool,bind(x,tuple),`fnullp),
			   lambda(tuple,bind(x,tuple),bind(y,tuple),`fmerge),
			   `fzero)>;
	   };
  |  REDUCE( `M, `x, `v, `head, `pred )
	: collectionp(M)
	=> {  Expr nx = translate_opr(x,sch,stuple,stream_prefix);
	      int size = stuple->length();
	      Expr fpred = generate_predicate(pred,sch,stuple,size);
	      Expr fhead = translate_tuple(head,sch,stuple,size);
	      stuple = stuple->extend(new binding<Expr>(v->name(),type(head,sch)));
	      sch = sch->extend(stuple);
	      res = #<reduce(`nx,
			     lambda(bool,bind(x,tuple),`fpred),
			     lambda(tuple,bind(x,tuple),`fhead))>;
	   };
  | REDUCE( `M, ...r )
	: !collectionp(M)
	=> {  Expr nx = translate_opr(#<REDUCE( set, ...r )>,sch,stuple,stream_prefix);
	      Expr tp = type(e,sch);
	      const char* m = (tp->eq(#<float>)) ? fform("f%s",M->name()->content()) : M->name()->content();
	      list<Expr>* d = Cons(nx,Cons(internal(fform("%s_zero",m),Nil),
				   Cons(#<lambda(`tp,bind(x,`tp),bind(y,`tp),
				       `(internal(fform("%s_merge",m),
						Cons(#<x>,Cons(#<y>,Nil)))))>,Nil)));
	      return internal("aggregate",d);
	   };
  | SORT( `x, `order )
	=> { Expr nx = translate_opr(x,sch,stuple,stream_prefix);
	     Expr fcmp = translate_compare(order,order,sch,stuple,stuple->length());
	     Expr strn = new_stream(internal("sort_stream",Cons(nx,Cons(#<lambda(integer,bind(x,tuple),bind(y,tuple),`fcmp)>,Nil))),false);
	     res = #<table_scan(`strn,lambda(bool,bind(x,tuple),true))>;
	   };
  | if(`pred,`x,`y)
	: streamp
	=> {  sch = new binding<Expr>;
	      Expr npred = translate_expr(pred,sch,stuple,stuple->length());
	      Expr nx = translate_opr(x,sch,stuple,stream_prefix);
	      Expr ny = translate_opr(y,sch,stuple,stream_prefix);
	      return #<if(`npred,`nx,`ny)>;
	   };
  | assign(...binds,`e)
	=> {  new_active_stream();
	      for(list<Expr>* r = binds; r->consp(); r=r->tl)
		 #case r->hd
		 | bind(`v,`u,`tp)
			=> {  sch = sch->extend(v->name(),tp);
			      active_environment->hd = active_environment->hd->extend(v->name(),
					#<bind(`v,`(translate_expr(u,sch,stuple,stuple->length())),`tp)>);
			   };
		 | bind(`v,`u)
			=> {  Expr tp = type(u,sch);
			      sch = sch->extend(v->name(),tp);
			      active_environment->hd = active_environment->hd->extend(v->name(),
					#<bind(`v,`(translate_expr(u,sch,stuple,stuple->length())),`tp)>);
			   };
		 #end;
	      return close_active_stream(translate_opr(e,sch,stuple,stream_prefix));
	   };
  | _ : streamp
      => {  Expr ne = translate_expr(e,sch,stuple,stuple->length());
	    #case ne
	    | stream(_)
		=> return ne;
	    | _ => { Expr tp = type(e,sch);
		     res = scan_collection_variable(ne,tp,stream_prefix);
		     return new_stream(res,false);
		   };
	    #end;
	 };
  | _ => {  //sch = new binding<Expr>;
	    Expr ne = translate_expr(e,sch,stuple,stuple->length());
	    return ne;
	 };
  #end;
  #case res
  | `f(...r)
	=> res = internal(f->name()->content(),r);
  #end;
  return new_stream(internal("suspended_stream",Cons(#<lambda(tuple,`res)>,Nil)),materializep);
};


Expr translate_query ( Expr e, Schema &sch, Schema &stuple, bool streamp = true ) {
  Expr se = translate_stream_opr(e,sch,stuple,false,streamp);
  Expr ne = se;
  streamp = false;
  #case se
  | stream(_) => streamp = true; ne = se;
  | assign(...r,stream(`s)) => streamp = true; ne = #<stream(`s)>;
  #end;
  if (!streamp)
     return ne;
  Expr res;
  Expr tp = type(e,stuple);
  #case tp
	     | `f(`etp)
		: collectionp(f)
		=> {  Expr size = integer(round_size(size_in_bytes(etp)));
		      Expr eq = generate_equality(etp,etp,#<value(x,`etp)>,#<value(y,`etp)>);
		      Expr eqf = #<lambda(bool,bind(x,`etp),bind(y,`etp),`eq)>;
		      Expr up = (f->eq(#<set>)) ? #<true> : #<false>;
		      if (is_class(etp))
			 res = internal("collect_references",Cons(ne,Cons(up,Cons(eqf,Nil))));
		      else res = internal("collect_values",Cons(ne,Cons(size,Cons(up,Cons(eqf,Nil)))));
		   };
  | bag(_)
	=> if (bulk_operation(e))
	      res = internal("materialize_bag",Cons(ne,Nil));
	   else res = ne;
  | list(_)
	=> if (bulk_operation(e))
	      res = internal("materialize_list",Cons(ne,Nil));
	   else res = ne;
  | set(void(`etp))
	=> if (bulk_operation(e))
	      res = internal("materialize_set",Cons(ne,
		     Cons(#<lambda(bool,bind(x,`etp),bind(y,`etp),
				`(generate_equality(etp,etp,#<x>,#<y>)))>,Nil)));
	   else res = ne;
  | set(`etp)
	=> if (bulk_operation(e))
	      res = internal("materialize_set",Cons(ne,
		     Cons(#<lambda(bool,bind(x,`etp),bind(y,`etp),
				`(generate_equality(etp,etp,#<x>,#<y>)))>,Nil)));
	   else res = ne;
  | _ => res = ne;
  #end;
  #case se
  | assign(...r,stream(_)) => return #<assign(...r,`res)>;
  | _ => return res;
  #end;
};