print.c

Go to the documentation of this file.

/* Copyright 1991 Digital Equipment Corporation.
** All Rights Reserved.
*****************************************************************/

#include "defs.h"

long print_depth=PRINT_DEPTH;
long indent=FALSE;
long const_quote=TRUE;
long write_resids=FALSE;
long write_canon=FALSE;
long write_stderr=FALSE;
long write_corefs=TRUE;

long page_width=PAGE_WIDTH;

long display_persistent=FALSE;
  
char *no_name="pointer";
char *name="symbol";
// char *buffer;
char seg_format[PRINT_POWER+4];

item pretty_things[PRETTY_SIZE];

/* Used to distinguish listings from other writes */
static long listing_flag;

/* Used to list function bodies in a nice way */
/* Only valid if listing_flag==TRUE */
static long func_flag;

/* Precedence of the comma and colon operators (or 0 if none exists) */
#define COMMA_PREC ((commasym->op_data)?(commasym->op_data->precedence):0)
#define COLON_PREC ((colonsym->op_data)?(colonsym->op_data->precedence):0)



void init_print()
{
  (void)snprintf(seg_format,PRINT_POWER+4,"%%0%ldd",PRINT_POWER);
}

char * heap_nice_name()
{
  string tmp1,tmp2;
  char g,len; // ,leading_a;

  g= ++gen_sym_counter;
  len=2;
  strcpy(tmp2,"");
  do {
    g--;
    /* Prefix one character to tmp2: */
    (void)snprintf(tmp1,2,"%c",g%26+'A');
    strcat(tmp1,tmp2);
    strcpy(tmp2,tmp1);
    g=g/26;
    len++;
  } while (g>0 && len<STRLEN);
  if (len>=STRLEN)
    perr("Variable name too long -- the universe has ceased to exist.");

  strcpy(tmp1,"_");
  strcat(tmp1,tmp2);
  
  return heap_copy_string(tmp1);
}

GENERIC unique_name()
{
  GENERIC name_loc;

  do name_loc=(GENERIC)heap_nice_name(); 
  while (find(STRCMP,(char *)name_loc,var_tree));

  return name_loc;
}

long str_to_int(char *s)
{
  long v=0;
  char c;

  c=(*s);
  if (c==0)
    v= -1;
  else {
    while (DIGIT(c)) {
      v=v*10+(c-'0');
      s++;
      c=(*s);
    }
    if (c!=0) v= -1;
  }

  return v;
}

void print_bin(long b)
{
  long p;

  for (p=INT_SIZE;p--;p>0) 
  {
    fprintf(outfile,(b&1?"X":" "));
    b = b>>1;
  }
}

void print_code(FILE *s,ptr_int_list c)
{
  outfile=s;

  if (c==NOT_CODED)
    fprintf(outfile,"  (not coded) ");
  else {
    fprintf(outfile,"  [");
    while (c) {
      print_bin((long)c->value_1);
      c=c->next;
    }
    fprintf(outfile,"]");
  }
}

void print_operator_kind(FILE *s,long kind)
{
  switch (kind) {
  case xf:
    fprintf(s,"xf");
    break;
  case fx:
    fprintf(s,"fx");
    break;
  case yf:
    fprintf(s,"yf");
    break;
  case fy:
    fprintf(s,"fy");
    break;
  case xfx:
    fprintf(s,"xfx");
    break;
  case xfy:
    fprintf(s,"xfy");
    break;
  case yfx:
    fprintf(s,"yfx");
    break;
  default:
    fprintf(s,"illegal");
    break;
  }
}

void check_pointer(ptr_psi_term p)
{
  ptr_node n;
  
  if (p) {
    deref_ptr(p);
    n=find(INTCMP,(char *)p,pointer_names);
    if (n==NULL) {
      (void)heap_insert(INTCMP,(char *)p,&pointer_names,(GENERIC)NULL);
      go_through(p);
    }
    else
      n->data=(GENERIC)no_name;
  }
}

void go_through_tree(ptr_node t)
{
  if (t) {
    if (t->left) {
      go_through_tree(t->left);
    }
    check_pointer((ptr_psi_term)t->data);
    if (t->right) {
      go_through_tree(t->right);
    }
  }

}

