/* ----------------------------------------------------------
%   (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
==================================================================== */
/*--------------------------------------------------------------------
*	    <<<< print.c >>>>>>
*           print out routine
--------------------------------------------------------------------*/

#define DEBUG 0			/* when debug, 1 */
#include "include.h"

void Pterm_core(),Peclause_core(),Pclause_core(),Pcahc_core();
void init_pp(),scanpst_term(),scanpst_clause(),scanpst_eclause(),print_pp();
int pp_number();

/* global vars */
int PST_PRINT_NUM;		/* # of different psts */

/* 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 < 0) /* for EUC */
#define alphabet(CH)   ((char_type[CH] <= N) || (char_type[CH] >= UC))
#define is_lower(CH)   ((kanzi(CH)) || (char_type[CH] == LC))

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*    print basic structures:
* Pterm(t,e)
* Peclause(ec) : print eclause
* Pclause(c,e): print clause with delimiter ','
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void Pterm(t,e)			/* print term */
struct term *t;
struct pair *e;
{
	init_pp();
	scanpst_term(t,e);
	Pterm_core(t,e,Print_Depth);
	if(PST_PRINT_NUM > 1)
	{
		tputc(';');
		print_pp(Print_Depth); /* $1={...},$2={...},.. */
	}
}

void Peclause(ec)		/* print eclause */
struct eclause *ec;
{
	init_pp();
	scanpst_eclause(ec);
	Peclause_core(ec,Print_Depth);
	if(PST_PRINT_NUM > 1)
	{
		tputc(';');
		print_pp(Print_Depth);
	}
}

void Pclause(c,e)		/* print clause */
struct clause *c;
struct pair *e;
{
	init_pp();
	scanpst_clause(c,e);
	Pclause_core(c,e);
	if(PST_PRINT_NUM > 1)
	{
		tputc(';');
		print_pp(Print_Depth);
	}
}

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* showhorn(body,constraint,env): print CAHC
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void Showhorn(c,cst,e)	/* Show horn clause */
register struct clause *c,*cst;
register struct pair *e;
{
	void P_hclause();
	
	if (cst == NULL_CL) P_hclause(c,e);
	else
	{
		init_pp();
		scanpst_clause(c,e);
		scanpst_clause(cst,e);
		Pcahc_core(c,cst,e);	/* H:-Body;Constraint */
		if (PST_PRINT_NUM > 1)
		{
			tputc(',');
			print_pp(Print_Depth);
		}
		tputc('.');
	}
}

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Pgoal(n) : print goal in refutation
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void Pgoal(n)		/* print goal in refute() */
struct node *n;
{
	init_pp();
	scanpst_clause(n->n_clause, n->n_env);
	scanpst_eclause(n->n_constraint);
	Psequence(n->n_clause,n->n_env,Print_Depth);
	if (n->n_constraint != NULL_ECL) {
		tputc(';');
		Peclause_core(n->n_constraint,Print_Depth);
		if(PST_PRINT_NUM > 1)
		{
			tputc(',');
			print_pp(Print_Depth);
		}
	}
	else if(PST_PRINT_NUM > 1)
	{
		tputc(';');
		print_pp(Print_Depth);
	}
}

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Showfunc(func): print definition of a predicate
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void Showfunc(f)   /*  Show definitions of function *f  */
register struct func *f;
{
	register struct set *ts;

	if (isuser(f))
	{
		for (ts = f->def.f_set; ts != NULL; ts = ts->s_link) {
			Showhorn(ts->s_clause, ts->s_constraint, 
				 NULL_ENV);
#if DEBUG == 1
			printf("(an=%d bn=%d)",ts->s_anumber,ts->s_bodynumber);
#endif		
			NL; 
		}
	}
}


/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* P_hclause(cl,e): print Horn clause
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void P_hclause_sub(cl,e)	/* H:-C1,C2,...Cn */
struct clause *cl;
struct pair *e;
{
	register struct clause *c;

