#ifdef HAVE_CONFIG_H
#include "scmconfig.h"
#endif

#include <savutil.h>
#include <yenta-savant.h>
#include <savantio.h>
#include <template.h>

#include "scm.h"

#define MOD "compare:"

/* NOTE: letting collections be GCed, or exiting with the database open does
 * not save changes any more-- this was causing problems with keeping stuff
 * consistent, since the rest of the state didn't get saved when you just
 * quit. */

/************************/
/* document definitions */
/************************/

#define MAKDOC(ddv) cons(tc16_savddv, (SCM) ddv)
#define IDOCP(obj) (NIMP(obj) && (TYP16(obj) == tc16_savddv))
#define DOCDDV(obj) ((DenseDocVec *)CDR(obj))

int tc16_savddv;

/* document smob functions */

/* document -- smob.print */
int prinddv(SCM exp, SCM port, int writing)
{
  char *unparsed;
  if (writing)
    {
      lputs("#<Document ", port);
      intprint(CDR(exp), 16, port);
      lputs(">", port);
      return 1;
    }
  else
    {
      lputs("#[", port);
      unparsed = ddv2string(DOCDDV(exp), 5);
      lputs(unparsed, port);
      free(unparsed);
      lputs("]", port);
      return 1;
    }
}

/* document -- smob.free */

size_t freeddv(CELLPTR obj)
{
  destroy_ddv(DOCDDV(obj));
  return 0;
}

/* document -- smob */

static smobfuns docsmob =
{
  mark0,
  freeddv,
  prinddv,
  0
};

/**************************/
/* collection definitions */
/**************************/

#define MAKCOLL(coll) cons(tc16_coll, (SCM) coll)
#define ICOLLP(obj) (NIMP(obj) && (TYP16(obj) == tc16_coll) && CDR(obj))
#define COLLPTR(obj) ((DDV_coll *)CDR(obj))

int tc16_coll;

/* collection smob functions */

/* collection -- smob.print */

int princoll(SCM exp, SCM port, int writing)
{
  writing = writing;
  if (COLLPTR(exp))
    {
      lputs("#<Document collection ", port);
      intprint(CDR(exp), 16, port);
      lputs(">", port);
    }
  else
    lputs("#<Closed document collection>", port);
  return 1;
}

/* collection -- smob.free */

size_t freecoll(CELLPTR coll)
{
/*  if (COLLPTR(coll))
    close_coll(COLLPTR(coll));*/
  return 0;
}

/* collection -- smob */

static smobfuns collsmob =
{
  mark0,
  freecoll,
  princoll,
  0
};

/***********************/
/* Provided primitives */
/***********************/

#define PROCIFY(name) {s_ ## name, p_ ## name},
#define DONE {0, 0}

/* Special error messages */
#define NOPEN "Database not open"
#define NVALID "Index not valid"
#define IOPEN "Database already open"

/* acquire-document add-document centroid checkpoint-collection 
 * checkpoint-document close-collection close-database cluster-size
 * collection? collection-length collection-ref database-size
 * delete-document document? documents export-document filenames
 * import-document increment-document index-valid? initialize insert-document
 * match max-index open-collection open-database remove-document
 * scale-document show-document seal-cluster temp-collection */

/*** "compare:acquire-document" ***/
static char s_acq_doc[] = MOD "acquire-document";
static SCM p_acq_doc(SCM collhdr, SCM filename)
{
  int ret;
  ASSERT(COLLPTR(collhdr), collhdr, ARG1, s_acq_doc);
  ASSERT(STRINGP(filename), filename, ARG2, s_acq_doc);
  ASSERT(All_Templates, EOL, "Not initialized", s_acq_doc);

  ret = MAKINUM(coll_acquire_file(COLLPTR(collhdr), CHARS(filename)));
  errno = 0; /* Clear errno; the errors are handled */
  return ret;
}