void go_through(ptr_psi_term t)
{
  if (t->attr_list)
    go_through_tree(t->attr_list);

  /*
  if(r=t->resid)
    while(r) {
      if(r->goal->pending)
    go_through(r->goal->aaaa_1);
      r=r->next;
    } */
}

void insert_variables(ptr_node vars,long force)
{
  ptr_psi_term p;
  ptr_node n;
  
  if(vars) {
    insert_variables(vars->right,force);
    p=(ptr_psi_term )vars->data;
    deref_ptr(p);
    n=find(INTCMP,(char *)p,pointer_names);
    if (n)
      if (n->data || force)
    n->data=(GENERIC)vars->key;
    insert_variables(vars->left,force);
  }
}

void forbid_variables(ptr_node n)
{
  ptr_psi_term v;
  
  if(n) {
    forbid_variables(n->right);
    v=(ptr_psi_term )n->data;
    deref_ptr(v);
    (void)heap_insert(INTCMP,(char *)v,&printed_pointers,(GENERIC)n->key);
    forbid_variables(n->left);
  }
}

void prettyf_inner(char *s,long q,char c)
{
  char *sb=buffer;

  if (indent) {
    while (*sb) sb++;
    if (q) { *sb = c; sb++; }
    while (*s) {
      if (q && *s==c) { *sb = *s; sb++; }
      *sb = *s; sb++; s++;
    }
    if (q) { *sb = c; sb++; }
    *sb=0;
  }
  else {
    if (q) (void)putc(c,outfile);
    while (*s) {
      if (q && *s==c) { (void)putc(*s,outfile); }
      (void)putc(*s,outfile);
      s++;
    }
    if (q) (void)putc(c,outfile);
  }
}

long starts_nonlower(char *s)
{
  return (*s && !LOWER(s[0]));
}

long has_non_alpha(char *s)
{
  while (*s) {
    if (!ISALPHA(*s)) return TRUE;
    s++;
  }
  return FALSE;
}

long all_symbol(char *s)
{
  while (*s) {
    if (!SYMBOL(*s)) return FALSE;
    s++;
  }
  return TRUE;
}

long is_integer(char *s)
{
  if (!*s) return FALSE;
  if (*s=='-') s++;
  while (*s) {
    if (!DIGIT(*s)) return FALSE;
    s++;
  }
  return TRUE;
}

long no_quote(char *s)
{
  if (!s[0]) return FALSE;

  if (s[0]=='%') return FALSE;
  if (SINGLE(s[0]) && s[1]==0) return TRUE;
  if (s[0]=='_'    && s[1]==0) return FALSE;
  if (all_symbol(s)) return TRUE;

  if (!LOWER(s[0])) return FALSE;
  s++;
  while (*s) {
    if (!ISALPHA(*s)) return FALSE;
    s++;
  }
  return TRUE;
}

void prettyf(char *s)
{
  prettyf_inner(s,FALSE,'\'');
}

void prettyf_quoted_string(char *s)
{
  prettyf_inner((char *)s,const_quote,'"');
}

void prettyf_quote(char *s)
{
  prettyf_inner(s, const_quote && !no_quote(s), '\'');
}
/*
                  !is_integer(s) &&
                  (starts_nonlower(s) || has_non_alpha(s)) &&
                  ((int)strlen(s)>1
                  ? !all_symbol(s):
                    ((int)strlen(s)==1
                    ? (s[0]==' ' || s[0]=='_' || UPPER(s[0]) || DIGIT(s[0]))
                    : TRUE
                    )
                  ),
                '\'');
*/

void end_tab()
{
  if (indent) {
    indx->str=(char *)heap_alloc(strlen(buffer)+1);
    strcpy(indx->str,buffer);
    indx++;
    *buffer=0;
  }
}

void mark_tab(ptr_tab_brk t)
{
  end_tab();
  indx->tab=t;
}

void new_tab(ptr_tab_brk *t)
{
  (*t)=HEAP_ALLOC(tab_brk);
  (*t)->broken=FALSE;
  (*t)->printed=FALSE;
  (*t)->column=0;
}


long strpos(long pos, char *str)
{
  while (*str) {
    if (str[0]=='\n') pos=0; else pos++;
    str++;
  }
  return pos;
}