	Pterm_core(cl->c_form,e,Print_Depth);
	c = cl->c_link;
	if (c != NULL)
	{
		tprint0(" :- ");
		Pclause_core(c,e);
	}
}

void P_hclause(cl,e)
struct clause *cl;
struct pair *e;
{
	register struct clause *c;

	init_pp();
	scanpst_clause(cl,e);
	P_hclause_sub(cl,e,Print_Depth);
	if (PST_PRINT_NUM > 1)
	{
		tputc(';');
		print_pp(Print_Depth);
	}
	tputc('.');
}

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* P_dclause(cl,e): print derivation clause of unfold/fold trans.
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void P_dclause(cl,e)
struct clause *cl;
struct pair *e;
{
	register struct clause *c;

	init_pp();
	scanpst_clause(cl,e);
	Pterm_core(cl->c_form,e,Print_Depth);
	c = cl->c_link;
	if (c != NULL)
	{
		tprint0(" <=> ");
		Pclause_core(c,e);
	}
	if (PST_PRINT_NUM > 1)
	{
		tputc(',');
		print_pp(Print_Depth);
	}
	tputc('.');
}

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Shownewfunc(): print itrace
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void Shownewfunc()   /*  Show def of new functions constructed in integrate  */
{
	register struct itrace *it;

	for (it = newf_list; it != NULL; it = it->it_link){
		tprint2("<%d,%d> ",it->it_anumber,it->it_cnumber);
		P_dclause(it->it_clause,NULL);
		NL;
	}
}

/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* writenewfunc(): print itrace to file
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
void writenewfunc()
{
	register struct itrace *it;
	register struct func *f;

	if (newf_list == NULL) return;

	for (it = newf_list; it != NULL; it = it->it_link){
		f = it->it_clause->c_form->type.t_func;
		if (isnoreduced(f) && (f->def.f_set != NULL))
		{
			tprint0("$ ");
			P_dclause(it->it_clause,NULL);
			NL;
		}
	}
}

/* ------------------ local functions  ---------------------- */
int quote_needed(f)		/* need quote? */
struct func *f;
{
	register char *n = f->f_name;

	if (f == CUT_P) return(FALSE);

	if (! is_lower(*n)) return(TRUE);
	for ( ; *n != '\0'; n++) {	  if (kanzi(*n)) n++;
	  else if (! alphabet(*n)) return(TRUE);
	}
	return(FALSE);
}

void Pvar(t, n)	/* print var with env, as "t_n" */
register struct term *t;
int n;
{
     if (((struct var *)t)->v_type==VAR_VOID_TYPE) tputc('_') 
     else if (streq(vname(t),"_")) tprint1("_%u",n)
     else {
	     tprint2("%s_%u",vname(t),n);
#if DEBUG == 1
	     tprint2("<h%db%d>",vheadoccurrence(t),voccurrence(t));  
#endif
     }
}


void Pclause_core(c,e)		/* print clause main */
struct clause *c;
struct pair *e;
{
	if (c == NULL) return;
	for (;;)
	{
		Pterm_core(c->c_form,e,Print_Depth);
		c = c->c_link;
		if (c == NULL) return;
		tprint0(", ");
	}
}

void Pcahc_core(c,cst,e)	/* print CAHC main */
register struct clause *c,*cst;
register struct pair *e;
{
	Pterm_core(c->c_form,e,Print_Depth);	/* print head */
	if (c->c_link != NULL) {	/* print body */
		tprint0(":-");
		Psequence(c->c_link,e,0); /* 0 means infinity */
	}
	if (cst != NULL){	/* print constraint */
		tprint0("; ");
		Psequence(cst,e,0);
	}
	/* tputc('.'); */
}

