/* ----------------------------------------------------------
%   (C)1992 Institute for New Generation Computer Technology
%       (Read COPYRIGHT for detailed information.)
----------------------------------------------------------- */
/*=====================================================================
*		cu-Prolog III (Constraint Unification Prolog)
*   Copyright: Institute for New Generation Computer Technology,Japan 
*                           1989--91
==================================================================== */
/*--------------------------------------------------------------------
*		<< syspred2.c >>
*		(system predicates No.2 : string, number)
*       1994.9.27  atom_to_str
--------------------------------------------------------------------*/

#include "include.h"
int kstrlen(),kpoint();

/* for LtoC(), CtoL() pred  */
#define FROM_NAME 1
#define FROM_CONC 0

int sum_pred(t,e)
struct term *t;
struct pair *e;
{
  return(calc_pred(t,e,'+'));
}

int multiply_pred(t,e)
struct term *t;
struct pair *e;
{
  return(calc_pred(t,e,'*'));
}


int calc_pred(t,e,op)
struct term *t;
struct pair *e;
char op;
{
  register struct term *x, *y, *z; 
  register struct pair *e0, *e1, *e2, *p;

  e0 = e1 = e2 = e;
  x = Arg(t,0); y = Arg(t,1); z = Arg(t,2);
  down(p,x,e0); down(p,y,e1); down(p,z,e2);

  if(isvar(x)) return(calc_2(y,z,x,e0,op));
  if(isvar(y)) return(calc_2(x,z,y,e1,op));
  else return(calc_1(x,y,z,e2,op));
}

int calc_1(x,y,z,e,op)
struct term *x,*y,*z;
struct pair *e;
char op;
{
  struct term *result;
  register float sum;

/*  if (isvar(x) || isvar(y)) return(SYSFAIL); */

  if (! (is_num(x))) {
    sprintf(nbuf,"%s/3: Illegal argument as 1st argument",
	    ((op == '+') ? "sum" : "multiply") );
    error_detail(x,NULL_ENV,nbuf);
  }
  if (! (is_num(y))) {
    sprintf(nbuf,"%s/3: Illegal argument as 2nd argument",
	    ((op == '+') ? "sum" : "multiply") );
    error_detail(y,NULL_ENV,nbuf);
  }

  if (op=='+') sum = num_value(x) + num_value(y);
  else if (op=='*') sum = num_value(x) * num_value(y);
  else error("system error! at calc_pred");

  result = Nnum_val(sum,TEMPORAL);
  return(equalpred(z,e,result,NULL_ENV));
}

int calc_2(x,z,y,e,op)
struct term *x,*y,*z;
struct pair *e;
char op;
{
  struct term *result;
  register float temp;

  if (isvar(x) || isvar(z)) return(SYSFAIL);

  if (! (is_num(x))) {
    sprintf(nbuf,"%s/3: Illegal argument as 1st argument",
	    ((op == '+') ? "sum" : "multiply") );
    error_detail(x,NULL_ENV,nbuf);
  }
  if (! (is_num(z))) {
    sprintf(nbuf,"%s/3: Illegal argument as 2nd argument",
	    ((op == '+') ? "sum" : "multiply") );
    error_detail(z,NULL_ENV,nbuf);
  }

  temp = num_value(x);
  if ((op=='*') && (temp==0.0)) error("multiply/3: zero division");

  if (op=='+')  temp =  num_value(z) - temp;
  else if (op=='*')  temp = num_value(z)/temp;

  result = Nnum_val(temp,TEMPORAL);
  return(equalpred(y,e,result,NULL_ENV));
}

int greater_pred(t,e)
struct term *t;
struct pair *e;
{
  return(numcomp_pred(t,e,0));
}

int less_pred(t,e)
struct term *t;
struct pair *e;
{
  return(numcomp_pred(t,e,1));
}

int geq_pred(t,e)
struct term *t;
struct pair *e;
{
  return(numcomp_pred(t,e,2));
}

int leq_pred(t,e)
struct term *t;
struct pair *e;
{
  return(numcomp_pred(t,e,3));
}

static char* compare_predicates[] = {
  "greater", "less", "geq", "leq" };