void work_out_length()
{
  ptr_item i;
  long done=FALSE;
  long pos;
  ptr_tab_brk worst,root;
  long w;
  
  while(!done) {
    
    pos=0;
    done=TRUE;
    
    w= -1;
    worst=NULL;
    root=NULL;
    
    for(i=pretty_things+1;(unsigned long)i<(unsigned long)indx;i++) {
      
      if(i->tab->broken && i->tab->printed) {
    pos=i->tab->column;
    root=NULL;
      }
      
      if(!i->tab->printed) i->tab->column=pos;
      
      if(!(i->tab->broken))
    if(!root || (root && (root->column)>=(i->tab->column)))
      root=i->tab;
      
      /* pos=pos+strlen(i->str); */
      pos=strpos(pos,i->str);
      i->tab->printed=TRUE;
      
      if(pos>page_width)
    done=FALSE;
      
      if(pos>w) {
    w=pos;
    worst=root;
      }
    }

    for(i=pretty_things+1;(unsigned long)i<(unsigned long)indx;i++)
      i->tab->printed=FALSE;
    
    if(!done)      
      if(worst)
    worst->broken=TRUE;
      else
    done=TRUE;
  }
}

/*** RM: Dec 11 1992  (START) ***/

long count_features(ptr_node t)
{
  long c=0;
  if(t) {
    if(t->left)
      c+=count_features(t->left);
    c++;
    if(t->right)
      c+=count_features(t->right);
  }
  return c;
}

long check_legal_cons(ptr_psi_term t,ptr_definition t_type)
{
  return (t->type==t_type &&
      count_features(t->attr_list)==2 &&
      find(FEATCMP,one,t->attr_list) &&
      find(FEATCMP,two,t->attr_list));
}

/*** RM: Dec 11 1992  (END) ***/
    
void pretty_list(ptr_psi_term t,long depth)
{
  ptr_tab_brk new;
  ptr_definition t_type;
  ptr_psi_term car,cdr;
  ptr_node n; 
  char sep[4],end[3];
  long list_depth; /* 20.8 */
  long done=FALSE; /* RM: Dec 11 1992 */
  
  strcpy(sep,"ab");
  strcpy(end,"cd");
  t_type=t->type;
  
  if (overlap_type(t_type,alist)) {
    if (!equal_types(t_type,alist)) {
      pretty_symbol(t_type->keyword);  /*  RM: Jan 13 1993  */
      prettyf(DOTDOT);
    }
    prettyf("[");
    strcpy(sep,",");
    strcpy(end,"]");
  }

  /*
    else if (equal_types(t_type,conjunction)) {
      prettyf("(");
      strcpy(sep,DOTDOT);
      strcpy(end,")");
      }
      */
  
  else if (equal_types(t_type,disjunction)) {
    prettyf("{");
    strcpy(sep,";");
    strcpy(end,"}");
  }

  
  /* RM: Dec 11 1992  New code for printing lists */
  
  new_tab(&new);
  list_depth=0; /* 20.8 */
  while(!done) {
    mark_tab(new);
    if(list_depth==print_depth)
      prettyf("...");

    get_two_args(t->attr_list,&car,&cdr);
    deref_ptr(car);
    deref_ptr(cdr);

    
    if(list_depth<print_depth)
      pretty_tag_or_psi_term(car,COMMA_PREC,depth);
    
    /* Determine how to print the CDR */
    n=find(INTCMP,(char *)cdr,pointer_names);
    
    if(n && n->data) {
      prettyf("|");
      pretty_tag_or_psi_term(cdr,MAX_PRECEDENCE+1,depth);
      done=TRUE;
    }
    else
      if(( /*  RM: Feb  1 1993  */
      (cdr->type==nil && overlap_type(t_type,alist)) ||
      (cdr->type==disj_nil && t_type==disjunction)
      )
      && !cdr->attr_list)
    done=TRUE;
      else
    if(!check_legal_cons(cdr,t_type)) {
      prettyf("|");
      pretty_tag_or_psi_term(cdr,MAX_PRECEDENCE+1,depth);
      done=TRUE;
    }
    else {
      if(list_depth<print_depth)
        prettyf(sep);
      t=cdr;
    }
    
    list_depth++;
  }
  
  prettyf(end);
}