void Pterm_core(t,e,d)	/* print term main */
register struct term *t;
register struct pair *e;
int d;
{
  register struct pair *p;

  if (t == NULL) {
    if (e == NULL) {
      tprint0("nil");
      return;
    }
    else return;	/* print nothing */
  }

  if (isvar(t)) {
    if (e == NULL) {
      Pvar(t, vnumber(t));
      return;
    }
    down(p,t,e);
    if(p != NULL) {	/* if t is not var */
      Pvar(t, (int)(p - eheap)); /* print its name with env */
      return;
    }
  }

  /* print literal */
  if (t == NIL) {		/* if t is NIL list ([]) */
    tprint0("[]");
    return;
  }

  if (!(--d)) {
    tprint0("???");
    return;
  }

#if DEBUG == 1
  if (isatom(t)) printf("~");
  else
  {
	  if(t->type.ident < 100)
		  printf("<t=%x e=%x y=%d>",t,e,t->type.ident);
	  else printf("<t=%x e=%x>",t,e);
  }
#endif

  switch (t->type.ident) {
    /* case VAR_VOID_TYPE:
       case VAR_PST_TYPE:
       case VAR_GLOBAL_TYPE: */ /* already checked in the above */
    case ATOMIC_TYPE: /* atomic */
      switch (t->t_arity) {
        case FLOAT_NUM : tprint1("%f",num_value(t)); /* float */
	  return;
	case INT_NUM  : tprint1("%d",(int)(num_value(t))); /* int */
	  return; 
	case STRING : tprint1("\"%s\"", str_value(t)); /* string */
	  return;
	default : tprint1("#%x", str_value(t)); /* file */
	  return;
	}
    case PST_TYPE: /* pst */
      /* tputc('{');*/
      Ppst(t,e,d);
      /* tputc('}'); */
      return;
    case CLAUSE_TYPE: /* clause */
      tputc('(');
      Psequence((struct clause *)t,e,d);
      tputc(')');
      return;
    case ECLAUSE_TYPE: /* eclaues */
      Peclause_core(t,d);
      return;
    case LIST_TYPE:
    case CONST_LIST_TYPE: /* list */
      tputc('[');
      Psequence((struct clause *)t,e,d);
      tputc(']');
      return;
    default:			/* complex term */
      Pfunctor(t,e,d);
      return;
    }
}

void Pfunctor(t,e,d)  /* print complex term */
register struct term *t;
register struct pair *e;
int d;
{
  register struct func *f = t->type.t_func; /* f is functor of t */
  register int i, arity = f->f_arity;
  struct operator *o;

  if ((arity == 2) || (arity == 1)) {
    for(o = o_list; o != NULL; o=o->o_link)
      if (o->o_func == f) {
	switch (o->o_type & INFIX) {
	case INFIX:
	  Pterm_core(Arg(t,0),e,d);
	  tprint1("%s",f->f_name);
	  Pterm_core(Arg(t,1),e,d);
	  return;
	case PREFIX:
	  tprint1("%s ",f->f_name);
	  Pterm_core(Arg(t,0),e,d);
	  return;
	case POSTFIX:
	  Pterm_core(Arg(t,0),e,d);
	  tprint1(" %s",f->f_name);
	  return;
	}
      }
  }

  /* print functor name */
  if (quote_needed(f))
    tprint1("\'%s\'", f->f_name)
  else 
    tprint1("%s", f->f_name);
  if(t->t_arity==0) return;	/* if t is const */

  tputc('(');		/* print args */
  i=0;
  while (1) {
    Pterm_core(Arg(t,i), e,d);	/* print one arg */
    if(++i >= arity) {
      tputc(')');
      break;
    }
    tprint0(", ");
  }
}

void Ppst_content(ptt,d)	/* {l1/v1,l2/v2,...} temporal PST*/
struct eclause *ptt;
{
	tputc('{');
	while (ptt->c_link != NULL_ECL) {
		Pterm_core(ptt->c_form, ptt->c_env,d);
		tprint0(", ");
		ptt = ptt->c_link;
	}
	Pterm_core(ptt->c_form, ptt->c_env,d);
	tputc('}');
}

				/* patch 92/1/22 by H.Tsuda */
