home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / SOURCES / FUNCTOR.C < prev    next >
C/C++ Source or Header  |  1990-08-13  |  5KB  |  246 lines
  1. /*
  2.  *        X PROLOG  Vers. 2.0
  3.  *
  4.  *
  5.  *    Written by :     Andreas Toenne
  6.  *            CS Dept. , IRB
  7.  *            University of Dortmund, W-Germany
  8.  *            <at@unido.uucp>
  9.  *            <....!seismo!unido!at>
  10.  *            <at@unido.bitnet>
  11.  *
  12.  *    Copyright :    This software is copyrighted by Andreas Toenne.
  13.  *            Permission is granted hereby to copy the entire
  14.  *            package including this copyright notice without fee.
  15.  *
  16.  */
  17.   
  18. #include "prolog.h"
  19. #include "extern.h"
  20.  
  21. #define NIL (functor *)0L
  22.  
  23. extern char *make_name();    /* module : memory.c */
  24. extern functor *make_functor();    /* module : memory.c */
  25.  
  26. void _search(name, arity, create, ret, p, h)
  27. char *name;            /* name of functor */
  28. short arity;            /* arity of functor, -1 if unkown */
  29. short create;            /* create unknown node if true */
  30. functor **ret;            /* contains return value */
  31. functor **p;            /* pointer to subtree */
  32. short *h;            /* controls balancing of subtrees */
  33. {
  34.     functor *p1, *p2;
  35.     short result;        /* for speed */
  36.     
  37.     if (*p == NIL)        /* empty tree */
  38.     {
  39.         if (create)    /* should we create a new node ? */
  40.         {
  41.             *p = make_functor(name);
  42.             *ret = *p;
  43.             (*p)->arity = arity;
  44.             (*p)->cp = (char *)0L;
  45.             (*p)->info[0] =
  46.             (*p)->info[1] =
  47.             (*p)->info[2] =
  48.             (*p)->info[3] = (char)0;
  49.             (*p)->flags = 0;
  50.             (*p)->left = (*p)->right = NIL;
  51.             (*p)->balance = 0;
  52.             *h = TRUE;        /* need some balancing */
  53.         }
  54.         else
  55.         {
  56.             *h = FALSE;
  57.             *ret = NIL;
  58.         }
  59.     }
  60.     else
  61.     {
  62.         result = strcmp(name, (*p)->name);
  63.         if (result < 0 ||
  64.            (result == 0 && arity < (*p)->arity) && arity >= 0)
  65.         {
  66.             _search(name, arity, create, ret, &(*p)->left, h);
  67.             if (*h)        /* need some balancing */
  68.             switch ((*p)->balance)
  69.             {
  70.                 case 1:    (*p)->balance = 0;
  71.                     *h = FALSE;
  72.                     break;
  73.                 case 0:    (*p)->balance = -1;
  74.                     break;
  75.                 case -1:p1 = (*p)->left;
  76.                     if (p1->balance == -1)
  77.                     {
  78.                         (*p)->left = p1->right;
  79.                         p1->right = *p;
  80.                         (*p)->balance = 0;
  81.                         *p = p1;
  82.                     }
  83.                     else
  84.                     {
  85.                         p2 = p1->right;
  86.                         p1->right = p2->left;
  87.                         p2->left = p1;
  88.                         (*p)->left = p2->right;
  89.                         p2->right = *p;
  90.                         if (p2->balance == -1)
  91.                             (*p)->balance = 1;
  92.                         else
  93.                             (*p)->balance = 0;
  94.                         if (p2->balance == 1)
  95.                             p1->balance = -1;
  96.                         else
  97.                             p1->balance = 0;
  98.                         *p = p2;
  99.                     }
  100.                     (*p)->balance = 0;
  101.                     *h = FALSE;
  102.                     break;
  103.             }
  104.         }
  105.         else
  106.         {
  107.         if (result > 0 ||
  108.            (result == 0 && arity > (*p)->arity) && arity >= 0)
  109.         {
  110.             _search(name, arity, create, ret, &(*p)->right, h);
  111.             if (*h)
  112.             switch ((*p)->balance)
  113.             {
  114.                 case -1:(*p)->balance = 0;
  115.                     *h = FALSE;
  116.                     break;
  117.                 case 0:    (*p)->balance = 1;
  118.                     break;
  119.                 case 1:    p1 = (*p)->right;
  120.                     if ( p1->balance == 1)
  121.                     {
  122.                         (*p)->right = p1->left;
  123.                         p1->left = *p;
  124.                         (*p)->balance = 0;
  125.                         *p = p1;
  126.                     }
  127.                     else
  128.                     {
  129.                         p2 = p1->left;
  130.                         p1->left = p2->right;
  131.                         p2->right = p1;
  132.                         (*p)->right = p2->left;
  133.                         p2->left = *p;
  134.                         if (p2->balance == 1)
  135.                             (*p)->balance = -1;
  136.                         else
  137.                             (*p)->balance = 0;
  138.                         if (p2->balance == -1)
  139.                             p1->balance = 1;
  140.                         else
  141.                             p1->balance = 0;
  142.                         *p = p2;
  143.                     }
  144.                     (*p)->balance = 0;
  145.                     *h = FALSE;
  146.                     break;
  147.             }
  148.         }
  149.         else
  150.         {
  151.             *ret = *p;
  152.             *h = FALSE;
  153.         }
  154.         }
  155.     }
  156. }
  157.  
  158. /* search/create a functor. Standard call */
  159.  
  160. functor *get_functor(name, arity)
  161. char *name;
  162. short arity;
  163. {
  164.     short h;
  165.     functor *ret;
  166.     
  167.     _search(name, arity, TRUE, &ret, &functors, &h);
  168.     return(ret);
  169. }
  170.  
  171. /* search for a functor. Return operator values if found */
  172.  
  173. functor *find_operator(name, flags, inf, pre, post)
  174. char *name;
  175. short *flags, *inf, *pre, *post;
  176. {
  177.     functor *ret;
  178.     short h;
  179.     
  180.     _search(name, 0, FALSE, &ret, &functors, &h);
  181.     if (ret)
  182.     {
  183.         *flags = ret->flags;
  184.         *inf = OP_INF(ret);
  185.         *pre = OP_PRE(ret);
  186.         *post = OP_POST(ret);
  187.     }
  188.     return(ret);
  189. }
  190.  
  191. void add_operator(name, op, pre)
  192. char *name;
  193. functor *op;                /* the operator functor */
  194. short pre;                /* the give preceedence */
  195. {
  196.     functor *ret;
  197.     short h;
  198.     
  199.     _search(name, 0, TRUE, &ret, &functors, &h);
  200.     if (op == XFXFUNCTOR)
  201.     {
  202.         ret->flags |= LOWER_LEFT | LOWER_RIGHT;
  203.         OP_INF(ret) = pre;
  204.         return;
  205.     }
  206.     if (op == XFYFUNCTOR)
  207.     {
  208.         ret->flags |= LOWER_LEFT;
  209.         OP_INF(ret) = pre;
  210.         return;
  211.     }
  212.     if (op == YFXFUNCTOR)
  213.     {
  214.         ret->flags |= LOWER_RIGHT;
  215.         OP_INF(ret) = pre;
  216.         return;
  217.     }
  218.     if (op == YFYFUNCTOR)
  219.     {
  220.         OP_INF(ret) = pre;
  221.         return;
  222.     }
  223.     if (op == FXFUNCTOR)
  224.     {
  225.         ret->flags |= LOWER_RIGHT;
  226.         OP_PRE(ret) = pre;
  227.         return;
  228.     }
  229.     if (op == FYFUNCTOR)
  230.     {
  231.         OP_PRE(ret) = pre;
  232.         return;
  233.     }
  234.     if (op == XFFUNCTOR)
  235.     {
  236.         ret->flags |= LOWER_LEFT;
  237.         OP_POST(ret) = pre;
  238.         return;
  239.     }
  240.     if (op == YFFUNCTOR)
  241.     {
  242.         OP_POST(ret) = pre;
  243.         return;
  244.     }
  245. }
  246.