void pretty_tag_or_psi_term(ptr_psi_term p, long sprec, long depth)
{
  ptr_node n,n2;

  if (p==NULL) {
    prettyf("<VOID>");
    return;
  }
  if (FALSE /*depth>=print_depth*/) { /* 20.8 */
    prettyf("...");
    return;
  }
  deref_ptr(p);
  
  n=find(INTCMP,(char *)p,pointer_names);
  
  if (n && n->data) {
    if (n->data==(GENERIC)no_name) {
      n->data=(GENERIC)unique_name();
      /* sprintf(name,"_%ld%c",++gen_sym_counter,0); */
      /* n->data=(GENERIC)heap_copy_string(name); */
    }
    n2=find(INTCMP,(char *)p,printed_pointers);
    if(n2==NULL) {
      prettyf((char *)n->data);
      (void)heap_insert(INTCMP,(char *)p,&printed_pointers,(GENERIC)n->data);
      if (!is_top(p)) {
        prettyf(DOTDOT);
        pretty_psi_term(p,COLON_PREC,depth);
      }
    }
    else
      prettyf((char *)n2->data);
  }
  else
    pretty_psi_term(p,sprec,depth);
}

long check_opargs(ptr_node n)
{
  if (n) {
    long f=check_opargs(n->left) | check_opargs(n->right);
    if (!featcmp(n->key,"1")) return 1 | f;
    if (!featcmp(n->key,"2")) return 2 | f;
    return 4 | f;
  }
  else
    return 0;
}


long opcheck(ptr_psi_term t, long *prec, long *type)
{
  long op;
  long result=NOTOP;
  long numarg=check_opargs(t->attr_list);
  ptr_operator_data opdat=t->type->op_data;

  *prec=0;
  if (numarg!=1 && numarg!=3) return NOTOP;
  while (opdat) {
    op=opdat->type;
    if (numarg==1) {
      if (op==xf || op==yf) { result=POSTFIX; break; }
      if (op==fx || op==fy) { result=PREFIX; break; }
    }
    if (numarg==3)
      if (op==xfx || op==xfy || op==yfx) { result=INFIX; break; }
    opdat=opdat->next;
  }
  if (opdat==NULL) return NOTOP;
  *prec=opdat->precedence;
  *type=op;
  return result;
}

