/* ----------------------------------------------------------
%   (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
==================================================================== */
/*--------------------------------------------------------------------
*		<<<< read.c >>>>		
*		input routines
* 94.8.10  unsigned char for Kanji input
--------------------------------------------------------------------*/

#include "include.h"

/* Classification of Characters */
#define BL  001  /* blank */
#define UC  002  /* Upper Character */
#define LC  003  /* Lower Character */
#define UL  004  /* UnderLine */
#define N   005  /* Numeric */
#define SG  006  /* sign, +- */
#define SP  007  /* special character */
#define Q   010  /* single/double quote */
#define CT  011  /* Cut */
#define CM  012  /* comment character */
#define BR  013  /* Brackets, Commas */
#define CO  014  /* Constraint Marker */

#define kanzi(CH)       (CH > 128)  /* for EUC */
#define alpha   (kanzi(cbuf) || ((UC <= char_type[cbuf]) && \
				 (char_type[cbuf] <= N)))

/* special characters are #$%&*+-/:<=>?@\^|~ */
#define specialchar(C)	((! kanzi(C)) && ((char_type[C] == SG) || \
					  (char_type[C] == SP)))
#define delimitchar(C)  ((! kanzi(C)) && ((char_type[C] >= BR) || (C == '.')))
#define bracket(C)      ((! kanzi(C)) && (char_type[C] == BR))

#define quotesign       ((! kanzi(cbuf)) && (char_type[cbuf] == Q))
#define white           ((! kanzi(cbuf)) && (char_type[cbuf] == BL))

#define numeric(X)   ((X == '-') || ((! kanzi(X)) && (char_type[X]==N)))
#define isdigit(X)   ((! kanzi(X)) && (char_type[X]==N))
#define isxdigit(X)  ((! kanzi(X)) && ((char_type[X]==N) || \
		((char_type[X] == LC) && ('a' <= X) && (X <= 'f')) || \
		((char_type[X] == UC) && ('A' <= X) && (X <= 'F'))))
#define is_varname(X)  ((X == '_') || ((! kanzi(X)) && (char_type[X]==UC)))

#define notconst_list(L) (((struct clause *)L)->c_type != CONST_LIST_TYPE)
#define isconst_list(L) (((struct clause *)L)->c_type == CONST_LIST_TYPE)
    
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++
  Rterm(num,flag)           
          general read routine entry
    num:  operator strength
    flag: heap mode (TEMPORAL,ETERNAL,...)
+++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
struct term *Rterm(n,flag)
int n,flag;
{
  int m = 0;
  struct term *Rterm_half(),*Rterm_leftover();
  struct term *t = Rterm_half(n,flag,&m);

  t = Rterm_leftover(n,m,flag,t);
  if ((is_clause(t)) && (((struct clause *)t)->c_link == NULL))
    return(((struct clause *)t)->c_form);
  return(t);
}

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++
  next()
    get next char into cbuf (global char register)
+++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void next()	
{
	if (feof(fp)) 
	{
		clearerr(fp);
		cbuf = EOF;
		return;
	}
	if (ferror(fp))
	{
		clearerr(fp);
		error("input error !");
	}
	cbuf = getc(fp);
	if (lfp) putc(cbuf,lfp);	/* log file */
	if (ECHO_BACK) putc(cbuf, wfp);
}

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++
  int check(c)
  check whether next input is c
+++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
int check(c)		/*  check if c is cbuf	*/
char c;
{
        if(cbuf == c) {
                advance;
                return(TRUE);
        } else
                return(FALSE);
}

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++
  int keyread(a)
    check whether user's input is 'a....\n'
+++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
int keyread(a)
char a;
{
	int c,c1;

	c = c1 = getchar();
	while (c1 != '\n') c1 = getchar();
	if (lfp) fprintf(lfp,"\n");
	if (c == a) return(TRUE);
	else return(FALSE);
}