/*** "compare:add-document" ***/
/*** ALPHA ***/
static char s_add_doc[] = MOD "add-document";
static SCM p_add_doc(SCM doc, SCM collhdr)
{
  ASSERT(IDOCP(doc), doc, ARG1, s_add_doc);
  ASSERT(ICOLLP(collhdr), collhdr, ARG2, s_add_doc);

  coll_add_doc(COLLPTR(collhdr), ddv_dup(DOCDDV(doc)));

  return UNSPECIFIED;
}

/*** "compare:centroid" ***/
static char s_cent[] = MOD "centroid";
static SCM p_cent(SCM index)
{
  int i;

  ASSERT(INUMP(index), index, ARG1, s_cent);
  ASSERT(DocVecs, EOL, NOPEN, s_cent);

  i = INUM(index);

  ASSERT((i >= 0) && (i < DocVecs->length), index, OUTOFRANGE, s_cent);
  ASSERT(DVszs[i] != 0.0, index, NVALID, s_cent);

  return MAKDOC(ddv_dup(DocVecs->items[i]));
}

/*** "compare:checkpoint-collection" ***/
/*** BETA ***/
static char s_chp_coll[] = MOD "checkpoint-collection";
static SCM p_chp_coll(SCM collhdr)
{
  ASSERT(ICOLLP(collhdr), collhdr, ARG1, s_chp_coll);
  
  checkpoint_coll(COLLPTR(collhdr));			/* %%% This should fail nicely if it gets an error! */

  return UNSPECIFIED;
}

/*** "compare:checkpoint-database" ***/
/*** BETA ***/
static char s_chp_db[] = MOD "checkpoint-database";
static SCM p_chp_db()
{
  ASSERT(DocVecs, EOL, NOPEN, s_chp_db);

  checkpoint_savant_yenta();				/* %%% This should fail nicely if it gets an error! */
  return UNSPECIFIED;
}

/*** "compare:close-collection" ***/
/*** BETA ***/
static char s_close_coll[] = MOD "close-collection";
static SCM p_close_coll(SCM collhdr)
{
  ASSERT(ICOLLP(collhdr), collhdr, ARG1, s_close_coll);
  
  close_coll(COLLPTR(collhdr));				/* %%% This should fail nicely if it gets an error! */

  CDR(collhdr) = NULL; /* make it closed */

  return UNSPECIFIED;
}

/*** "compare:close-database" ***/
/*** BETA ***/
static char s_close_db[] = MOD "close-database";
static SCM p_close_db()
{
  ASSERT(DocVecs, EOL, NOPEN, s_close_db);

  close_savant_yenta();
  DocVecs = NULL;
  return UNSPECIFIED;
}

/*** "compare:cluster-size" ***/
/*** ALPHA ***/
static char s_clst_sz[] = MOD "cluster-size";
static SCM p_clst_sz(SCM index)
{
  int i;
  ASSERT(DocVecs, EOL, NOPEN, s_clst_sz);
  ASSERT(INUMP(index), index, ARG1, s_clst_sz);
  i = INUM(index);
  ASSERT((i >= 0) && (i < DocVecs->length), index, OUTOFRANGE, s_clst_sz);
  ASSERT(DVszs[i] != 0.0, index, NVALID, s_clst_sz);

  return MAKINUM(DVszs[i]);
}

/*** "compare:collection?" ***/
/*** ALPHA ***/
static char s_collp[] = MOD "collection?";
static SCM p_collp(SCM obj)
{
  return ICOLLP(obj) ? BOOL_T : BOOL_F;
}

/*** "compare:collection-length" ***/
/*** BETA ***/
static char s_coll_len[] = MOD "collection-length";
static SCM p_coll_len(SCM collhdr)
{
  ASSERT(ICOLLP(collhdr), collhdr, ARG1, s_coll_len);

  return MAKINUM(COLLPTR(collhdr)->length);
}