long pretty_psi_with_ops(ptr_psi_term t,long sprec,long depth)
{
  // ptr_tab_brk new;
  ptr_psi_term arg1, arg2;
  long ttype, a1type, a2type;
  long tprec, a1prec, a2prec;
  long tkind, a1kind, a2kind;
  long p1, p2, argswritten;
  long sp; /* surrounding parentheses */

  if (write_canon) return FALSE; /* PVR 24.2.94 */

  argswritten=TRUE;
  tkind=opcheck(t, &tprec, &ttype);
  sp=(tkind==INFIX||tkind==PREFIX||tkind==POSTFIX) && tprec>=sprec;
  if (sp) prettyf("(");
  if (tkind==INFIX) {
    get_two_args(t->attr_list, &arg1, &arg2);
    deref_ptr(arg1); /* 16.9 */
    deref_ptr(arg2); /* 16.9 */
    a1kind = opcheck(arg1, &a1prec, &a1type);
    a2kind = opcheck(arg2, &a2prec, &a2type);

    /* The p1 and p2 flags tell whether to put parens around t's args */
    /* Calculate p1 flag: */
    if      (a1prec>tprec) p1=TRUE;
    else if (a1prec<tprec) p1=FALSE;
    else /* equal priority */
      if (ttype==xfy || ttype==xfx) p1=TRUE;
      else /* yfx */
        if (a1type==yfx || a1type==fx || a1type==fy) p1=FALSE;
        else p1=TRUE;

    /* Calculate p2 flag: */
    if      (a2prec>tprec) p2=TRUE;
    else if (a2prec<tprec) p2=FALSE;
    else /* equal priority */
      if (ttype==yfx || ttype==xfx) p2=TRUE;
      else /* xfy */
        if (a2type==xfy || a2type==xf || a2type==yf) p2=FALSE;
        else p2=TRUE;

    /* Write the expression */
    if (p1) prettyf("(");
    pretty_tag_or_psi_term(arg1,MAX_PRECEDENCE+1,depth);
    if (p1) prettyf(")");
    if (!p1 && strcmp(t->type->keyword->symbol,",")) {
      prettyf(" ");
    }
    pretty_quote_symbol(t->type->keyword); /*  RM: Jan 13 1993  */
    if (listing_flag && !func_flag &&
        (!strcmp(t->type->keyword->symbol,",") ||
         !strcmp(t->type->keyword->symbol,":-"))) {
      prettyf("\n        ");
    }
    else {
      if (!p2 && strcmp(t->type->keyword->symbol,".")) prettyf(" ");
    }
    if (p2) prettyf("(");
    pretty_tag_or_psi_term(arg2,MAX_PRECEDENCE+1,depth);
    if (p2) prettyf(")");
  }
  else if (tkind==PREFIX) {
    get_two_args(t->attr_list, &arg1, &arg2); /* arg2 does not exist */
    a1kind = opcheck(arg1, &a1prec, &a1type);

    /* Calculate p1 flag: */
    if (a1type==fx || a1type==fy) p1=FALSE;
    else p1=(tprec<=a1prec);

    pretty_quote_symbol(t->type->keyword);  /*  RM: Jan 13 1993  */
    if (!p1) prettyf(" ");
    if (p1) prettyf("(");
    pretty_tag_or_psi_term(arg1,MAX_PRECEDENCE+1,depth);
    if (p1) prettyf(")");
  }
  else if (tkind==POSTFIX) {
    get_two_args(t->attr_list, &arg1, &arg2); /* arg2 does not exist */
    a1kind = opcheck(arg1, &a1prec, &a1type);

    /* Calculate p1 flag: */
    if (a1type==xf || a1type==yf) p1=FALSE;
    else p1=(tprec<=a1prec);

    if (p1) prettyf("(");
    pretty_tag_or_psi_term(arg1,MAX_PRECEDENCE+1,depth);
    if (p1) prettyf(")");
    if (!p1) prettyf(" ");
    pretty_quote_symbol(t->type->keyword); /*  RM: Jan 13 1993  */
  }
  else {
    argswritten=FALSE;
  }
  if (sp) prettyf(")");
  return argswritten;
}

/****************************************************************************/

