/* ----------------------------------------------------------
% (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(')');
}
syntax highlighted by Code2HTML, v. 0.9.1