/*** "compare:collection-ref" ***/
/*** BETA ***/
static char s_coll_ref[] = MOD "collection-ref";
static SCM p_coll_ref(SCM collhdr, SCM index)
{
  DDV_coll *coll;
  int i;
  ASSERT(ICOLLP(collhdr), collhdr, ARG1, s_coll_ref);
  ASSERT(INUMP(index), index, ARG2, s_coll_ref);

  coll = COLLPTR(collhdr);
  i = INUM(index);
  ASSERT((i >= 0) && (i < coll->length), index, OUTOFRANGE, s_coll_ref);

  return MAKDOC(ddv_dup(coll->items[i]));
}

/*** "compare:database-size" ***/
/*** ALPHA ***/
static char s_db_sz[] = MOD "database-size";
static SCM p_db_sz()
{
  int i, c = 0;
  ASSERT(DocVecs, EOL, NOPEN, s_db_sz);
  
  for (i = 0; i < DocVecs->length; i++)
    if (DVszs[i] != 0.0)
      c++;

  return MAKINUM(c);
}

/*** "compare:delete-document" ***/
/*** ALPHA ***/
static char s_del_doc[] = MOD "delete-document";
static SCM p_del_doc(SCM index)
{
  int i;
  ASSERT(INUMP(index), index, ARG1, s_del_doc);
  ASSERT(DocVecs, EOL, NOPEN, s_del_doc);

  i = INUM(index);
  ASSERT((i >= 0) && (i < DocVecs->length), index, OUTOFRANGE, s_del_doc);
  ASSERT(DVszs[i] != 0.0, index, NVALID, s_del_doc);

  remove_doc(i);
  return UNSPECIFIED;
}  

/*** "compare:document?" ***/
/*** ALPHA ***/
static char s_docp[] = MOD "document?";
static SCM p_docp(SCM obj)
{
  return IDOCP(obj) ? BOOL_T : BOOL_F;
}

/*** "compare:documents" ***/
/*** ALPHA ***/
static char s_docs[] = MOD "documents";
static SCM p_docs(SCM index)
{
  int i;
  SCM ret = EOL;
  DDV_coll *dc;
  ASSERT(INUMP(index), index, ARG1, s_docs);
  ASSERT(DocVecs, EOL, NOPEN, s_docs);

  i = INUM(index);

  ASSERT((i >= 0) && (i < DocVecs->length), index, OUTOFRANGE, s_docs);
  ASSERT(DVszs[i] != 0.0, index, NVALID, s_docs);

  dc = DVColls[i];
  if (dc)
    for (i = 0; i < dc->length; i++)
      ret = cons(MAKDOC(ddv_dup(dc->items[i])), ret);
  return ret;
}


/*** "compare:export-document" ***/
/*** ALPHA ***/
static char s_exp_doc[] = MOD "export-document";
static SCM p_exp_doc(SCM doc, SCM pcnt)
{
  int *wts, i;
  char **words;
  SCM wd, lst;
  ASSERT(IDOCP(doc), doc, ARG1, s_exp_doc);
  ASSERT(INUMP(pcnt), pcnt, ARG2, s_exp_doc);

  ddv2description(DOCDDV(doc), INUM(pcnt) / 100.0, &words, &wts);
  lst = EOL;
  for (i = 0; words[i]; i++)
    {
      wd = cons(MAKINUM(wts[i]), makfrom0str(words[i]));
      free(words[i]);
      lst = cons(wd, lst);
    }
  free(wts);
  free(words);
  return lst;
}

/*** "compare:import-document" ***/
/*** ALPHA ***/
static char s_imp_doc[] = MOD "import-document";
static SCM p_imp_doc(SCM exp)
{
  /* NOTE: returns #f for badly formed input, so that complicated type
   * checking need not be done beforehand as well as in here.  Note that
   * nil does not translate into an empty document, but just returns #f. */
  int len = 0, *wts, i = 0;
  SCM lst;
  char **words;

  DenseDocVec *ddv;

  if (!(NIMP(exp) && CONSP(exp)))
    return BOOL_F;

  for (lst = exp; lst != EOL; lst = CDR(lst))
    {
      if (!INUMP(CAR(CAR(lst))) ||
	  !STRINGP(CDR(CAR(lst))) ||
	  !(CDR(lst) == EOL || CONSP(CDR(lst))))
	return BOOL_F;
      len++;
    }
  wts = (int *)malloc(len * sizeof(int));
  words = (char **)malloc((len + 1) * sizeof(char *));

  for (lst = exp; lst != EOL; lst = CDR(lst))
    {
      wts[i] = INUM(CAR(CAR(lst)));
      words[i] = CHARS(CDR(CAR(lst)));
      i++;
    }
  words[i] = NULL;

  ddv = description2ddv(words, wts);
  free(words);
  free(wts);
  return MAKDOC(ddv);
}