void pretty_psi_term(ptr_psi_term t,long sprec,long depth)
{
  char buf[STRLEN]; /* Big enough for a long number */
  ptr_residuation r;
  long argswritten;
  //  double fmod();
  
  if (t) {
    deref_ptr(t); /* PVR */

    /* if (trace) printf("<%ld>",t->status); For brunobug.lf PVR 14.2.94 */

    /*  RM: Feb 12 1993  */
    if(display_persistent &&
       (GENERIC)t>heap_pointer)
      prettyf(" $");
    
    if((t->type==alist || t->type==disjunction) && check_legal_cons(t,t->type))
      pretty_list(t,depth+1); /*  RM: Dec 11 1992  */
    else
      if(t->type==nil && !t->attr_list)
    prettyf("[]");
      else
    if(t->type==disj_nil && !t->attr_list) /*  RM: Feb  1 1993  */
      prettyf("{}");
    else {
    argswritten=FALSE;
    if (t->value_3) {
#ifdef CLIFE
      if(t->type->type==block) {  /* RM 20 Jan 1993 */
            pretty_block(t);          /* AA 21 Jan 1993 */
      }
      else
#endif /* CLIFE */
      if (sub_type(t->type,integer)) {
        /* Print integers in chunks up to the full precision of the REAL */
        long seg,neg,i;
        REAL val;
        char segbuf[100][PRINT_POWER+3];
        
        val = *(REAL *)t->value_3;
        neg = (val<0.0);
        if (neg) val = -val;
        if (val>WL_MAXINT) goto PrintReal;
        seg=0;
        while (val>=(double)PRINT_SPLIT) {
          double tmp;
          tmp=(REAL)fmod((double)val,(double)PRINT_SPLIT);
          (void)snprintf(segbuf[seg],100,seg_format,(unsigned long)tmp);
          val=floor(val/(double)PRINT_SPLIT);
          seg++;
        }
        (void)snprintf(segbuf[seg],100,"%s%ld",(neg?"-":""),(unsigned long)val);
        for (i=seg; i>=0; i--) prettyf(segbuf[i]);
        if (!equal_types(t->type,integer)) {
          prettyf(DOTDOT);
          pretty_symbol(t->type->keyword); /*  RM: Jan 13 1993  */
        }
      }
      else if (sub_type(t->type,real)) {
      PrintReal:
        (void)snprintf(buf,STRLEN,"%lg",*(REAL *)t->value_3);
        prettyf(buf);
        if (!equal_types(t->type,real) &&
        !equal_types(t->type,integer)) {
          prettyf(DOTDOT);
          pretty_symbol(t->type->keyword); /*  RM: Jan 13 1993  */
        }
      }
      else if (sub_type(t->type,quoted_string)) {
        prettyf_quoted_string((char *)t->value_3);
        if(!equal_types(t->type,quoted_string)) {
          prettyf(DOTDOT);
          pretty_quote_symbol(t->type->keyword); /*  RM: Jan 13 1993  */
        }
      }
      /* DENYS: BYTEDATA */
      else if (sub_type(t->type,sys_bytedata)) {
        pretty_quote_symbol(t->type->keyword);
      }
      else if (equal_types(t->type,stream)) {
        (void)snprintf(buf,STRLEN,"stream(%ld)",(long)t->value_3);
        prettyf(buf);
      }
      else if (equal_types(t->type,eof))
        pretty_quote_symbol(eof->keyword); /*  RM: Jan 13 1993  */
      else if (equal_types(t->type,cut))
        pretty_quote_symbol(cut->keyword); /*  RM: Jan 13 1993  */
      else {
        prettyf("*** bad object '");
        pretty_symbol(t->type->keyword); /*  RM: Jan 13 1993  */
        prettyf("'***");
      }
    }
    else {
      if (depth<print_depth) /* 20.8 */
        argswritten=pretty_psi_with_ops(t,sprec,depth+1);
      /*  RM: Jan 13 1993  */
      if (!argswritten) pretty_quote_symbol(t->type->keyword);
    }
    
    /* write_canon -- PVR 24.2.94 */
    if (!argswritten && t->attr_list &&
        (depth<print_depth || write_canon)) /* 20.8 */
      pretty_attr(t->attr_list,depth+1);
    
    if (depth>=print_depth && !write_canon && t->attr_list) /* 20.8 */
      prettyf("(...)");
      }
    if ((r=t->resid))
      while (r) {
    if (r->goal->pending) {
          if (FALSE /* write_resids 11.8 */) {
        prettyf("\\");
        pretty_psi_term(r->goal->aaaa_1,0,depth);
          }
          else
        prettyf("~");
    }
    r=r->next;
      }
  }
}

void do_pretty_attr(ptr_node t,ptr_tab_brk tab,long *cnt,long two,long depth)
{
  long v;
  char s[4];
  ptr_module module;
  
  if (t) {
    if (t->left) {
      do_pretty_attr(t->left,tab,cnt,two,depth);
      prettyf(",");
    }
    
    /* Don't start each argument on a new line, */
    /* unless printing a function body: */
    mark_tab(tab);
    
    v=str_to_int(t->key);
    if (v<0) {
      if(display_modules) { /*  RM: Jan 21 1993  */
    module=extract_module_from_name(t->key);
    if(module) {
      prettyf(module->module_name);
      prettyf("#");
    }
      }
      prettyf_quote(strip_module_name(t->key));

      prettyf(" => ");
    }
    else if (v== *cnt)
      (*cnt)++ ;
    else {
      (void)snprintf(s,4,"%ld",v);
      prettyf(s); /* 6.10 */
      prettyf(" => ");
    }
    
    /* pretty_tag_or_psi_term(t->data,(two?COMMA_PREC:MAX_PRECEDENCE+1)); */
    pretty_tag_or_psi_term((ptr_psi_term)t->data,COMMA_PREC,depth);
    
    if (t->right) {
      prettyf(",");
      do_pretty_attr(t->right,tab,cnt,two,depth);
    }
  }
}


long two_or_more(ptr_node t)
{
  if (t) {
    if (t->left || t->right) return TRUE; else return FALSE;
  }
  else
    return FALSE;
}

void pretty_attr(ptr_node t,long depth)
{
  ptr_tab_brk new;
  long cnt=1;

  prettyf("(");
  new_tab(&new);

  do_pretty_attr(t,new,&cnt,two_or_more(t),depth);

  prettyf(")");
}