void adv()		/*  skip white and set the next char into cbuf  */
{
        while(white)
                next();
}

int skip(c)		/*	skip c	*/
char c;
{
        if(cbuf != c){
	  wfp = stderr;
	  tprint2("\n '%c' <-> '%c'", cbuf, c);
	  error(" illegal character ");
	}
        advance;
        return(cbuf);
}

int alldigit(c)
register unsigned char *c;
{
	if ( c[0] >= 0x80 ) return(FALSE);
	if (! numeric(*c)) return(FALSE);
	for( c++ ; *c!='\0' ; c++ )
	    if (! isdigit(*c)) return(FALSE);
	return(TRUE);
}

void read_hexa(i)
register int i;
{
  for(i=0; isxdigit(cbuf); next())
    if (i < NAMELEN_MAX) nbuf[i++]=cbuf;
  nbuf[i]='\0';
}


void read_digits(i)
register int i;
{
  for( ; isdigit(cbuf); next())
    if (i < NAMELEN_MAX) nbuf[i++] = cbuf;
  if (cbuf=='.')
    do
      { nbuf[i++] = cbuf;
	next();
      } while((isdigit(cbuf)) && (i < NAMELEN_MAX));
  if ((cbuf == 'e') || (cbuf == 'E')) {
    nbuf[i++] = 'E';
    next();
    if ((cbuf == '-') || isdigit(cbuf))
      do
	{ nbuf[i++] = cbuf;
	  next();
	} while((isdigit(cbuf)) && (i < NAMELEN_MAX));
  }
  nbuf[i]='\0';
}

void read_comments()
{
  while (1) {
    next();
    if (cbuf == '*') {
      next();
      if (cbuf == '/') {advance; return;}
    }
  }
}

void read_spechar(i)
register int i;
{
  while (specialchar(cbuf) && (i < NAMELEN_MAX)) {
    nbuf[i++] = cbuf;
    next();
  } 
  nbuf[i]='\0';
}

int Rtoken()	/* read name into nbuf[]  */
{
  if (reread) {
    reread = FALSE;
    return(tokentype);
  }

  adv();
  if (cbuf==EOF) {
    set_eof();
    error("unexpected End Of File");
  }
  if (bracket(cbuf))   /* ()[]{}|, */
    {
      if (cbuf==',') return(tokentype = COMMA);
      nbuf[0] = cbuf;
      nbuf[1] = '\0';
      return(tokentype = BRACKET);
    }
  if (! kanzi(cbuf)) {
   /* if (char_type[cbuf] == CO) return(tokentype = CONST_MARK); */
      if (char_type[cbuf] == CM) {
	skipline;
	return(Rtoken());
      }
  }

  tokentype = NAME;
  if (isdigit(cbuf))
    {
      read_digits(0);
      return(tokentype = NUMBER);
    }

  if (alpha) {
    register int i = 0;
    if (is_varname(cbuf)) tokentype = VARNAME;
    while(alpha && (i < NAMELEN_MAX)){
      if (kanzi(cbuf)) {
	nbuf[i++] = cbuf;
	next();
      }
      nbuf[i++] = cbuf;
      next();
    }
    nbuf[i]='\0';
    return(tokentype);
  }

  if (quotesign) {
    register char temp = cbuf;
    register int i;
    if (temp == '\"') tokentype = STRING;
    next();
    for (i = 0; i < NAMELEN_MAX; next()) {
      if (cbuf != temp) nbuf[i++]=cbuf;
      else {
	next();
	if (cbuf == temp) nbuf[i++]=cbuf;
	else break;
      }
    }
    if (i >= NAMELEN_MAX) {
      nbuf[i]='\0';
      wfp = stderr;
      sprintf(nbuf,">>> %s <<<",nbuf);
      error("too long string/name");
    }
    nbuf[i]='\0';
    return(tokentype);
  }

  if (cbuf == '!') {
    nbuf[0] = cbuf;
    nbuf[1] = '\0';
    next();
    return(tokentype);
  }

  if (char_type[cbuf] == CO) {
    nbuf[0] = cbuf;
    nbuf[1] = '\0';
    next();
    return(tokentype);
  }

  if (specialchar(cbuf)) {
    register int i = 0;

    nbuf[i++] = cbuf;
    next();

    switch (nbuf[0]) {
    case '-':
      if (isdigit(cbuf)) {
	tokentype = NUMBER;
	read_digits(i);
      }
      else read_spechar(i);
      break;
    case '/':
      if (cbuf == '*') {
	read_comments();
	return(Rtoken());
      }
      else read_spechar(i);
      break;
    case '#':
      if (isxdigit(cbuf)) {
	tokentype = FILE_TYPE;
	read_hexa(i);
      }
      else read_spechar(i);
      break;
    case '.':
      if (white) tokentype = FULLSTOP;
      else read_spechar(i);
      break;
    default:
      read_spechar(i);
    }
  }
  else {
    sprintf(nbuf,"Illegal Character:>>> %c <<<",cbuf); 
    error(nbuf);
  }
    
 return(tokentype);
}

