home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Vectronix 2
/
VECTRONIX2.iso
/
FILES_01
/
X_PROLOG.LZH
/
X_PROLOG
/
SOURCES
/
TERMS.C
< prev
Wrap
C/C++ Source or Header
|
1990-08-13
|
6KB
|
294 lines
/*
* X PROLOG Vers. 2.0
*
*
* Written by : Andreas Toenne
* CS Dept. , IRB
* University of Dortmund, W-Germany
* <at@unido.uucp>
* <....!seismo!unido!at>
* <at@unido.bitnet>
*
* Copyright : This software is copyrighted by Andreas Toenne.
* Permission is granted hereby to copy the entire
* package including this copyright notice without fee.
*
*/
#include "prolog.h"
#include "extern.h"
#include "error.h"
extern term *push_proto();
extern term *push_copy();
extern functor *get_functor();
/* create a 'standard' term prototype */
term *term_proto(f)
functor *f;
{
term *t;
t = push_proto(f->arity);
ARG(t,0) = (term *)f;
t->flags = STRUCT;
/* no argument initialisation here */
return(t);
}
/* create an integer prototype */
term *int_proto(i)
long i;
{
term *t;
t = push_proto(0);
t->flags = INT;
VALUE(t) = i;
return(t);
}
/* create a variable prototype */
term *var_proto(pos)
short pos; /* the # of that local var */
{
term *t;
t = push_proto(0);
t->flags = VAR;
REF(t) = (term *)pos;
return(t);
}
/* create a 'standard' term prototype */
term *term_copy(f)
functor *f;
{
term *t;
t = push_copy(f->arity);
ARG(t,0) = (term *)f;
t->flags = STRUCT;
/* no argument initialisation here */
return(t);
}
/* create an integer copy */
term *int_copy(i)
long i;
{
term *t;
t = push_copy(1);
t->flags = INT;
VALUE(t) = i;
return(t);
}
/* create a variable copy */
term *var_copy()
{
term *t;
t = push_copy(1);
t->flags = VAR;
REF(t) = FREEVAR;
return(t);
}
/* create a anonymous variable copy */
term *anonymous_copy()
{
term *t;
t = var_copy();
t->flags |= ANONYMOUS;
return(t);
}
/* Bind two variables */
/* Rule : Bind the variable that lies higher in the areas to */
/* the lower variable */
void bind_2_vars(v1, v2)
register term *v1, *v2;
{
if (v1 != v2) /* sanity check */
{
if (v1 < v2) /* v1 lower than v2 */
{
BIND_VAR(v2, v1);
}
else
{
BIND_VAR(v1, v2);
}
}
}
/* return the n'th argument of term t within the given enviroment */
/* enviroment means here the activation record for this term */
/* in conjunction with the set of framevariables of that term */
/* Note! If we deal with a copystack term, we got no activation record */
/* neither a frame. */
term *argument(t, e, n)
register term *t;
register env *e;
register short n;
{
register term *arg;
arg = ARG(t,n); /* get the n'th argument */
if (! ISVAR(arg)) /* stop at non vars */
return(arg);
if (ISPROTO(arg)&&!ISANOPROTO(arg))/* proto vars got a frame var */
arg = (term *)(e->frame + VALUE(arg));
while (TRUE) /* run through binding chain */
{
if ((! ISVAR(arg)) || /* stop at non vars */
(REF(arg) == FREEVAR)) /* and at unbound vars */
return(arg);
else
arg = REF(arg);
}
}
/* Derefer the term, if it's a variable */
term *deref(t, e)
register term *t;
env *e;
{
if (! ISVAR(t)) /* stop at non vars */
return(t);
if (ISPROTO(t)&&!ISANOPROTO(t))/* proto vars got a frame var */
t = (term *)(e->frame + VALUE(t));
while (TRUE) /* run through binding chain */
{
if ((! ISVAR(t)) || /* stop at non vars */
(REF(t) == FREEVAR)) /* and at unbound vars */
return(t);
else
t = REF(t);
}
}
/* create a term's instance if necessary */
/* if we bind a variable to a prototype term, we MUST create a */
/* duplicate term if he has some variables */
/* Otherwise we would end up with global sideeffects when binding */
/* this prototypes variables. */
term *term_instance(t, e)
register term *t;
register env *e;
{
register short i;
short arity;
register term *p;
register term *arg;
if (! ISPROTO(t)) /* non prototypes */
return(t); /* need not to be copied */
if (ISANOPROTO(t)) /* a anonymous variable */
return(anonymous_copy());
if (ISVAR(t)) /* instance of a var prototype */
{
p = var_copy(); /* create a copy first */
/* bind the old frame with the new copy */
#ifdef VAX
BIND_VAR((term *)(e->frame+VALUE(t)), p);
#else
arg = (term *)(e->frame+VALUE(t));
BIND_VAR(arg, p);
#endif
return(p);
}
if (ISINT(t)) /* instance of a int prototype */
return(int_copy(VALUE(t))); /* easy */
/* create instance for 'normal' terms recursivly */
arity = ARITY(t); /* number of arguments */
p = term_copy(FUNC(t)); /* create body of term */
for (i=1; i<=arity; i++) /* create all arguments */
{
arg = argument(t, e, i);/* get argument first */
if (ISFRAME(arg)) /* a unbound framevariable */
{
term *p1;
p1 = var_copy();
BIND_VAR(arg, p1);
ARG(p,i) = p1;
}
else
ARG(p,i) = term_instance(arg, e);
}
return(p);
}
/* Match two terms */
/* Basic unification */
short term_unify(a, ae, b, be)
register term *a, *b;
register env *ae;
env *be;
{
register short success = TRUE;
register short n, arity;
if (ISSTRUCT(a) && ISSTRUCT(b)) /* 'normal' terms */
{
if (FUNC(a) != FUNC(b)) /* not equal */
return(FALSE);
else
{
arity = ARITY(a);
for (n=1; n<=arity && success; n++)
success = term_unify(argument(a,ae,n),ae,
argument(b,be,n),be);
}
}
else
{
if (ISANOPROTO(a) || ISANOPROTO(b))
return(TRUE);
if (ISVAR(a))
if (ISVAR(b))
bind_2_vars(a, b);
else
{
BIND_VAR(a, term_instance(b, be));
}
else
if (ISVAR(b))
{
BIND_VAR(b, term_instance(a, ae));
}
else
return(VALUE(a) == VALUE(b));
}
return(success);
}