int numcomp_pred(t,e,op)
struct term *t;
struct pair *e;
int op;
{
  register struct term *x, *y; 
  register struct pair *e0, *e1, *p;
  int g, l;

  e0 = e1 = e;
  x = Arg(t,0); y = Arg(t,1);
  down(p,x,e0); down(p,y,e1);

  if(isvar(x) || (p != NULL))
    return(SYSFAIL);

  if (! (is_num(x))) {
    sprintf(nbuf,"%s/2: Illegal argument as 1st Arg",
	    compare_predicates[op]);
    error_detail(x,e0,nbuf);
  }
  if (! (is_num(y))) {
    sprintf(nbuf,"%s/2: Illegal argument as 2nd Arg",
	    compare_predicates[op]);
    error_detail(y,e1,nbuf);
  }
  
  g = (num_value(x) > num_value(y)) ? SYSTRUE : SYSFAIL;
  l = (num_value(x) < num_value(y)) ? SYSTRUE : SYSFAIL;

  switch (op) {
    case 0: return(g);
    case 1: return(l);
    case 2: return((l==SYSFAIL) ? SYSTRUE : SYSFAIL);
    case 3: return((g==SYSFAIL) ? SYSTRUE : SYSFAIL);
    }
}

/* concat("ab","cde",X) -> X = "abcde" */
int concat_pred(t,e,n,status)
struct term *t;
struct pair *e;
struct node *n;
int status;
{
  register struct term *x, *y, *z;
  register struct pair *px, *py, *p;
  struct pair *ex, *ey, *ez;
  int len;
  char *buf;

  x = Arg(t,0);
  y = Arg(t,1);
  z = Arg(t,2);
  ex = ey = ez = e;
  down(px,x,ex); down(py,y,ey); down(p,z,ez);

  if (isvar(x) && isvar(y)) {
    if (status ==BACKTRACK) { /* X,Y are Vars, and Z is CONST */
      if ((len = (int)n->n_set-1) < 0) 	return(SYSFAIL);
/* copy status chars from z to nbuf */
      len = kpoint(str_value(z),len);
      strncpy(nbuf,str_value(z),len);
      nbuf[len] = '\0'; /* due to BUG of SUN4 */
      upush(&(px->p_body));
      upush(&(px->p_env));
      px->p_body = Nstr(nbuf,TEMPORAL);
      px->p_env = NULL_ENV;
      buf = str_value(z);
      upush(&(py->p_body));
      upush(&(py->p_env));
      buf += len;
      py->p_body = Nstr(buf,TEMPORAL);
      py->p_env = NULL_ENV;
      n->n_set = (struct set *)( (int)n->n_set - 1);
      return(SYSTRUE);
    }
    else {
      if (isvar(z)) return(SYSFAIL);
      if (! is_string(z)) {
	error_detail(z,ez,"concat/2: Illegal 3rd argument");
      }
      len = kstrlen(str_value(z));
      upush(&(px->p_body));
      upush(&(px->p_env));
      px->p_body = z;
      px->p_env = ez;
      nbuf[0] = '\0';
      upush(&(py->p_body));
      upush(&(py->p_env));
      py->p_body = Nstr(nbuf,TEMPORAL);
      py->p_env = NULL_ENV;
      n->n_set = (struct set *)len; /* memorize the position */
      return(SYSTRUE);
    }
  }

  if(isvar(x)) return(diff_str(y,z,x,ex,0));
  if(isvar(y)) return(diff_str(x,z,y,ey,1));
  else return(app_str(x,y,z,ez));
}

int app_str(x,y,z,ez)
struct term *x, *y, *z;
struct pair *ez;
{
  struct term *result;

  if (! (is_string(x) && is_string(y))) error("concat/3: illegal term");
  if ((strlen(str_value(x))+strlen(str_value(y))) > NAMELEN_MAX)
    error("concat/3: too long string");
  strcpy(nbuf,str_value(x));
  strcat(nbuf,str_value(y));
  result = Nstr(nbuf,TEMPORAL);
  return(equalpred(z,ez,result,NULL_ENV));
}