struct term *Rlist(flag)	/* read list */
int flag;
{
	register struct term *v;
	register struct clause *c;
	int ac;

	advance;	/* skip [ */
	if (cbuf == ']') {	/*  []  */
		return(NIL);
	      }
	/* read the first argument */
	c = Nlist(Rterm(999,flag),(struct clause *)NIL,flag);
	ac = c->c_type;
	switch (Rtoken()) {
	  case COMMA:
		c->c_link = (struct clause *)Rlist(flag);
		if (notconst_list(c->c_link)) c->c_type = LIST_TYPE;
		return((struct term *)c);
	  case BRACKET:
	      if (nbuf[0]=='|') {
		advance;
		v = Rterm(999,flag);
		c->c_link = (struct clause *)v;
		if (isvar(v) || notconst_list(v))
		  c->c_type = LIST_TYPE;
 		return((struct term *)c);
	      }
	      else {
		reread = TRUE;
		return((struct term *)c);
	      }
	  default: error("Illegal list : ? ");
	}
}

struct term *Rpst(flag)		/* pst */
int flag;
{
   struct term *p = (struct term *)Npst(flag);
   struct term *t;
   struct eclause *pobj = NULL_ECL;

   while (1) {
     advance;
     if (cbuf == '}')  return(p);
     t = Rterm(999, flag);
     if (Pred(t) != PNAME_P) {
       error_detail(t,NULL_ENV,
		"Illegal PST: Delimiter of PST should be '/'");
     }
     if ((! is_functor(Arg1(t)) || (Arg1(t)->t_arity != 0))) {
       error_detail(t,NULL_ENV,
		"Illegal PST: PNAME of PST should be ATOM");
     }
      pobj = insert_pstobj(t,pobj,flag);
     switch (Rtoken()) {
      case COMMA:
	  break;
      case BRACKET:
	  reread = TRUE;
	  ((struct pst *)p)->p_lists = pobj;
          return(p);
      default:
	  sprintf(nbuf,"Illegal pst : >>> %c <<<",cbuf);
	  error(nbuf);
	}
   }
}

struct eclause *insert_pstobj(val,tail,flag)
struct term *val;
struct eclause *tail;
int flag;
{
  struct eclause *pre, *ptop = tail;
  register int f,i;
  if (! is_functor(Arg1(val))) {
    error_detail(Arg1(val),NULL_ENV,
		"Illegal Property name for PST");
  }
  if (tail == NULL_ECL)
    return(Npstobj(val,NULL_ENV,tail,flag));

  pre = tail;
  f = Pred(Arg1(val))->f_number;

  while (tail != NULL_ECL) {
    i = Pred(Arg1(tail->c_form))->f_number - f;
    if (i > 0) {
      if (pre == tail) return(Npstobj(val,NULL_ENV,tail,flag));
      else break;
    }
    if (i==0) {
      wfp = stderr;
      Pterm(Arg1(tail->c_form),NULL_ENV); NL;
      Pterm(Arg1(val),NULL_ENV);
      error("ERROR: There are same PNAMES in PST");
    }
    pre = tail;
    tail = tail->c_link;
  }
  pre->c_link = Npstobj(val,NULL_ENV,tail,flag);
  return(ptop);
 }

