/*********************************************************************************
 *
 *  Processing of ODMG ODL 2.0
 *  Copyright (c) 1999-2003 by Leonidas Fegaras, the University of Texas at
 *     Arlington. All rights reserved.
 *  Programmer: Leonidas Fegaras
 *  Date: 9/28/98
 *
 ********************************************************************************/

#ifdef LDB_SERVER
  #include <sm_vas.h>
#else
  #include <stdlib.h>
# endif

#include <stream.h>
#include <fstream.h>
#include "odl.h"

extern ofstream fout;

extern char* schema_include_file;


// the pathname of the current module
static Path current_module_path;

static bool in_method = false;

// list of current ODL declarations
static list<Expr>* current_declarations = Nil;


static Pool<Catalog>            user_catalog;
static sm_index                 user_catalog_index;
static Pool<DataRepository>     user_database;
static sm_index                 user_database_index;


void fatal_odmg_error ( const char* s, Expr x ) {
  if (x->eq(#<none>))
     eout << "*** LDB error: " << s << endl;
  else eout << "*** LDB error: " << s << ": " << x << endl;
  throw odmg_error_class(eout.str());
};

void odmg_error ( const char* s ) {
  fatal_odmg_error(s,#<none>);
};

void odmg_error ( const char* s, Expr e) {
  fatal_odmg_error(s,e);

};

void odmg_error ( const char* s, String e) {
  fatal_odmg_error(s,variable(e));
};


Path::Path () {
  context = new list<String>;
};


void Path::new_context ( String name ) {
  context = Cons(name,context);
};


void Path::exit_context () {
  if (context->consp())
     context = context->tl;
};


String Path::local ( String name ) {
  String res = name;
  for(list<String>* r = context; r->consp(); r=r->tl)
     res = new string(*r->hd + "::" + *res);
  return res;
};


String Path::clocal ( String name ) {
  String res = name;
  for(list<String>* r = context; r->consp(); r=r->tl)
     res = new string(*r->hd + "_" + *res);
  return res;
};


list<String>* Path::local_in_each_module ( String name ) {
  list<String>* res = new list<String>;
  String nm = new string("");
  for(list<String>* r = context->reverse(); r->consp(); r=r->tl)
  {  nm = new string(*nm + *r->hd + "::");
     res = Cons(new string(*nm + *name),res);
  };
  return res;
};


void initialize_current_module () {
  current_module_path = Path();
};


void set_current_module ( String name ) {
  current_module_path.new_context(name);
};

String get_local_in_path ( String name ) {
  return current_module_path.local(name);
};


Ref<UserInfo> create_user ( sm_string username, sm_string password ) {
  Pool<UserInfo> user_pool;
  sm_index user_index;
  sm_string user_index_ref;
  sm_string user_pool_ref;
  if (!ldb_sm->find_declaration(sm_string("user_pool"),user_pool_ref)
      || !ldb_sm->find_declaration(sm_string("user_index"),user_index_ref))
  {  cout << "Creating the User Database.\n";
     user_pool = Pool<UserInfo>(false);
     user_index = sm_index(false,true,sm_string("b*100"));
     oid_t up_id = user_pool.oid();
     oid_t ui_id = user_index.oid();
     ldb_sm->add_declaration(sm_string("user_pool"),sm_string((char*) &up_id,sizeof(oid_t)));
     ldb_sm->add_declaration(sm_string("user_index"),sm_string((char*) &ui_id,sizeof(oid_t)));
  } else {
     user_pool = Pool<UserInfo>(*(oid_t*) user_pool_ref.content());
     user_index = sm_index(*(oid_t*) user_index_ref.content(),false);
  };
  raw_ref uu;
  if (user_index.find(username,uu))
     odmg_error(fform("User %s already exists",username.scontent()));
  cout << "Creating user '" << username << "'.\n";
  Ref<UserInfo> u = user_pool.new_record();
  user_index.add(username,u.oid());
  u->name = username;
  u->password = password;
  user_catalog = Pool<Catalog>(false);
  user_catalog_index = sm_index(false,false,sm_string("b*100"));
  user_database = Pool<DataRepository>(false);
  user_database_index = sm_index(false,true,sm_string("b*100"));
  u->catalog = user_catalog.oid();
  u->catalog_index = user_catalog_index.oid();
  u->user_database = user_database.oid();
  u->user_database_index = user_database_index.oid();
  return u;
};


Ref<UserInfo> login ( sm_string username, sm_string password ) {
  Pool<UserInfo> user_pool;
  sm_index user_index;
  sm_string user_index_ref;
  sm_string user_pool_ref;
  if (!ldb_sm->find_declaration(sm_string("user_pool"),user_pool_ref)
      || !ldb_sm->find_declaration(sm_string("user_index"),user_index_ref))
     odmg_error("The User Database does not exist");
  user_pool = Pool<UserInfo>(*(oid_t*) user_pool_ref.content());
  user_index = sm_index(*(oid_t*) user_index_ref.content(),false);
  raw_ref uu;
  if (!user_index.find(username,uu))
     odmg_error(fform("User %s does not exist",username.scontent()));
  Ref<UserInfo> u(uu);
  if (sm_string(u->password) != password)
     odmg_error("Wrong password");
  user_catalog = Pool<Catalog>(u->catalog);
  user_catalog_index = sm_index(u->catalog_index,false);
  user_database = Pool<DataRepository>(u->user_database);
  user_database_index = sm_index(u->user_database_index,false);
  return u;
};


void print_all_declarations () {
  Ref< Catalog > decl;
  PoolScan<Catalog> scan(user_catalog);
  while ( scan.next(decl) )
  {  cout << decl.oid() << " " << sm_string(decl->name);
     cout << " " << decl->tag << " " << get_declaration_binding(decl) << endl;
  };
  scan.close();
};


list< Ref<Catalog> >* get_declarations ( String dname ) {
  list< Ref<Catalog> >* dcls = new list< Ref<Catalog> >;
  sm_string name = sm_string(dname->content());
  sm_string key;
  raw_ref decl;
  sm_index_scan scan(user_catalog_index,name,name);
  while(scan.next(key,decl))
     dcls = dcls->cons(Ref<Catalog>(decl));
  scan.close();
  return dcls;
};


Ref<Catalog> get_declaration ( String dname ) {
  list< Ref<Catalog> >* dcls = get_declarations(dname);
  if (dcls->nullp() || dcls->tl->consp())
     return sm_ref();
  return dcls->hd;
};


Expr get_declaration_binding ( Ref<Catalog> dcl ) {
  if (dcl.valid())
     return read_expr(sm_string(dcl->binding).scontent());
  else return #<none>;
};


Expr get_path_binding ( String path ) {
  for(list<Expr>* r = current_declarations; r->consp(); r=r->tl)
     #case r->hd
     | declaration(`nm,`binding)
	   : nm->name()->eq(path)
	   => return binding;
     #end;
  Ref<Catalog> dcl = get_declaration(path);
  Expr binding = (dcl.valid()) ? read_expr(sm_string(dcl->binding).scontent()) : #<none>;
  current_declarations = current_declarations->cons(#<declaration(`(variable(path)),`binding)>);
  return binding;
};


Expr get_scoped_binding ( String name ) {
  #case get_path_binding(name)
  | none => ;
  | `e => return e;
  #end;
  for(list<String>* r = current_module_path.local_in_each_module(name); r->consp(); r=r->tl)
     #case get_path_binding(r->hd)
     | none => ;
     | `e => return e;
     #end;
  return #<none>;
};


Expr get_declaration_binding ( String dname ) {
  return get_scoped_binding(dname);
};


Expr get_declaration_binding ( String dname, String cname ) {
   return get_scoped_binding(new string(*cname+"::"+*dname));
};


String expr_to_string ( Expr e ) {
  eout.reset();
  e->write(eout);
  eout.flush();
  return new string(eout.str());
};


Ref<Catalog> store_declaration ( String name, const type_tag tag, Expr binding, bool duplicate_error ) {
  list< Ref<Catalog> >* dcls = get_declarations(name);
  Ref<Catalog> ref;
  if (dcls->consp() && duplicate_error
	&& !(dcls->tl->nullp() && dcls->hd->tag == forward_dcl))
     odmg_error("duplicate declaration",name);
  else if (dcls->consp())
	  if (dcls->tl->nullp())
	  {  user_catalog_index.remove(sm_string(name->content()),dcls->hd.oid());
	     user_catalog.remove(dcls->hd);
	  } else odmg_error("ambiguous declaration",name);
  ref = user_catalog.new_record();
  user_catalog_index.add(sm_string(name->content()),ref.oid());
  ref->name = name->content();
  ref->tag = tag;
  ref->binding = sm_string(expr_to_string(binding)->content());
  ref->module = sm_string(current_module_path.local(new string(""))->content());
  sm_string bs = sm_string(expr_to_string(binding)->content());
  if (sm_string(ref->binding) != bs)
     ref->binding = bs;
  current_declarations = current_declarations->cons(#<declaration(`(variable(name)),`binding)>);
  ldb_sm->commit_transaction();
  ldb_sm->begin_transaction();
  return ref;
};


Ref<Catalog> store_local_declaration ( String name, const type_tag tag, Expr binding, bool duplicate_error = true ) {
  return store_declaration(current_module_path.local(name),tag,binding,duplicate_error);
};


Ref<DataRepository> get_data_entry ( String pathname ) {
  raw_ref ref;
  if (user_database_index.find(sm_string(pathname->content()),ref))
     return Ref<DataRepository>(ref);
  else return sm_ref();
};


Ref<DataRepository> new_extent ( String pathname, String classname ) {
  sm_file pool(false);
  Ref<DataRepository> ref = user_database.new_record();
  ref->tag = extent_entry;
  ref->name = sm_string(pathname->content());
  ref->class_name = sm_string(classname->content());
  ref->module = sm_string(current_module_path.local(new string(""))->content());
  ref->cardinality = 0;
  ref->size = 0;
  ref->oid = pool.oid();
  user_database_index.add(sm_string(ref->name),ref.oid());
  return ref;
};


Ref<DataRepository> new_index ( String pathname, String classname, bool uniquep ) {
  sm_index ind(false,uniquep,sm_string("b*100"));
  Ref<DataRepository> ref = user_database.new_record();
  ref->tag = index_entry;
  ref->name = sm_string(pathname->content());
  ref->class_name = sm_string(classname->content());
  ref->module = sm_string(current_module_path.local(new string(""))->content());
  ref->cardinality = 0;
  ref->size = 0;
  ref->oid = ind.oid();
  ref->uniquep = uniquep;
  user_database_index.add(sm_string(ref->name),ref.oid());
  return ref;
};


list<Expr>* class_keys ( Expr e ) {
  #case e
  | class(`cname,scope(...es),inherits(...inhr),extent(...ext),keys(...keys),...body)
	=> if (es->nullp())
	      return keys;
	   else return keys->append(class_keys(get_scoped_binding(es->hd->name())));
  | _ => return Nil;
  #end;
};


void import_module ( String module_name ) {
  cout << "Importing module " << module_name << endl;
  sm_string key;
  raw_ref ref;
  sm_string low = sm_string(module_name->content());
  sm_string high = low + ":_";
  sm_index_scan scan(user_catalog_index,low,high);
  while(scan.next(key,ref))
  {  Ref<Catalog> cref(ref);
     String name = new string(sm_string(cref->name).scontent());
     user_catalog_index.add(sm_string(name->content()),ref);
     Expr decl = get_declaration_binding(cref);
     #case decl
     | class(`cname,scope(...es),inherits(...inhr),extent(...ext),keys(...keys),...body)
	  => {  sm_file f(false);
		int i = 0;
		for(list<Expr>* r = class_keys(decl); r->consp(); r=r->tl, i++)
		{  sm_index(true,true,sm_string("i4"));
		};
	     };
     #end;
     current_declarations = current_declarations->cons(#<declaration(`(variable(name)),`decl)>);
   };
  scan.close();
};


String scoped_name ( Expr e ) {
  #case e
  | scope(...r,`x) => return x->name();
  | _ => odmg_error("Illegal scope",e);
  #end;
};


void print_scoped_name ( Expr e ) {
  #case e
  | scope(...ns)
	=> { fout << ns->hd;
	     for(list<Expr>* r = ns->tl; r->consp(); r=r->tl)
		fout << "::" << r->hd;
	   };
  | _ => fout << e;
  #end;
};


void print_inherits ( list<Expr>* inhs ) {
  if (inhs->consp())
  {  fout << ": ";
     for(list<Expr>* r = inhs; r->consp(); r=r->tl)
     {  fout << "public ";
	print_scoped_name(r->hd);
	if (r->tl->consp())
	   fout << ", ";
     };
  };
};


void print_expr (Expr e);


void print_declarators ( list<Expr>* dcls ) {
  for(list<Expr>* r = dcls; r->consp(); r=r->tl)
  {  #case r->hd
     | array(`v,`n)
	   => { fout << v << "[";
		print_expr(n);
		fout << "]";
	      };
     | array(`v,...s)
	   => odmg_error("can't handle arrays of multiple dimensions",r->hd);
     | `e => fout << e;
     #end;
     if (r->tl->consp())
	fout << ", ";
   };
};


bool classp ( String name ) {
  for(list<String>* r = Cons(name,current_module_path.local_in_each_module(name)); r->consp(); r=r->tl)
     for(list< Ref<Catalog> >* dcls = get_declarations(r->hd); dcls->consp(); dcls=dcls->tl)
        if (dcls->hd->tag == class_dcl || dcls->hd->tag == forward_dcl)
	   return true;
  return false;
};


bool member ( String s, list<String>* r ) {
  if (r->consp())
     return s->eq(r->hd) || member(s,r->tl);
  else return false;
};


bool needs_alloc ( Expr tp ) {
  #case tp
  | set(_)  => return true;
  | bag(_)  => return true;
  | list(_)  => return true;
  | struct(...r) => return true;
  | scope(`nm) : nm->variablep()
      => #case get_scoped_binding(nm->name())
         | typedef(`type,_)
              => return needs_alloc(type);
         | _ => return false;
         #end;
  | _ => return false;
  #end;
};


void print_type ( Expr e );


void print_alloc ( Expr name, Expr type ) {
  #case type
  | scope(`nm) : nm->variablep()
      => #case get_scoped_binding(nm->name())
         | typedef(`tp,_)
		=> print_alloc(name,tp);
	 | _ => fout << name << "._alloc(); ";
	 #end;
  | `f(`etp)
	=> {  fout << name << ".element_size = sizeof(";
	      print_type(etp);
	      fout << "); ";
	   };
  | _ => fout << name << "._alloc(); ";
  #end;
};


void create_alloc ( list<Expr>* decls ) {
  return;
  fout << "void _alloc () { ";
  for(list<Expr>* r=decls; r->consp(); r=r->tl)
     #case r->hd
     | attribute(`tp,none,...vars)
           : needs_alloc(tp)
           => print_alloc(vars->hd,tp);
     | attribute(`tp,...vars)
           : needs_alloc(tp)
           => print_alloc(vars->hd,tp);
     | relationship(`tp,`rname,...r)
           : needs_alloc(tp)
           => print_alloc(rname,tp);
     #end;
  fout << "}; ";
};


void print_type ( Expr e ) {
  #case e
  | struct(`name,...decls)
	=> {  fout << "struct " << name << " { ";
	      for(list<Expr>* r=decls; r->consp(); r=r->tl)
		 #case r->hd
		 | attribute(`tp,...dcls)
			=> { print_type(tp); 
			     fout << " ";
			     print_declarators(dcls);
			     fout << "; ";
			   };
		 #end;
	      create_alloc(decls->reverse());
	      fout << "}";
	    };
  | enum(`name,...vars)
	=> { fout << "enum " << name << " { " << vars->hd;
	     for(list<Expr>* r = vars->tl; r->consp(); r=r->tl)
		fout << ", " << r->hd;
	     fout << " }";
	   };
  | union(`name,`tp,...cases)
       => {  fout << "struct " << name << " { ";
             print_type(tp);
	     fout << " tag; struct { ";
	     for(list<Expr>* r = cases; r->consp(); r=r->tl)
		#case r->hd
		| case(`tp,`dcl,...cs)
			=> { print_type(tp);
			     fout << " ";
			     print_declarators(Cons(dcl,Nil));
			     fout << "; ";
			   };
		#end;
	     fout << "} value; }";
	   };
  | scope(`x)
	=> {  if (classp(x->name()))
		 if (in_method)
	         {  fout << "Ref<";
		    print_scoped_name(e);
		    fout << ">";
	         }
		 else fout << "raw_ref";
	      else print_scoped_name(e);
	   };
  | `f(`tp)
	=> if (in_method)
	   {  fout << "Sequence<";
	      print_type(tp);
	      fout << " >";
	   } else fout << "raw_sequence";
  | array(`tp,none)
	=> { fout << "Sequence< ";
	     print_type(tp);
	     fout << " >";
	   };
  | array(`tp,`n)
	=> { fout << "Vector< ";
	     print_type(tp);
	     fout << "," << n << " >";
	   };
  | set(`e)
	=> { fout << "Set< ";
	     print_type(e);
	     fout << " >";
	   };
  | bag(`e)
	=> { fout << "Bag< ";
	     print_type(e);
	     fout << " >";
	   };
  | list(`e)
	=> { fout << "Sequence< ";
	     print_type(e);
	     fout << " >";
	   };
  | unsigned_long => fout << "unsigned long";
  | unsigned_short => fout << "unsigned short";
  | integer => fout << "int";
  | string => if (in_method)
		 fout << "sm_string";
	      else fout << "raw_string";
  | _ : e->variablep()
	=> if (classp(e->name()))
	      if (in_method)
	      {  fout << "Ref<";
		 print_scoped_name(e);
		 fout << ">";
	      } else fout << "raw_ref";
	   else fout << e;
  | _ => odmg_error("I don't know how to handle the type",e);
  #end;
};


list<Expr>* get_union_tags ( Expr type ) {
  #case type
  | `e : (e->eq(#<unsigned_long>) || e->eq(#<unsigned_short>) || e->eq(#<long>) || e->eq(#<short>) || e->eq(#<string>)
	 || e->eq(#<float>) || e->eq(#<double>))
	=> return Nil;
  | scope(`tp)
	=> return get_union_tags(tp);
  | enum(`ename,...tags)
	=> return tags;
  | _ : type->variablep()
	=> #case get_scoped_binding(type->name())
	   | typedef(`tp,`nm)
		=> return get_union_tags(tp);
	   | enum(`ename,...tags)
		=> return tags;
	   | _ => odmg_error("invalid union tag type",type);
	   #end;
  | _ => odmg_error("invalid union tag type",type);
  #end;
};


void check_type ( Expr e ) {
  #case e
  | struct(`name,...r)
	=> { list<Expr>* ns = Nil;
	     for(; r->consp(); r=r->tl)
		#case r->hd
		| attribute(`tp,...vars)
			=> {  check_type(tp);
			      for(; vars->consp(); vars=vars->tl)
			         if (member(vars->hd,ns))
				    odmg_error("duplicate attribute name",vars->hd);
			         else ns = ns->cons(vars->hd);
			   };
		#end;
	   };
  | enum(`name,...vars)
	=> { list<Expr>* ns = Nil;
	     for(; vars->consp(); vars=vars->tl)
	        if (member(vars->hd,ns))
		   odmg_error("duplicate enumeration tag",vars->hd);
		else ns = ns->cons(vars->hd);
	   };
  | union(`name,`tp,...cases)
	=> { list<Expr>* ns = Nil;
	     list<Expr>* ts = Nil;
	     check_type(tp);
	     list<Expr>* utags = get_union_tags(tp);
	     for(list<Expr>* r = cases; r->consp(); r=r->tl)
		#case r->hd
		| case(`ctp,`decl,...tags)
		      => { check_type(ctp);
			   if (member(decl,ns))
			      odmg_error("duplicate union case name",decl);
			   else ns = ns->cons(decl);
			   for(; tags->consp(); tags=tags->tl)
			   {  Expr tag = tags->hd;
			      #case tag
			      | scope(`v) => tag = v;
			      #end;
			      if (utags->nullp() && !tag->eq(#<default>) && !tag->integerp())
				 odmg_error("expected an integer case tag",tag);
			      else if (utags->consp() && !tag->eq(#<default>) && !member(tag,utags))
				 odmg_error("invalid case tag",tag);
			      else if (member(tag,ts))
				 odmg_error("duplicate union case tag",tag);
			      else ts = ts->cons(tag);
			   };
			 };
		#end;
	   };
  | scope(`tp)
	=> check_type(tp);
  | array(`tp,_)
	=> check_type(tp);
  | `f(`tp)
	=> check_type(tp);
  | _ : e->variablep()
	=> if (e->eq(#<unsigned_long>) || e->eq(#<unsigned_short>) || e->eq(#<long>) || e->eq(#<short>) || e->eq(#<string>)
		 || e->eq(#<float>) || e->eq(#<double>) || e->eq(#<void>))
	      ;
	   else if (e->eq(#<date>) || e->eq(#<time>) || e->eq(#<interval>) || e->eq(#<timestamp>))
	      odmg_error("Temporal features are not supported in SDL",e);
	   else if (!classp(e->name()))
		   #case get_scoped_binding(e->name())
		   | typedef(`tp,`nm)
		       => check_type(tp);
		   | none => odmg_error("invalid type name",e);
		   #end;
  | _ => odmg_error("I don't know how to handle the type",e);
  #end;
};


const char* binary_opr ( Expr e ) {
  #case e
  | plus => return "+";
  | minus => return "-";
  | div => return "/";
  | times => return "*";
  | mod => return "%";
  | or => return "|";
  | and => return "&";
  | xor => return "^";
  | shift_right => return ">>";
  | shift_left => return "<<";
  #end;
};


void print_expr ( Expr e ) {
  #case e
  | scope(...r) => print_scoped_name(e);
  | plus(`x) => print_expr(x);
  | minus(`x) => { fout << "-("; print_expr(x); fout << ")"; };
  | not(`x) => { fout << "~("; print_expr(x); fout << ")"; };
  | `f(`x,`y) => { fout << "("; print_expr(x); fout << binary_opr(f);
		   print_expr(y); fout << ")"; };
  | _ => fout << e;
  #end;
};


void print_class_accessors ( String cname, String in_class ) {
  #case get_declaration_binding(cname)
  | class(`name,scope(...exc),inherits(...inhr),extent(...ext),keys(...keys),...decls)
	=> { if (exc->consp())
	        print_class_accessors(scoped_name(#<scope(...exc)>),in_class);
	     in_method = true;
	     for(list<Expr>* body = decls; body->consp(); body=body->tl)
		#case body->hd
		| method(`type,`tname,params(...args),`x,`y)
			=> { String fname = new string("_F_" + *current_module_path.clocal(new (GC) string("")) + *tname->name());
			     fout << "\nstatic ";
			     if (type->eq(#<void>))
				fout << "void";
			     else { print_type(type); fout << "*"; };
			     fout << " " << fname
				  << " ( Ref<" << in_class << ">* x" << ((args->nullp()) ? "" : ", ");
			     for(list<Expr>* r = args; r->consp(); r=r->tl)
				#case r->hd
				| `f(`tp,`dcl)
					=> { print_type(tp);
					     fout << " *" << dcl << ((r->tl->nullp()) ? "" : ", ");
					   };
				#end;
			     if (type->eq(#<void>))
				fout << " ) {\n  if (x != NULL) ((*x)->" << tname << "(*x";
			     else {
			        fout << " ) {\n  if (x == NULL) return NULL; else return new (GC) ";
			        print_type(type);
				fout << "((*x)->" << tname << "(*x";
			     };
			     for(list<Expr>* r = args; r->consp(); r=r->tl)
				#case r->hd
				| `f(`tp,`dcl)
					=> fout << ",*" << dcl;
				#end;
			     fout << "));\n};\nstatic int " << fname << "_ = ( store_function(\"" << fname << "\",(void*) " << fname << ","
				  << args->length()+1 << ",0), 0 );\n";
			   };
		#end;
	};
  #end;
  in_method = false;
  fout << endl;
};


Expr class_type ( String cname );


list<String>* primary_key ( String s ) {
  list<Expr>* keys = class_keys(get_scoped_binding(s));
  if (keys->nullp())
     return new list<String>;
  else #case keys->hd
       | combine(...r)
	   => { list<String>* s = new list<String>;
		for(; r->consp(); r=r->tl)
		   s = s->cons(r->hd->name());
		return s->reverse();
	      };
       | _ => return Cons(keys->hd->name(),new list<String>);
       #end;
};


void process_definitions ( list<Expr>* r );


void process_decl ( Expr e ) {
  #case e
  | class(`cname,scope(...es),inherits(...inhr),extent(...ext),keys(...keys),...body)
	=> { String cn = current_module_path.local(cname->name());
	     store_declaration(cn,class_dcl,e);
	     fout << "\nclass " << cname;
	     if (es->nullp())
		print_inherits(inhr);
	     else print_inherits(Cons(#<scope(...es)>,inhr));
	     fout << " {\npublic:\n";
	     list<Expr>* indexes = Nil;
	     if (ext->consp())
	     {  String en = current_module_path.local(ext->hd->name());
	        store_declaration(en,extent_dcl,#<extent(`cname)>);
		new_extent(en,cn);
		/* create a unique BTree index for each key */
		int i = 0;
		for(list<Expr>* r = class_keys(e); r->consp(); r=r->tl, i++)
		{  list<Expr>* attrs;
		   #case r->hd
		   |  combine(...s) => attrs = s;
		   |  _ => attrs = Cons(r->hd,Nil);
		   #end;
		   Expr index_name = variable(new string(fform("%s_index_%i",cn->content(),i)));
		   indexes = Cons(index_name,indexes);
		   store_declaration(index_name->name(),index_dcl,
                                     #<index(`index_name,true,...attrs)>,cn);
		   new_index(index_name->name(),cn);
		};
	     };
	     current_module_path.new_context(cname->name());
	     if (ext->consp())
		store_local_declaration(new string("_class_indexes"),index_dcl,#<index(...indexes)>,false);
	     for(list<Expr>* r = body; r->consp(); r=r->tl)
		process_decl(r->hd);
	     fout << "  ";
	     create_alloc(body->reverse());
	     fout << "\n};\n";
	     fout << "static " << cname << " " << cname << "__;\n\n";
	     print_class_accessors(cname->name(),cname->name());
	     current_module_path.exit_context();
	   };
  | interface(`iname,inherits(...inhr),...body)
	=> { Ref<Catalog> dcl = store_local_declaration(iname->name(),interface_dcl,e);
	     fout << "\ninterface " << iname;
	     print_inherits(inhr);
	     fout << " {\npublic:\n";
	     for(list<Expr>* r = body; r->consp(); r=r->tl)
		#case r->hd
		| attribute(...r)
			=> odmg_error("attributes are not allowed in interface declarations");
		| relationship(...r)
			=> odmg_error("relationships are not allowed in interface declarations");
		| _ => process_decl(r->hd);
		#end;
	     fout << "};\n";
	   };
  | attribute(`type,`copies,...vars)
	=> { fout << "  ";
	     check_type(type);
	     print_type(type);
	     for(; vars->consp(); vars=vars->tl)
	     {  store_local_declaration(vars->hd->name(),attribute_dcl,e);
		fout << " " << vars->hd;
		if (!copies->eq(#<none>))
		{  fout << "[";
		   print_expr(copies);
		   fout << "]";
		};
		if (vars->tl->consp())
		   fout << ",";
	     };
	     fout << ";\n";
	   };
  | relationship(`type,`rname,`inv)
	=> { store_local_declaration(rname->name(),relationship_dcl,e);
	     check_type(type);
	     fout << "  ";
	     check_type(type);
	     print_type(type);
             fout << " " << rname;
	     fout << ";\n";
	   };
  | constant(`type,`cname,`value)
	=> { store_local_declaration(cname->name(),constant_dcl,e);
	     check_type(type);
	     fout << "\nconst ";
	     print_type(type);
	     fout << " " << cname << " = ";
	     print_expr(value);
	     fout << ";\n";
	   };
  | typedef(`type,array(`tname,...dims))
	=> { store_local_declaration(tname->name(),typedef_dcl,e);
	     check_type(type);
	     fout << "\ntypedef ";
	     print_type(type);
	     fout << " " << tname << "[";
	     for(list<Expr>* r=dims; r->consp(); r=r->tl)
	     {  print_expr(r->hd);
		if (r->tl->consp()) fout << ",";
	     };
	     fout << "];\n";
	   };
  | typedef(`type,`tname)
	=> { store_local_declaration(tname->name(),typedef_dcl,e);
	     check_type(type);
	     fout << "\ntypedef ";
	     print_type(type);
	     fout << " " << tname << ";\n";
	   };
  | struct(`sname,...members)
	=> { list<Expr>* s = Nil;
	     fout << endl;
	     check_type(e);
	     for(list<Expr>* r = members; r->consp(); r=r->tl)
		#case r->hd
		| attribute(`tp,...vars)
			=> for(; vars->consp(); vars=vars->tl)
			      s = s->cons(#<bind(`(vars->hd),`tp)>);
		#end;
	     s = s->reverse();
	     store_local_declaration(sname->name(),typedef_dcl,#<typedef(struct(`sname,...s),`sname)>);
	     print_type(e);
	     fout << ";\n";
	   };
  | union(`tname,`type,...cases)
	=> { store_local_declaration(tname->name(),union_dcl,e);
	     fout << endl;
	     check_type(e);
	     print_type(e);
	     fout << ";\n";
	   };
  | enum(`ename,...tags)
	=> { store_local_declaration(ename->name(),enum_dcl,e);
	     fout << endl;
	     check_type(e);
	     int i = 0;
	     for(list<Expr>* r = tags; r->consp(); r=r->tl, i++)
		store_local_declaration(r->hd->name(),constant_dcl,#<constant(`ename,`(r->hd),`(integer(i)))>);
	     print_type(e);
	     fout << ";\n";
	   };
  | method(`type,`tname,params(...r),`x,`y)
	=> { in_method = true;
	     store_local_declaration(tname->name(),method_dcl,e);
	     fout << "  ";
	     check_type(type);
	     print_type(type);
	     fout << " " << tname << " ( Ref<" << current_module_path.current() << "> this_ref";
	     for(; r->consp(); r=r->tl)
		#case r->hd
		| `f(`tp,`dcl)
	                => { fout << ", ";
			     if (f->eq(variable(new string("in"))))
				fout << "const ";
			     check_type(tp);
			     print_type(tp);
			     fout << " ";
			     if (f->eq(#<out>) || f->eq(#<inout>))
				 fout << "&";
			     print_declarators(Cons(dcl,Nil));
			   };
		#end;
	     fout << " );\n";
	     in_method = false;
	   };
  | forward(`name)
	=> { store_local_declaration(name->name(),forward_dcl,e);
	     fout << "\nclass " << name << ";\n";
	   };
  | import(...r)
	=> ;
  | module(...r)
	=> process_definitions(Cons(e,Nil));
  | _ => odmg_error("I don't know how to handle",e);
  #end;
};


void remove_module ( String module_name ) {
/*
  cout << "This will destroy all the data in module " << module_name << ". Proceed? ";
  char c;
  cin >> c;
  if (c != 'y')
     throw odmg_error_class("Better Luck Next Time!");
*/
  Ref<Catalog> decl;
  PoolScan<Catalog> scan(user_catalog);
  sm_string mn = sm_string(fform("%s::",module_name->content()));
  int ms = module_name->length()+2;
  while ( scan.next(decl) )
     if (sm_string(decl->name).substring(0,ms) == mn)
     {  user_catalog_index.remove(sm_string(decl->name),decl.oid());
	user_catalog.remove(decl);
     };
  scan.close();
  PoolScan<DataRepository> dscan(user_database);
  Ref<DataRepository> dcl;
  while ( dscan.next(dcl) )
     if (sm_string(dcl->name).substring(0,ms) == mn)
     {  if (dcl->tag == extent_entry)
	   sm_file(dcl->oid).delete_file();
	else sm_index(dcl->oid,false).delete_index();
	user_database_index.remove(sm_string(dcl->name),dcl.oid());
	user_database.remove(dcl);
     };
  dscan.close();
};


void process_definitions ( list<Expr>* r ) {
  for(; r->consp(); r=r->tl)
     #case r->hd
     | module(`mname,...specs)
	=> { for(list< Ref<Catalog> >* decls = get_declarations(mname->name()); decls->consp(); decls=decls->tl)
		if (decls->hd->tag == module_dcl)
		{  remove_module(mname->name());
		   user_catalog_index.remove(sm_string(mname->name()->content()),decls->hd.oid());
		   user_catalog.remove(decls->hd);
		};
	     current_module_path.new_context(mname->name());
	     store_declaration(current_module_path.local(new string("_file_name")),
			       class_file_dcl,estring(new string(schema_include_file)),false);
	     store_declaration(mname->name(),module_dcl,mname,false);
	     fout << "#ifndef " << mname << "_module\n#define " << mname << "_module 1\n\n";
	     for(list<Expr>* s = specs; s->consp(); s=s->tl)
		#case s->hd
	        | import(...path)
			=> { string s = "";
			     for(list<Expr>* r=path; r->consp(); r=r->tl)
				s = s + "_" + *r->hd->name();
			     import_module(new string(s));
			   };
		#end;
	     for(list<Expr>* s = specs; s->consp(); s=s->tl)
		#case s->hd
		| class(`name,...n)
			=> { store_local_declaration(name->name(),forward_dcl,name);
			     fout << "class " << name << ";\n";
			   };
		| interface(`name,...n)
			=> { store_local_declaration(name->name(),forward_dcl,name);
			     fout << "interface " << name << ";\n";
			   };
		#end;
	     fout << endl;
	     for(list<Expr>* s = specs; s->consp(); s=s->tl)
		process_decl(s->hd);
	     current_module_path.exit_context();
	     fout << "#endif\n";
	   };
     | _ => process_decl(r->hd);
     #end;
};


void process_definition ( const char* definition ) {
//  current_module_path.exit_context();
  process_definitions(Cons(read_expr(definition),Nil));
};


Expr find_attribute_type ( String attr, String cname, String &iname ) {
  #case get_declaration_binding(cname)
  | class(`name,scope(...exc),inherits(...inhr),extent(...ext),keys(...keys),...body)
	=> { for(; body->consp(); body=body->tl)
		#case body->hd
		| attribute(`type,`copies,...vars)
			=> for(; vars->consp(); vars=vars->tl)
			      if (vars->hd->name()->eq(attr))
			      {  iname = cname;
				 return type;
			      };
		| relationship(`tp,`name,...r)
			=> if (name->name()->eq(attr))
			   {  iname = cname;
			      return tp;
			   };
		#end;
	     if (exc->consp())
	     {  Expr u = find_attribute_type(attr,scoped_name(#<scope(...exc)>),iname);
		if (!u->eq(#<none>))
		   return u;
	     };
	     return #<none>;
	};
  | typedef(struct(...r),_)
	=> { for(; r->consp(); r=r->tl)
		#case r->hd
		| bind(`nm,`tp)
			: (*cname+"::"+*nm->name()).eq(attr)
			=> return tp;
		#end;
	        return #<none>;
	   };
  | _ => return #<none>;
  #end;
};


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


Expr extent_type ( String ename ) {
    #case get_scoped_binding(ename)
    | extent(`v) : v->variablep()
	=> return v;
    | _ => return #<none>;
    #end;
};


bool extentp ( Expr x ) {
  if (x->variablep())
  {  for(list<String>* r = current_module_path.local_in_each_module(x->name()); r->consp(); r=r->tl)
     {  Ref<DataRepository> d = get_data_entry(r->hd);
	if (d.valid())
	   return d->tag == extent_entry;
     };
     return false;
  };
  return false;
};


bool constantp ( Expr x ) {
  if (x->variablep()) 
  {  for(list<String>* r = current_module_path.local_in_each_module(x->name()); r->consp(); r=r->tl)
     {  Ref<Catalog> d = get_declaration(r->hd);
	if (d.valid())
	   return d->tag == constant_dcl;
     };
     return false;
  };
  return false;
};


Expr find_in_module ( Expr nm ) {
  return variable(current_module_path.local(nm->name()));
};


Expr get_class_extent ( Expr x ) {
  if (x->variablep())
     #case get_scoped_binding(x->name())
     | class(`name,`extends,inherits(...inhr),extent(`ext),keys(...keys),...body)
		=> return find_in_module(ext);
     | _ => return #<none>;
     #end;
  return #<none>;
};


bool subclass ( String x, String y ) {
  if (x->eq(y))
     return true;
  #case get_scoped_binding(x)
  |  class(`v,scope(),inherits(...inhr),...s)
	=> if (v->name()->eq(y))
	      return true;
	   else {  for(list<Expr>* r = inhr; r->consp(); r=r->tl)
		      if (subclass(scoped_name(r->hd),y))
			 return true;
		   return false;
		};
  |  class(`v,`extends,inherits(...inhr),...s)
	=> if (v->name()->eq(y))
	      return true;
	   else {  for(list<Expr>* r = inhr->cons(extends); r->consp(); r=r->tl)
		      if (subclass(scoped_name(r->hd),y))
			 return true;
		   return false;
		};
  |  interface(`v,inherits(...inhr),...body)
	=> if (v->name()->eq(y))
	      return true;
	   else {  for(; inhr->consp(); inhr=inhr->tl)
		      if (subclass(scoped_name(inhr->hd),y))
			 return true;
		   return false;
		};
  |  _ => return false;
  #end;
};


list<String>* class_superclasses ( String class_name ) {
  #case get_scoped_binding(class_name)
  |  class(`v,scope(),...s)
	=> return new list<String>;
  |  class(`v,`extends,...s)
	=> return Cons(scoped_name(extends),class_superclasses(scoped_name(extends)));
  | _ => return new list<String>;
  #end;
};


list<String>* class_subclasses ( String class_name ) {
  list<String>* cs = new list<String>;
  sm_string name = sm_string(class_name->content());
  sm_string key;
  raw_ref d;
  sm_index_scan scan(user_catalog_index,name,name+"~");
  while(scan.next(key,d))
  {  Ref<Catalog> cd(d);
     if (cd->tag == class_dcl)
	#case get_declaration_binding(cd)
	| class(`v,scope(`n),...r)
		: n->name()->eq(class_name)
		=> cs = Cons(v->name(),cs);
	#end;
  };
  scan.close();
  list<String>* ns = cs;
  for(list<String>* r = cs; r->consp(); r= r->tl)
     ns = ns->append(class_subclasses(r->hd));
  return ns;
};


list<String>* module_classes () {
  list<String>* dcls = new list<String>;
  sm_string name = sm_string(current_module_path.local(new string(""))->content());
  sm_string key;
  raw_ref decl;
  sm_index_scan scan(user_catalog_index,name,name+"~");
  while(scan.next(key,decl))
  {  Ref<Catalog> cdecl(decl);
     if (cdecl->tag == class_dcl)
	dcls = dcls->cons(new string(sm_string(cdecl->name).scontent()));
  };
  if (!scan.eof())
     odmg_error("couldn't retrieve the module classes");
  scan.close();
  return dcls;
};


String new_secondary_index ( Expr e ) {
  #case e
  | index(`index_name,`relation,...attrs)
	=> #case class_type(relation->name())
	   | none => odmg_error("Tried to create an index on a nonexistent relation",relation);
	   | `tp => {  current_module_path.new_context(relation->name());
		       String cn = get_local_in_path(index_name->name());
		       Expr en = variable(cn);
		       store_declaration(cn,index_dcl,#<index(`en,false,...attrs)>,false);
		       String ci = new string("_class_indexes");
		       #case get_declaration_binding(ci,relation->name())
		       | none
			   => store_declaration(get_local_in_path(ci),index_dcl,#<index(`index_name)>);
		       | index(...r)
			   => if (!member(index_name,r))
				 store_declaration(get_local_in_path(ci),index_dcl,#<index(...r,`en)>,false);
		       #end;
		       current_module_path.exit_context();
		       return cn;
		     };
	    #end;
  #end;
};


// colect database statistics (eg. cardinalities) and store them in the system catalog
void collect_statistics () {
  cout << "STATISTICS:\n     class-extent        objects    Bytes\n-----------------------------------------\n";
  sm_string key;
  sm_string module = sm_string(current_module_path.local(new string(""))->content());
  Ref<DataRepository> decl;
  PoolScan<DataRepository> scan(user_database);
  while(scan.next(decl))
  if (sm_string(decl->module) == module)
  {  if (decl->tag == extent_entry)
     {  long count = 0;
        long size = 0;
	sm_file f(decl->oid);
        sm_file_scan s(f);
	sm_ref obj;
	while(s.next(obj))
	{  count++;
	   size += obj.size();
	};
	s.close();
	cout << fform("%20s%10d%10d\n",sm_string(decl->name).scontent(),count,size);
	decl->cardinality = count;
	decl->size = size;
     } else {
        long count = 0;
        long size = 0;
	sm_index f(decl->oid,decl->uniquep);
        sm_index_scan s(f,"","~");
	sm_string key;
	raw_ref obj;
	while(s.next(key,obj))
	{  count++;
	   size += ((sm_ref) obj).size();
	};
	s.close();
	decl->cardinality = count;
	decl->size = size;
     };
  };
  scan.close();
};


void tcl_print_type ( Expr e, ostream &sout ) {
  #case e
  | struct(...r)
	=> {  sout << "{struct ";
	      for(; r->consp(); r=r->tl)
		 #case r->hd
		 | bind(`nm,`tp)
			=> {  sout << "{";
			      tcl_print_type(tp,sout);
			      sout << " " << nm << "} ";
			   };
		 #end;
	      sout << "} ";
	    };
  | enum(`name,...vars)
	=> { sout << "{enum " << vars->hd;
	     for(list<Expr>* r = vars->tl; r->consp(); r=r->tl)
		sout << " " << r->hd;
	     sout << "} ";
	   };
  | union(`name,`tp,...cases)
	=> { sout << "{union " << name << " ";
	     tcl_print_type(tp,sout);
	     sout << " ";
	     for(list<Expr>* r = cases; r->consp(); r=r->tl)
		#case r->hd
		| case(`tp,`dcl,...cs)
			=> { sout << "{ {";
			     for(; cs->consp(); cs=cs->tl)
				if (cs->hd->eq(#<default>))
				   sout << "default ";
				else { print_scoped_name(cs->hd);
				       sout << " ";
				     };
			     sout << "} ";
			     tcl_print_type(tp,sout);
			     sout << " ";
			     print_declarators(Cons(dcl,Nil));
			     sout << "} ";
			  };
		#end;
	     sout << "}";
	   };
  | scope(`x)
	=> tcl_print_type(x,sout);
  | array(`tp,_)
	=> { sout << "{list ";
	     tcl_print_type(tp,sout);
	     sout << "} ";
	   };
  | `f(`e)
	=> { sout << "{" << f << " ";
	     tcl_print_type(e,sout);
	     sout << "} ";
	   };
  | unsigned_long => sout << "long";
  | unsigned_short => sout << "short";
  | integer => sout << "int";
  | void => sout << "void";
  | _ : e->variablep()
	=> #case get_scoped_binding(e->name())
	   | typedef(`type,_)
		=> tcl_print_type(type,sout);
	   | none => sout << e;
	   | class(...r) => sout << e;
	   | `tp => tcl_print_type(tp,sout);
	   #end;
  #end;
};


void tcl_print_decl ( Expr e, bool top_level, ostream &sout ) {
  #case e
  | class(`cname,scope(...es),inherits(...inhr),extent(...ext),keys(...keys),...body)
	=> { sout << "{" << cname << " {";
	     if (es->consp())
		sout << es->hd << " ";
	     for(list<Expr>* r = inhr; r->consp(); r=r->tl)
		sout << r->hd << " ";
	     sout << "} ";
	     if (ext->consp())
		sout << "{" << ext->hd << "} ";
	     else sout << "{} ";
	     for(list<Expr>* r = body; r->consp(); r=r->tl)
		tcl_print_decl(r->hd,false,sout);
	     sout << "} ";
	   };
  | interface(`iname,inherits(...inhr),...body)
	=> { sout << "{" << iname << " {";
	     for(list<Expr>* r = inhr; r->consp(); r=r->tl)
		sout << r->hd << " ";
	     sout << "} ";
	     for(list<Expr>* r = body; r->consp(); r=r->tl)
		tcl_print_decl(r->hd,false,sout);
	     sout << "} ";
	   };
  | attribute(`type,`copies,...vars)
	: !top_level
	=> { for(; vars->consp(); vars=vars->tl)
	     {  sout << "{";
	        tcl_print_type(type,sout);
		sout << " " << vars->hd;
		if (!copies->eq(#<none>))
		   print_expr(copies);
	        sout << "} ";
	     };
	   };
  | relationship(`type,`rname,...r)
	: !top_level
	=> { sout << "{";
	     tcl_print_type(type,sout);
	     sout << " " << rname;
	     sout << "} ";
	   };
  #end;
};


void tcl_print_module ( ostream &sout ) {
  sout << "{";
  Ref< Catalog > decl;
  PoolScan<Catalog> scan(user_catalog);
  sm_string module = sm_string(current_module_path.local(new string(""))->content());
  while(scan.next(decl))
     if (sm_string(decl->module) == module)
	tcl_print_decl(get_declaration_binding(decl),true,sout);
  scan.close();
  sout << "}";
};