void Ppst_content2(ptt,env,d)	/* {l1/v1,l2/v2,...} static PST with env */
struct eclause *ptt;
struct pair *env;
{
	tputc('{');
	while (ptt->c_link != NULL_ECL) {
		Pterm_core(ptt->c_form, env,d);
		tprint0(", ");
		ptt = ptt->c_link;
	}
	Pterm_core(ptt->c_form,env,d);
	tputc('}');
}

void Ppst(t,e,d)		/* print pst (in Pterm_core) */
struct term *t;			/* actually, (struct pst *) */
struct pair *e;
int d;
{
  register struct eclause *ptt = ((struct pst *)t)->p_lists;
  struct pst_item *target;
  int n;

  target = find_pstitem(t,e);
  if (target != NULL_PSTIT) { /* print temporal PST */
    ptt = target->p_lists;
    if (ptt == NULL_ECL) {
	    tprint0("{}");
	    return;
    }
#if DEBUG == 1
    printf("<pl=%x>",ptt);
#endif
    n = pp_number(ptt);
    if (n > 0) {		/* called more than once!! */
	    tprint1("_p%d",n);
	    return;
    }
    Ppst_content(ptt,d);	/* print temporal PST */
  }
  else {			/* print (static) PST in program */
    if (ptt == NULL_ECL)
    {
	    tprint0("{}");
	    return;
    }
#if DEBUG == 1
    printf("<pl=%x>",ptt);
#endif
    n = pp_number(ptt);
    if (n > 0) {		/* called more than once!! */
	    tprint1("_p%d",n);
	    return;
    }
    Ppst_content2(ptt,e,d);	/* print static PST with env */
  }
}

void Peclause_core(ec,d)	/* print eclause main */
struct eclause *ec;
int d;
{
	if (ec == NULL) return;
	while (1) {
		Pterm_core(ec->c_form, ec->c_env,d);
		ec = ec->c_link;
		if (ec == NULL) return;
		tputc(',');
	}
}

void Psequence(t,e,d)	/* print content of list t */
struct clause *t;
register struct pair *e;
int d;
{
  register struct pair *p;
  register struct term *tt = (struct term *)t;

  if ((tt == NULL) || (tt == NIL)) return;

  while (1) {
    Pterm_core(t->c_form,e,d);	/* print the first argument */
    t = t->c_link;
    tt = (struct term *)t;

    if (tt == NULL) return;
    if (isvar(tt)) {
      if (e == NULL) {
	tprint0(" | ");
	Pvar(tt, vnumber(tt));
	return;
      }
      down(p, tt, e);
      if (p != NULL) { /* if tt is variable */
	tprint0(" | ");
	Pvar(tt, (int)(p - eheap));
	return;
      }
    }
    if (! (is_list(tt) || is_clause(tt))) {
      if (tt == NIL) return;
      tprint0(" | ");
      Pterm_core(tt,e,d);
      return;
    }
    tputc(',');
    t = (struct clause *)tt;
      }
}

/* ------------- functions for PST pretty print --------------- */
struct pstprint
{
	struct eclause *pp_ec;
	int pp_num;
	struct pstprint *pp_link;
};

struct pstprint *PST_PRINT_LIST; /* pst save entry */

void init_pp()
{
	PST_PRINT_LIST = NULL;
	PST_PRINT_NUM = 1;
}

void print_pp(d)		/* $1={...},$2={...},... */
int d;				/* printing depth */
{
	register struct pstprint *pp;
	int printed = 0;

	for(pp = PST_PRINT_LIST; pp !=NULL; pp=pp->pp_link)
	{
		if (pp->pp_num != 0){
			if (printed != 0) tputc(',')
			else printed=1;
			tprint1("_p%d=",pp->pp_num);
			Ppst_content(pp->pp_ec,d);
		}
	}
}

int pp_number(ec)		/* print PST number */
struct eclause *ec;
{
	register struct pstprint *pp,*ppn;