int is_term_end(c)
register char c;
{
  switch(c) {
    case '.':
    case ')':
    case '|' :
    case ',':
    case ';':
    case ']': return(TRUE);
    default:  return(FALSE);
    }
}

int prefix_is_atom(m)
int m;
{
  switch(tokentype) {
    case FULLSTOP: return(TRUE);
    case COMMA:
    case BRACKET:
      return(is_term_end(nbuf[0]));
    case NAME: {
      register struct operator *o;
      if ((o = op_search(nbuf,INFIX)) != NULL)
	if ((o->o_prec - ((o->o_type & 0010) != 0)) >= m) return(TRUE);
      if ((o = op_search(nbuf,POSTFIX)) != NULL)
	if ((o->o_prec - ((o->o_type & 0010) != 0)) >= m) return(TRUE);
      }
    default:  return(FALSE);
    }
}

struct term *Rterm_half(n,flag,m)
int n, flag, *m;
{
  register struct term *t;
  char tempname[NAMELEN_MAX];
  int ac = CONSTANT_TERM;

  switch (Rtoken()) {
    case BRACKET:
      switch (nbuf[0]) {
        case '[':
	  t = ((struct term *)Rlist(flag));
	  if ((Rtoken() != BRACKET) || nbuf[0] != ']') {
	    error_detail(t,NULL_ENV,"Syntax error --- ] missing");
	  }
	  advance;
	  return(t);
	case '(': 
	  advance;
	  t = Rterm(1200,flag);
	  if ((Rtoken() != BRACKET) || nbuf[0] != ')') {
	    error_detail(t,NULL_ENV,"Syntax error --- ) missing");
	  }
	  advance;
	  if (is_clause(t)) {
	    struct clause *c = (struct clause *)t;
	    return((c->c_link == NULL) ? c->c_form : t);
	    }
	  else return(t);
	case '{':
	  t = (struct term *)Rpst(flag);
	  if ((Rtoken() != BRACKET) || nbuf[0] != '}') {
	    error_detail(t,NULL_ENV,"Syntax error --- } missing");
	  }
	  advance;
	  return(t);
	default :
	  sprintf(nbuf,"Syntax Error: unexpected >>> %c <<<",nbuf[0]);
	  error(nbuf);
	}
    case VARNAME: /* variable */
      if (streq(nbuf, "_")) return(Anonymous_var);
      if((t = varsearch(nbuf))==NULL)
	   return(Nvar(nbuf,flag));
      else return(t);
    case NUMBER:  /* number */
      return(Nnum(nbuf,flag));
    case STRING:  /* string */
      return(Nstr(nbuf,flag));
    case FILE_TYPE: { /* file pointer */
      int pt;
      sscanf(nbuf,"%x",&pt);
      return(Nfile((FILE *)pt));
      }
    case NAME: /* name */
      strcpy(tempname,nbuf); /* tempname <- nbuf */ 
     
      /* constant or functor */
      if (check('(')) {
	register int i,arity = 0;
	struct clause *temp, *argstack;
	argstack = temp 
	  = Nclause(NULL_TERM,NULL_CL,TEMPORAL);

	while(1) {
	  reread = FALSE; /* read term */
	  t = Rterm(999,flag);
	  if (notconst(t)) ac = NOT_CONSTANT_TERM;
	  temp->c_link = Nclause(t,NULL_CL,TEMPORAL);
	  temp = temp->c_link;
	  arity++;
	  if (tokentype != COMMA) break;
	  advance;
	} 
	skip(')');
	t = Nterm(arity,flag);
	if (ac==CONSTANT_TERM) t->t_arity = -arity;
	t->type.t_func = Predicate(tempname,arity);
	temp = argstack;
	for(i=0; i < arity; i++) {
	  temp = temp->c_link;
	  t->tag.t_arg[i] = temp->c_form;
	}
	return(t);
      }

      {
	struct operator *o;

	if ((o = op_search(tempname, PREFIX)) == NULL) {
	  t = Nterm(0,flag);
	  t->type.t_func = Predicate(tempname,0);	  
	  return(t);
	}

	if (o->o_prec > n) {
	  sprintf(nbuf,"Syntax Error:>>> %s <<<",tempname);
	  error(nbuf);
	}
	Rtoken();
	reread=TRUE;
	if (prefix_is_atom(o->o_prec)) {
	  if (*m > n) error("Syntax error");
	  t = Nterm(0,flag);
	  t->type.t_func = Predicate(tempname,0);
	  return(t);
	}

	(t = Nterm(1,flag))->type.t_func = o->o_func;
	Arg1(t) = Rterm((o->o_prec - o->o_type + PREFIX),flag);
	*m = o->o_prec;
	if (isconst(Arg1(t))) t->t_arity = -t->t_arity;
	return(t);
      }
    default: /* else */
      sprintf(nbuf,"Syntax error --- unexpected %c",cbuf);
      error(nbuf);
   }
}