int diff_str(x,z,y,e,first)
struct term *x, *y, *z;
struct pair *e;
int first;  /* assuming 0/last_half, 1/first_half is designated */
{
  struct term *result;
  int lx, lz, dif;
  char *cx, *cz;

  if (isvar(z)) return(SYSFAIL);

  if (! (is_string(z))  && (isvar(x) || is_string(x)))
     error("concat/3: illegal term");

  cx = str_value(x); cz = str_value(z);
  if ((lz = strlen(cz)) < (lx = strlen(cx)))
    error("concat/3: not appropriate args");

  if (first) /* find last half */
    {
      register int pos;

      for (pos = 0; pos < lx; pos++)
        if (cx[pos] != cz[pos]) return(SYSFAIL);
      cz += pos;
      result = Nstr(cz,TEMPORAL);
    }
  else /* find first half */
    {
      register int pos;

      dif = lz - lx;
      for (pos = dif; pos < lz; pos++)
        if (cx[pos-dif] != cz[pos]) return(SYSFAIL);
      /*  strcpy(nbuf, cz, dif); this mus be bag.  */
      strncpy(nbuf, cz, dif);
      nbuf[dif] = '\0';
      result = Nstr(nbuf,TEMPORAL);
    }
  return(equalpred(y,e,result,NULL_ENV));
}

/* concat2("abcde",X) -> X = ["a","b","c","d","e"] */
int concat2_pred(t,e)
struct term *t;
struct pair *e;
{
  struct term *x, *y;
  struct pair *ex, *ey, *p;
  struct term *tt;

  x = Arg(t,0);
  y = Arg(t,1);
  ex = ey = e;
  down(p,x,ex); down(p,y,ey);
  *nbuf = '\0';

  if (isvar(x)) {
    if (isvar(y)) return(SYSFAIL);
    LtoC(y,ey,0,FROM_CONC);
    tt = Nstr(nbuf, TEMPORAL);
    return(equalpred(x,ex,tt,NULL_ENV));
  }
  if (is_num(x)) {
      sprintf(nbuf, "%d",(int)num_value(x));
      tt = CtoL(nbuf, FROM_CONC);
    }
  else if (is_string(x)) tt = CtoL(str_value(x), FROM_CONC);
  else tt = CtoL(x->type.t_func->f_name, FROM_CONC);
  return(equalpred(y,ey,tt,NULL_ENV));
}


int strlen_pred(t,e)
struct term *t;
struct pair *e;
{
  struct term *s, *l;
  struct pair *es, *el, *p;
  int len;

  s = Arg(t,0);
  l = Arg(t,1);

  es = el = e;
  down(p,l,el);
  down(p,s,es);

  if (p != NULL) return(SYSFAIL);
  if (! is_string(s)) {
    error_detail(t,e,"strlen/1: 1st arg is not string");
  }
  if  (! (isvar(l) || is_num(l))) {
    error_detail(t,e,"strlen/2: 2nd arg is neither Var nor Number");
  }
  len = kstrlen(str_value(s));
  t = Nnum_val((float)len,TEMPORAL);
  return(equalpred(l,el,t,NULL_ENV));
}

/* substring("abcde",2,X) -> X = "cde"
   substring("abcde",-3,2,X) -> X = "cd" */
int substr_pred(t,e)
struct term *t;
struct pair *e;
{
  static char *emsg = "substring/%d: %s arg is not %s";
   struct term *s, *tmp;
   register struct pair *p, *ee;
   int arity,start,numb,len;
   char *sr;

   arity = t->t_arity;
   if (arity < 0) arity = -arity;

   s = Arg1(t);
   ee = e;
   down(p,s,ee);

   if (! is_string(s)) {
     sprintf(nbuf,emsg,arity, "1st", "string");
     error_detail(t,e,nbuf);
   }
   tmp = Arg2(t);
   ee = e;
   down(p,tmp,ee);
   if (! is_int(tmp))  {
     sprintf(nbuf,emsg, arity, "2nd","integer");
     error_detail(t,e,nbuf);
   }
   start = num_value(tmp);
   len = kstrlen(str_value(s));
   if (start < 0) start += len;

   if (arity == 4) {
     tmp = Arg3(t);
     ee = e;
     down(p,tmp,ee);
     if (! is_int(tmp)) {
       sprintf(nbuf,emsg,4,"3rd","integer");
       error_detail(t,e,nbuf);
     }
     numb = num_value(tmp);
     if (numb < 0) numb+=len;
   }
   else  { /* arity == 3 */
     numb = len-start;
   }
   if ( (start > len) || (numb > len) || (start < 0)) {
     sprintf(nbuf,"substring/%d: Illegal argument value",arity);
     error_detail(t,e,nbuf);
   }
   