void pretty_output()
{
  ptr_item i;
  long j;
  
  for(i=pretty_things+1;(unsigned long)i<(unsigned long)indx;i++) {
    if(i->tab->broken && i->tab->printed) {
      fprintf(outfile,"\n");
      for(j=0;j<i->tab->column;j++)
    fprintf(outfile," ");
    }
    fprintf(outfile,"%s",i->str);
    i->tab->printed=TRUE;
  }
}

void pretty_variables(ptr_node n,ptr_tab_brk tab)
{
  ptr_psi_term tok;
  ptr_node n2;
  
  if(n->left) {
    pretty_variables(n->left,tab);
    prettyf(", ");
  }

  mark_tab(tab);
  prettyf(n->key);
  prettyf(" = ");

  tok=(ptr_psi_term )n->data;
  deref_ptr(tok);
  n2=find(INTCMP,(char *)tok,printed_pointers);
  if(strcmp((char *)n2->data,n->key)<0)
    /* Reference to previously printed variable */
    prettyf((char *)n2->data);
  else {
    if (eqsym->op_data) {
      long tkind, tprec, ttype, eqprec;
      eqprec=eqsym->op_data->precedence;
      tkind=opcheck(tok, &tprec, &ttype);
      if (tprec>=eqprec) prettyf("(");
      pretty_psi_term(tok,MAX_PRECEDENCE+1,0);
      if (tprec>=eqprec) prettyf(")");
    }
    else
      pretty_psi_term(tok,MAX_PRECEDENCE+1,0);
  }
  
  if(n->right) {
    prettyf(", ");
    pretty_variables(n->right,tab);
  }
}

long print_variables(long printflag)
{
  ptr_tab_brk new;
  GENERIC old_heap_pointer;
  if (!printflag) return FALSE; /* 21.1 */
  
  outfile=output_stream;
  listing_flag=FALSE;
  old_heap_pointer=heap_pointer;
  
  pointer_names=NULL;
  printed_pointers=NULL;
  gen_sym_counter=0;
  go_through_tree(var_tree);
  insert_variables(var_tree,TRUE);
  forbid_variables(var_tree);
  
  indent=TRUE;
  const_quote=TRUE;
  write_resids=TRUE;
  write_canon=FALSE;
  *buffer=0;
  indx=pretty_things;

  if (var_tree) {
    new_tab(&new);
    pretty_variables(var_tree,new);
    prettyf(".");
    mark_tab(new);
    prettyf("\n");
    end_tab();

    if (indent) {
      work_out_length();
      pretty_output();
    }
  }
  heap_pointer=old_heap_pointer;
  return (var_tree!=NULL);
}

void write_attributes(ptr_node n,ptr_tab_brk tab)
{
  if(n) {
    write_attributes(n->left,tab);
    mark_tab(tab);
    pretty_tag_or_psi_term((ptr_psi_term)n->data,MAX_PRECEDENCE+1,0);
    write_attributes(n->right,tab);
  }
}


void listing_pred_write(ptr_node n,long fflag)
{
  long old_print_depth;

  listing_flag=TRUE;
  func_flag=fflag;
  indent=TRUE;
  const_quote=TRUE;
  write_corefs=TRUE;
  write_stderr=FALSE;
  write_resids=FALSE;
  write_canon=FALSE;
  outfile=output_stream;
  old_print_depth=print_depth;
  print_depth=PRINT_DEPTH;
  main_pred_write(n);
  print_depth=old_print_depth;
  (void)fflush(outfile);
}

void pred_write(ptr_node n)
{
  listing_flag=FALSE;
  /* write_stderr=FALSE; */
  outfile=(write_stderr?stderr:output_stream);
  main_pred_write(n);
  (void)fflush(outfile);
}