	for (pp = PST_PRINT_LIST; pp != NULL; pp = pp->pp_link)
		if (pp->pp_ec == ec) return(pp->pp_num);
	return(0);
}

void scanpst_term(t,e)	/* scan PST in a term */
register struct term *t;
register struct pair *e;
{
  register struct pair *p;
  void addpst(),scanpst_functor();

  if (t == NULL) return;
  if (isvar(t)) {
	  if (e == NULL) return;
	  down(p,t,e);
	  if(p != NULL) return;
  }
  if (t == NIL) return; /* if t is NIL list ([]) */
  switch (t->type.ident) {
    case ATOMIC_TYPE: /* atomic */
	  return;
    case PST_TYPE: /* pst */
	  addpst(t,e);
	  return;
    case CLAUSE_TYPE: /* clause */
	  scanpst_clause((struct clause *)t,e);
	  return;
    case ECLAUSE_TYPE: /* eclaues */
	  scanpst_eclause((struct eclause *)t);
    case LIST_TYPE:
    case CONST_LIST_TYPE: /* list */
	  scanpst_clause((struct clause *)t,e);
	  return;
    default:			/* complex term */
	  scanpst_functor(t,e);
	  return;
  }
}

void scanpst_clause(t,e)	/* modify Psequence() */
struct clause *t;
struct pair *e;
{
  register struct pair *p;
  register struct term *tt = (struct term *)t;

  if ((tt == NULL) || (tt == NIL)) return;

  while (1) {
	  scanpst_term(t->c_form,e);	/* scan the first argument */
	  t = t->c_link;
	  tt = (struct term *)t;
	  
	  if (tt == NULL) return;
	  if (isvar(tt)) {
		  if (e == NULL)  return;
		  down(p, tt, e);
		  if (p != NULL) return;
	  }
	  if (! (is_list(tt) || is_clause(tt))) {
		  if (tt == NIL) return;
		  scanpst_term(tt,e);
		  return;
	  }
	  t = (struct clause *)tt;
  }
}

void scanpst_eclause(ec)
struct eclause *ec;
{
	if (ec == NULL_ECL) return;
	scanpst_term(ec->c_form,ec->c_env);
	scanpst_eclause(ec->c_link);
}

void scanpst_functor(t,e)
struct term *t;
struct pair *e;
{
	int i,arity;
	arity = t->t_arity;
	for (i = 0; i < arity; i++)
		scanpst_term(Arg(t,i),e);
}

void addpst(t,e)
struct term *t;
struct pair *e;
{
  register struct eclause *ptt = ((struct pst *)t)->p_lists;
  struct pst_item *target;
  struct pstprint *pp,*ppnew;

  target = find_pstitem(t,e);
  if (target != NULL_PSTIT)  ptt = target->p_lists;
  if (ptt == NULL_ECL) return;
  for (pp = PST_PRINT_LIST; pp != NULL; pp = pp->pp_link)
	  if (pp->pp_ec == ptt) {
		  if (pp->pp_num == 0)
			  pp->pp_num = PST_PRINT_NUM++;
		  return;
	  }
  MEMORY_ALLOC(ppnew,pstprint,TEMPORAL);
  ppnew->pp_ec = ptt;
  ppnew->pp_num = 0;
  ppnew->pp_link = PST_PRINT_LIST;
  PST_PRINT_LIST = ppnew;
}

/* ------------- functions for debug ------------------- */
void P_var(vlist)		/* for debug */
struct term *vlist;
{
	register struct term *v;

	for (v = vlist; v != NULL; v = vlink(v))
	{
		printf("%s-(%d)-",vname(v),v->type.ident);

		Pclause_core(vconstraint(v),NULL);
		NL;
	}
}

void showvar(v)			/* show variable (for debug) */
struct term *v;
{
	putchar('(');
	while (v != NULL)
	{
		printf("%s ",vname(v));
		v = vlink(v);
	}
	putchar(')');
}