   sr = str_value(s);
   sr += kpoint(sr,start);
  numb = kpoint(sr,numb);
   strncpy(nbuf,sr,numb);
   nbuf[numb] = '\0';
   tmp = Nstr(nbuf,TEMPORAL);
   return(equalpred(Arg(t,arity-1),e,tmp,NULL_ENV));
 }

/* divstr("abcd",2,X,Y) -> X = "ab", Y = "cd" */
/* divstr(+,+,?,?) or divstr(+,-,+,?) */
int divstr_pred(t,e)
struct term *t;
struct pair *e;
{
   static char *emesg = "divstr*/4: %s is not %s";
   register struct pair *p, *ee, *e1;
   struct term *str, *temp, *first;
   int n,len, firsthalf();
   char *sr, *sf, *divkstr();

   str = Arg1(t);
   ee = e;	down(p,str,ee);
   if (! is_string(str)) {
     sprintf(nbuf,emesg,"1st","string");
     error_detail(t,e,nbuf);
   }
   sr = str_value(str);
   len = kstrlen(sr);

   temp = Arg2(t);
   ee = e;	down(p,temp,ee);
   if (p != NULL) { /* 2nd arg is var */
     e1 = e;
     first = Arg3(t);
     down (p,first,e1);
     if (! is_string(first)) {
       sprintf(nbuf,emesg,"2nd","integer and 3rd arg is var");
       error_detail(t,e,nbuf);
     }
     sf = str_value(first);
     n = kstrlen(sf);
     if ((n <= len) && (firsthalf(sf,sr)==TRUE) &&
	 (equalpred(temp,ee,Nnum_val((float)n,TEMPORAL),NULL_ENV)
	  == SYSTRUE)){
       sr += strlen(sf);
       return(equalpred(Arg(t,3),e,Nstr(sr,TEMPORAL),NULL_ENV));
     }
     return(SYSFAIL);
   }
   else if (! is_int(temp)) {
     sprintf(nbuf,emesg,"2nd","integer");
     error_detail(t,e,nbuf);
   }

   n = num_value(temp);		/* 2nd arg is num */
   if (n < 0) n += len;
   if ((n > len) || (n < 0)) {
     sprintf(nbuf,emesg,"2nd","appropriate");
     error_detail(t,e,nbuf);
   }
   n = kpoint(sr,n);		/* n:kanji point -> n:char point */
   strncpy(nbuf,sr,n);
   nbuf[n]='\0';
   temp = Nstr(nbuf,TEMPORAL);
   if (equalpred(Arg(t,2),e,temp,NULL_ENV) == SYSFAIL)
     return(SYSFAIL);
   temp = Nstr(sr+n,TEMPORAL);
   return(equalpred(Arg(t,3),e,temp,NULL_ENV));
 }


int firsthalf(h,w)
char h[], w[];
{
  register int i;
  for (i = 0; h[i] == w[i]; i++);
  if (h[i] == '\0') return(TRUE);
  else return(FALSE);
}


/* strcmp("ab","abc", X) -> X = '<' */
/* strcmp(+,+,-) */
int strcmp_pred(t,e)
struct term *t;
struct pair *e;
{
   static char *emesg = "strcmp*/3: %s is not string";
   register struct pair *p, *ee;
   struct term *a, *b;
   int result;

   a = Arg(t,0);	b = Arg(t,1);
   ee = e; down(p,a,ee);
   if (! is_string(a)) {
     sprintf(nbuf,emesg,"1st");
     error_detail(t,e,nbuf);
   }
   ee = e; down(p,b,ee);
   if (! is_string(b)) {
     sprintf(nbuf,emesg,"2nd");
     error_detail(t,e,nbuf);
   }
   result = strcmp(str_value(a),str_value(b));
   if (result < 0)
     return(equalpred(Arg(t,2),e,S_LESS,NULL_ENV));
   else if (result == 0)
     return(equalpred(Arg(t,2),e,S_EQ,NULL_ENV));
   else /* result > 0 */
     return(equalpred(Arg(t,2),e,S_GREATER,NULL_ENV));
 }

int compare_pred(t,e)
struct term *t;
struct pair *e;
{
  register struct pair *p, *ee;
  struct term *a, *b;
  float j;
  int i;

  ee = e;
  a = Arg(t,0);
  down(p,a,ee);

  ee = e;
  b = Arg(t,1);
  down(p,b,ee);