struct term *Rterm_leftover(n,m,flag,t)
register int n,flag,m;
struct term *t;
{
  struct operator *o;
  int ac = (notconst(t)) ? NOT_CONSTANT_TERM : CONSTANT_TERM;

  switch(Rtoken()) {
    case NAME:
      reread=FALSE;
      if ((o = op_search(nbuf,INFIX)) != NULL) {
	if ((o->o_prec <= n) && 
	    ((o->o_prec - ((o->o_type & 0010) ? 1 : 0)) >= m)) {
	  struct term *tt = Nterm(2,flag);
	  tt->type.t_func = o->o_func;
	  Arg1(tt) = t;
	  Arg2(tt) = Rterm(o->o_prec - (o->o_type & 0001), flag);
	  if ((ac == CONSTANT_TERM) && (isconst(Arg2(tt))))
	    tt->t_arity = -tt->t_arity;
	  return(Rterm_leftover(n,o->o_prec,flag,tt));
	}
      }
      if ((o = op_search(nbuf,POSTFIX)) != NULL) {
	if ((o->o_prec <= n) &&
	    (o->o_prec >= (m + ((o->o_type & 0010) ? 1 : 0)))) {
	  struct term *tt = Nterm(1,flag);
	  tt->type.t_func = o->o_func;
	  Arg1(tt) = t;
	  if (ac == CONSTANT_TERM) tt->t_arity = -tt->t_arity;
	  return(Rterm_leftover(n,o->o_prec,flag,tt));
	}
      }
    case FULLSTOP:
      reread = TRUE;
      return(t);
    case BRACKET:
      switch(nbuf[0]) {
        case '(':
        case '[':
	  sprintf(nbuf,"Syntax Error:>>> %c <<<",nbuf[0]);
	  error(nbuf);
	}
      return(t);
    case COMMA:
      if ((n >= 1000) && (m < 1000)) {
	struct term *tt;

	advance;
	tt = Rterm(1000,flag);
        reread = TRUE;
	if (! is_clause(tt))
	  tt=(struct term *)Nclause(tt,NULL_CL,flag);
	t = (struct term *)Nclause(t,(struct clause *)tt,flag);
	if (n > 1000)
	  return(Rterm_leftover(n,1000,flag,t));
      }
    default:
      return(t);
    }
}