/*** "compare:increment-document" ***/
/*** ALPHA ***/
static char s_incr_doc[] = MOD "increment-document";
static SCM p_incr_doc(SCM index, SCM doc)
{
  int i;
  ASSERT(INUMP(index), index, ARG1, s_incr_doc);
  ASSERT(IDOCP(doc), doc, ARG2, s_incr_doc);

  i = INUM(index);

  ASSERT((i >= 0) && (i < DocVecs->length), index, OUTOFRANGE, s_incr_doc);
  ASSERT(DVszs[i] != 0.0, index, NVALID, s_incr_doc);

  incr_dv(DOCDDV(doc), i);
  ASSERT(DVszs[i] != 0.0, EOL, "Problem!", s_incr_doc);
  return UNSPECIFIED;
}

/*** "compare:index-limit" ***/
/*** ALPHA ***/
static char s_ind_lim[] = MOD "index-limit";
static SCM p_ind_lim()
{
  ASSERT(DocVecs, EOL, NOPEN, s_ind_lim);
  
  return MAKINUM(DocVecs->length);
}

/*** "compare:index-valid" ***/
/*** ALPHA ***/
static char s_ind_val[] = MOD "index-valid?";
static SCM p_ind_val(SCM index)
{
  int i;
  ASSERT(INUMP(index), index, ARG1, s_ind_val);
  ASSERT(DocVecs, EOL, NOPEN, s_ind_val);

  i = INUM(index);

  return ((i >= 0) && (i < DocVecs->length) && (DVszs[i] != 0.0))
    ? BOOL_T : BOOL_F;
}

/*** "compare:initialize" ***/
/*** BETA ***/
static char s_init[] = MOD "initialize";
static SCM p_init(SCM savantrcname)
{
  ASSERT(STRINGP(savantrcname), savantrcname, ARG1, s_init);
  
  load_config(CHARS(savantrcname));
  /* %%% This should be tested, but I've got to make it not just die if there's a problem */
  core_comm_local();
  return UNSPECIFIED;
}

/*** "compare:insert-document" ***/
/*** ALPHA ***/
static char s_ins_doc[] = MOD "insert-document";
static SCM p_ins_doc(SCM doc)
{
  int i;

  ASSERT(IDOCP(doc), doc, ARG1, s_ins_doc);
  ASSERT(DocVecs, EOL, NOPEN, s_ins_doc);

  i = save_dv(DOCDDV(doc));
  return MAKINUM(i);
}

/*** "compare:match" ***/
/*** ALPHA ***/
static char s_match[] = MOD "match";
static SCM p_match(SCM doc)
{
  ASSERT(IDOCP(doc), doc, ARG1, s_match);
  ASSERT(DocVecs, EOL, NOPEN, s_match);

  return cons(tc7_fvect + (DocVecs->length << 8),
	      (SCM) find_matches(DOCDDV(doc)));
}

/*** "compare:open-collection" ***/
/*** ALPHA ***/
static char s_open_coll[] = MOD "open-collection";
static SCM p_open_coll(SCM collname)
{
  ASSERT(STRINGP(collname), collname, ARG1, s_open_coll);
  
  return MAKCOLL(load_coll(CHARS(collname)));		/* %%% This should fail nicely if it gets an error! */
}

/*** "compare:open-database" ***/
/*** ALPHA ***/

