void fprint_env (FILE * out, struct ENV * env) {
if (env != NULL) {
if (env->next != NULL) {
fprintf(out,"%s -> ", env->ident);
fprint_term (out,env->term);
printf(", ");
}
else{
fprintf(out,"%s -> ", env->ident);
fprint_term (out,env->term);
}
}
}
static
void linear_delete(Mindex mdx, Term t)
{
Plist curr, prev;
prev = NULL;
curr = mdx->linear_first;
while (curr != NULL && curr->v != t) {
prev = curr;
curr = curr->next;
}
if (curr == NULL) {
fprint_term(stderr, t);
fprintf(stderr, "\n");
fatal_error("mindex_delete (linear), term not found.");
}
else {
if (prev != NULL)
prev->next = curr->next;
else
mdx->linear_first = curr->next;
if (curr == mdx->linear_last)
mdx->linear_last = prev;
free_plist(curr);
}
} /* linear_delete */
static
void p_binding(int vnum, Context vc, Term t, Context tc)
{
Term vt, ti;
vt = get_variable_term(vnum);
ti = apply(vt, vc);
printf("[");
fprint_term(stdout,vt);
printf(",0x%x:%d] -> [", (unsigned) vc, vc->multiplier);
fprint_term(stdout,t);
printf(",0x%x:%d] (", (unsigned) tc, tc->multiplier);
fprint_term(stdout,ti);
printf(")\n");
free_term(vt);
free_term(ti);
} /* p_binding */
static
void fprint_linear_index(FILE *fp, Plist first)
{
Plist p;
for (p = first; p != NULL; p = p->next) {
Term t = p->v;
fprintf(fp, "FPA_ID=%u: ", (unsigned) FPA_ID(t));
fprint_term(fp, t);
fprintf(fp, "\n");
}
} /* fprint_linear_index */
void fprint_term (FILE * out, struct TERM * tree) {
TRACE("fprint_term\n");
switch (tree->type) {
case TYPE_TERM_INTEGER :
TRACE("integer");
fprintf(out,"%d", tree->integer.value);
break;
case TYPE_TERM_VARIABLE :
TRACE("variable");
fprintf (out,"%s", tree->variable.value);
break;
case TYPE_TERM_QUOTE :
TRACE("quote");
fprintf (out, "(quote ");
fprint_term (out,tree->quote.content) ;
fprintf(out,")");
break;
case TYPE_TERM_ABSTRACTION :
TRACE("abstraction")
fprintf(out,"(lambda (%s) ", tree->abstraction.variable);
fprint_term (out, tree->abstraction.body) ;
fprintf(out,")");
break;
case TYPE_TERM_CLOSURE :
TRACE("closure")
fprintf(out,"(lambda (%s) ", tree->closure.variable);
fprint_term (out, tree->closure.body) ;
fprintf(out,")[");
fprint_env(out, tree->closure.env);
fprintf(out,"]");
break;
case TYPE_TERM_APPLICATION :
TRACE("application")
fprintf(out,"(");
fprint_term (out, tree->application.left) ;
fprintf(out, " ");
fprint_term (out, tree->application.right) ;
fprintf(out,")");
break;
case TYPE_TERM_LET :
TRACE("let")
fprintf(out,"(let (%s ", tree->let.variable);
fprint_term (out, tree->let.init) ;
fprintf(out, ") ");
fprint_term (out, tree->let.body) ;
fprintf(out,")");
break;
}
}
/* PUBLIC */
void fprint_term(FILE *fp, Term t)
{
if (t == NULL)
fprintf(fp, "fprint_term: NULL term\n");
else {
if (VARIABLE(t))
fprintf(fp, "v%d", VARNUM(t));
else {
fprint_sym(fp, SYMNUM(t));
if (COMPLEX(t)) {
int i;
fprintf(fp, "(");
for (i = 0; i < ARITY(t); i++) {
fprint_term(fp, ARG(t,i));
if (i < ARITY(t)-1)
fprintf(fp, ",");
}
fprintf(fp, ")");
}
}
}
fflush(fp);
} /* fprint_term */
/* PUBLIC */
void p_term(Term t)
{
fprint_term(stdout, t);
printf("\n");
fflush(stdout);
} /* p_term */