  if (is_num(a) && is_num(b)) {
    j = num_value(a) - num_value(b);
    if (j > 0.0)
      return(equalpred(Arg(t,2),e,S_GREATER,NULL_ENV));
    else if (j == 0.0)
      return(equalpred(Arg(t,2),e,S_EQ,NULL_ENV));
    return(equalpred(Arg(t,2),e,S_LESS,NULL_ENV));
  }

  if (is_string(a) && is_string(b)) {
    i = strcmp(str_value(a),str_value(b));
    if (i > 0)
      return(equalpred(Arg(t,2),e,S_GREATER,NULL_ENV));  
    else if (i == 0)
      return(equalpred(Arg(t,2),e,S_EQ,NULL_ENV));
    return(equalpred(Arg(t,2),e,S_LESS,NULL_ENV));
  }

  error_detail(t,e,"compare*/3: Args are mismatched");
}

int atom_to_str_pred(t,e)
struct term *t;
struct pair *e;
{
    struct term *t1,*ns;
    struct pair *e1,*p1;
    
    t1=Arg1(t);
    e1 = e;
    down(p1,t1,e1);
    if (p1 == NULL_ENV) /* arg1: bound  */
    {
	if (isconst_functor(t1))
	{
	    ns = Nstr(Predname(t1),ETERNAL);
	    if (tunify(Arg2(t),e,ns,NULL_ENV,0)==TRUE)
		return(SYSTRUE);
	}
	return(SYSFAIL);
    }
  else error_detail(t,e,"atom_to_pred: 1st arg is free.");
}


/* count() predicate :
	count(X) -> X = 0,1,2,...
	count(3) -> set COUNTNUMBER in 3

*/
long COUNTNUMBER = 0;	/* used for count(gensym) predicate */

int count_pred(t,e)
struct term *t;
struct pair *e;
{
   register struct pair *p;
   struct term *result;

   t = Arg(t,0);
   down(p,t,e);

   if (p != NULL) {
        result = Nnum_val((float)COUNTNUMBER,TEMPORAL);
	COUNTNUMBER++;
        return(equalpred(t,e,result,NULL_ENV));
             }
   if (is_int(t)) {
       COUNTNUMBER=(long)num_value(t);
       return(SYSTRUE);
     }
   error_detail(t,e,"count/1: illegal argument.");
}

int gensym_pred(t,e)
struct term *t;
struct pair *e;
{
  register struct term *tt;
  register struct pair *p, *ee;
  struct term *result;
  char newname[8];

  if (t->t_arity == 2) {
    tt = Arg(t,0);
    ee = e;
    down(p,tt,ee);
    if (is_functor(tt))
      strncpy(newname, tt->type.t_func->f_name,8);
    else if (is_string(tt)) 
      strncpy(newname, str_value(tt), 8);
    else error_detail(t,e,"gensym/2: 1st Argument should be atom");

    tt = Arg(t,1);
    ee = e;
  }
  else { /* gensym/1 */
    tt = Arg(t,0);
    ee = e;
    strcpy(newname,genname);
  }

  down(p,tt,ee);
  if (p != NULL) {
  /* new function name is generated in nbuf[] */
      while (1) {
	sprintf(nbuf,"%s%d", newname, GENSYM++);
	if (exist_fname(nbuf) == NULL) break;
      }
      result = Nterm(0,TEMPORAL);
      result->type.t_func = Predicate(nbuf,0);
      return(equalpred(tt,ee,result,NULL_ENV));
           }
    else error_detail(t,e,"gensym/1:Argument should be Variable");
}

int kstrlen(str)
char *str;
{
    register unsigned char *c;
    register float n;

#if KANJI != 1    
    return(strlen(str));
#else
    for (c=(unsigned char *)str,n=0; *c != '\0'; c++)
    {
	if (*c > EUCOS) n+=0.5;
	else n++;
    }
    return( (int)n );
#endif
}

int kpoint(s,n)		/* return the point after nth Kanji char */
unsigned char *s;
int n;
{
    register unsigned char *c;
    register int i;
    register float l;

#if KANJI != 1
    return(n);
#else
    for (c=s,l=i=0; *c != '\0'; c++,i++)
    {
	if (l == (float) n) break;
	if (*c > EUCOS) l+=0.5;
	else l++;
    }
    return(i);
#endif
}