home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Vectronix 2
/
VECTRONIX2.iso
/
FILES_01
/
X_PROLOG.LZH
/
X_PROLOG
/
SOURCES
/
FUNCTOR.C
< prev
next >
Wrap
C/C++ Source or Header
|
1990-08-13
|
5KB
|
246 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"
#define NIL (functor *)0L
extern char *make_name(); /* module : memory.c */
extern functor *make_functor(); /* module : memory.c */
void _search(name, arity, create, ret, p, h)
char *name; /* name of functor */
short arity; /* arity of functor, -1 if unkown */
short create; /* create unknown node if true */
functor **ret; /* contains return value */
functor **p; /* pointer to subtree */
short *h; /* controls balancing of subtrees */
{
functor *p1, *p2;
short result; /* for speed */
if (*p == NIL) /* empty tree */
{
if (create) /* should we create a new node ? */
{
*p = make_functor(name);
*ret = *p;
(*p)->arity = arity;
(*p)->cp = (char *)0L;
(*p)->info[0] =
(*p)->info[1] =
(*p)->info[2] =
(*p)->info[3] = (char)0;
(*p)->flags = 0;
(*p)->left = (*p)->right = NIL;
(*p)->balance = 0;
*h = TRUE; /* need some balancing */
}
else
{
*h = FALSE;
*ret = NIL;
}
}
else
{
result = strcmp(name, (*p)->name);
if (result < 0 ||
(result == 0 && arity < (*p)->arity) && arity >= 0)
{
_search(name, arity, create, ret, &(*p)->left, h);
if (*h) /* need some balancing */
switch ((*p)->balance)
{
case 1: (*p)->balance = 0;
*h = FALSE;
break;
case 0: (*p)->balance = -1;
break;
case -1:p1 = (*p)->left;
if (p1->balance == -1)
{
(*p)->left = p1->right;
p1->right = *p;
(*p)->balance = 0;
*p = p1;
}
else
{
p2 = p1->right;
p1->right = p2->left;
p2->left = p1;
(*p)->left = p2->right;
p2->right = *p;
if (p2->balance == -1)
(*p)->balance = 1;
else
(*p)->balance = 0;
if (p2->balance == 1)
p1->balance = -1;
else
p1->balance = 0;
*p = p2;
}
(*p)->balance = 0;
*h = FALSE;
break;
}
}
else
{
if (result > 0 ||
(result == 0 && arity > (*p)->arity) && arity >= 0)
{
_search(name, arity, create, ret, &(*p)->right, h);
if (*h)
switch ((*p)->balance)
{
case -1:(*p)->balance = 0;
*h = FALSE;
break;
case 0: (*p)->balance = 1;
break;
case 1: p1 = (*p)->right;
if ( p1->balance == 1)
{
(*p)->right = p1->left;
p1->left = *p;
(*p)->balance = 0;
*p = p1;
}
else
{
p2 = p1->left;
p1->left = p2->right;
p2->right = p1;
(*p)->right = p2->left;
p2->left = *p;
if (p2->balance == 1)
(*p)->balance = -1;
else
(*p)->balance = 0;
if (p2->balance == -1)
p1->balance = 1;
else
p1->balance = 0;
*p = p2;
}
(*p)->balance = 0;
*h = FALSE;
break;
}
}
else
{
*ret = *p;
*h = FALSE;
}
}
}
}
/* search/create a functor. Standard call */
functor *get_functor(name, arity)
char *name;
short arity;
{
short h;
functor *ret;
_search(name, arity, TRUE, &ret, &functors, &h);
return(ret);
}
/* search for a functor. Return operator values if found */
functor *find_operator(name, flags, inf, pre, post)
char *name;
short *flags, *inf, *pre, *post;
{
functor *ret;
short h;
_search(name, 0, FALSE, &ret, &functors, &h);
if (ret)
{
*flags = ret->flags;
*inf = OP_INF(ret);
*pre = OP_PRE(ret);
*post = OP_POST(ret);
}
return(ret);
}
void add_operator(name, op, pre)
char *name;
functor *op; /* the operator functor */
short pre; /* the give preceedence */
{
functor *ret;
short h;
_search(name, 0, TRUE, &ret, &functors, &h);
if (op == XFXFUNCTOR)
{
ret->flags |= LOWER_LEFT | LOWER_RIGHT;
OP_INF(ret) = pre;
return;
}
if (op == XFYFUNCTOR)
{
ret->flags |= LOWER_LEFT;
OP_INF(ret) = pre;
return;
}
if (op == YFXFUNCTOR)
{
ret->flags |= LOWER_RIGHT;
OP_INF(ret) = pre;
return;
}
if (op == YFYFUNCTOR)
{
OP_INF(ret) = pre;
return;
}
if (op == FXFUNCTOR)
{
ret->flags |= LOWER_RIGHT;
OP_PRE(ret) = pre;
return;
}
if (op == FYFUNCTOR)
{
OP_PRE(ret) = pre;
return;
}
if (op == XFFUNCTOR)
{
ret->flags |= LOWER_LEFT;
OP_POST(ret) = pre;
return;
}
if (op == YFFUNCTOR)
{
OP_POST(ret) = pre;
return;
}
}