void main_pred_write(ptr_node n)
{
  if (n) {
    GENERIC old_heap_pointer;
    ptr_tab_brk new;
 
    if (!write_corefs) main_pred_write(n->left);

    old_heap_pointer=heap_pointer;
    pointer_names=NULL;
    printed_pointers=NULL;
    gen_sym_counter=0;
    if (write_corefs)
      go_through_tree(n);
    else
      check_pointer((ptr_psi_term)n->data);
    insert_variables(var_tree,FALSE);

    *buffer=0;
    
    indx=pretty_things;
    new_tab(&new);

    if (write_corefs) {
      write_attributes(n,new);
    }
    else {
      mark_tab(new);
      pretty_tag_or_psi_term((ptr_psi_term)n->data,MAX_PRECEDENCE+1,0);
    }

    end_tab();

    if (indent) {
      work_out_length();
      pretty_output();
    }
    
    heap_pointer=old_heap_pointer;

    if (!write_corefs) main_pred_write(n->right);
  }
}

void display_psi_stdout(ptr_psi_term t)
{
  outfile=stdout;
  main_display_psi_term(t);
}

void display_psi_stderr(ptr_psi_term t)
{
  outfile=stderr;
  main_display_psi_term(t);
}

void display_psi_stream(ptr_psi_term t)
{
  outfile=output_stream;
  main_display_psi_term(t);
}

void display_psi(FILE *s,ptr_psi_term t)
{
  outfile=s;
  main_display_psi_term(t);
}


void main_display_psi_term(ptr_psi_term t)
{
  GENERIC old_heap_pointer;
  ptr_tab_brk new;

  listing_flag=FALSE;
  if(t) {

    deref_ptr(t);
    
    old_heap_pointer=heap_pointer;
    pointer_names=NULL;
    printed_pointers=NULL;
    gen_sym_counter=0;
    go_through(t);
    insert_variables(var_tree,FALSE);
    
    indent=FALSE;
    const_quote=TRUE;
    write_resids=FALSE;
    write_canon=FALSE;
    *buffer=0;
    indx=pretty_things;

    new_tab(&new);
    mark_tab(new);
    pretty_tag_or_psi_term(t,MAX_PRECEDENCE+1,0);
    end_tab();
    if (indent) {
      work_out_length();
      pretty_output();
    }
    
    heap_pointer=old_heap_pointer;
  }
  else
    printf("*null psi_term*");
}

void display_couple(ptr_psi_term u,char *s,ptr_psi_term v)
{
  GENERIC old_heap_pointer;
  ptr_tab_brk new;

  output_stream=stdout;
  listing_flag=FALSE;
  old_heap_pointer=heap_pointer;
  
  pointer_names=NULL;
  printed_pointers=NULL;
  gen_sym_counter=0;
  check_pointer(u);
  check_pointer(v);
  insert_variables(var_tree,TRUE);
  
  indent=FALSE;
  const_quote=TRUE;
  write_resids=FALSE;
  write_canon=FALSE;
  *buffer=0;
  indx=pretty_things;
  new_tab(&new);
  mark_tab(new);
  pretty_tag_or_psi_term(u,MAX_PRECEDENCE+1,0);
  prettyf(s);
  pretty_tag_or_psi_term(v,MAX_PRECEDENCE+1,0);
  end_tab();

  if (indent) {
    work_out_length();
    pretty_output();
  }
  
  heap_pointer=old_heap_pointer;
}

void print_resid_message(ptr_psi_term t,ptr_resid_list r)
{
  GENERIC old_heap_pointer;
  ptr_tab_brk new;
  ptr_resid_list r2; /* 21.9 */
  
  outfile=stdout;
  listing_flag=FALSE;
  old_heap_pointer=heap_pointer;
  
  pointer_names=NULL;
  printed_pointers=NULL;
  gen_sym_counter=0;

  check_pointer(t);

  r2=r;
  while(r2) {
    check_pointer(r2->var);
    r2=r2->next;
  }
  
  insert_variables(var_tree,TRUE);
  
  indent=FALSE;
  const_quote=TRUE;
  write_resids=FALSE;
  write_canon=FALSE;
  *buffer=0;
  indx=pretty_things;
  new_tab(&new);
  mark_tab(new);

  prettyf("residuating ");
  pretty_tag_or_psi_term(t,MAX_PRECEDENCE+1,0);
  prettyf(" on variable(s) {");

  r2=r;
  while(r2) {
    pretty_tag_or_psi_term(r2->var,MAX_PRECEDENCE+1,0);
    r2=r2->next;
    if(r2)
      prettyf(",");
  }

  prettyf("}\n");
  end_tab();
  
  heap_pointer=old_heap_pointer;
}