static char s_open_db[] = MOD "open-database";
static SCM p_open_db(SCM dbname)
{
  ASSERT(STRINGP(dbname), dbname, ARG1, s_open_db);
  ASSERT(!DocVecs, EOL, IOPEN, s_open_db);

  init_savant_yenta(strdup(CHARS(dbname)));		/* %%% This should fail nicely if it gets an error! */
  return UNSPECIFIED;
}

/*** "compare:remove-document" ***/
/*** ALPHA ***/
static char s_rem_doc[] = MOD "remove-document";
static SCM p_rem_doc(SCM collhdr, SCM index)
{
  int i;
  DDV_coll *coll;
  ASSERT(INUMP(index), index, ARG2, s_rem_doc);
  ASSERT(ICOLLP(collhdr), collhdr, ARG1, s_rem_doc);

  coll = COLLPTR(collhdr);
  i = INUM(index);

  ASSERT((i >= 0) && (i < coll->length), index, OUTOFRANGE, s_rem_doc);

  coll_remove_doc(coll, i);

  return UNSPECIFIED;
}

/*** "compare:show-document" ***/
/*** BETA ***/
static char s_show_doc[] = MOD "show-document";
static SCM p_show_doc(SCM docobj, SCM words)
{
  int num;
  char *unparsed;
  SCM ret;
  
  ASSERT(IDOCP(docobj), docobj, ARG1, s_show_doc);
  ASSERT(INUMP(words), words, ARG2, s_show_doc);

  num = INUM(words);

  ASSERT(words > 0, words, OUTOFRANGE, s_show_doc);

  unparsed = ddv2string(DOCDDV(docobj), num);
  ret = makfrom0str(unparsed);
  free(unparsed);
  return ret;
}

/*** "compare:scale-document" ***/
/*** BETA ***/
static char s_scale_doc[] = MOD "scale-document";
static SCM p_scale_doc(SCM docobj, SCM mult)
{
  ASSERT(IDOCP(docobj), docobj, ARG1, s_scale_doc);
  ASSERT(INUMP(mult), mult, ARG2, s_scale_doc);

  ddv_mult(DOCDDV(docobj), INUM(mult));
  return UNSPECIFIED;
}

/*** "compare:temp-collection" ***/
/*** ALPHA ***/
static char s_temp_coll[] = MOD "temp-collection";
static SCM p_temp_coll()
{
  return MAKCOLL(temp_coll());
}

/* Functions of no arguments */

static iproc procs0[] =
{
  PROCIFY(close_db)
  PROCIFY(chp_db)
  PROCIFY(db_sz)
  PROCIFY(temp_coll)
  PROCIFY(ind_lim)
  DONE
};

/* Functions of 1 argument */

static iproc procs1[] =
{
  PROCIFY(docs)
  PROCIFY(chp_coll)
  PROCIFY(close_coll)
  PROCIFY(clst_sz)
  PROCIFY(collp)
  PROCIFY(cent)
  PROCIFY(coll_len)
  PROCIFY(del_doc)
  PROCIFY(docp)
  PROCIFY(imp_doc)
  PROCIFY(init)
  PROCIFY(ins_doc)
  PROCIFY(match)
  PROCIFY(open_coll)
  PROCIFY(open_db)
  PROCIFY(ind_val)
  DONE
};

/* Functions of 2 arguments */

static iproc procs2[] =
{
  PROCIFY(acq_doc)
  PROCIFY(add_doc)
  PROCIFY(coll_ref)
  PROCIFY(exp_doc)
  PROCIFY(incr_doc)
  PROCIFY(rem_doc)
  PROCIFY(show_doc)
  PROCIFY(scale_doc)
  DONE
};

void init_savant()
{
  tc16_savddv = newsmob(&docsmob);
  tc16_coll = newsmob(&collsmob);

  init_iprocs(procs0, tc7_subr_0);
  init_iprocs(procs1, tc7_subr_1);
  init_iprocs(procs2, tc7_subr_2);

/*  add_final(close_savant_yenta);*/

  add_feature("savant");
}
