home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / SOURCES / TERMS.C < prev   
C/C++ Source or Header  |  1990-08-13  |  6KB  |  294 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. #include "error.h"
  21.  
  22. extern term *push_proto();
  23. extern term *push_copy();
  24. extern functor *get_functor();
  25.  
  26.  
  27. /*    create a 'standard' term prototype    */
  28.  
  29. term *term_proto(f)
  30. functor *f;
  31. {
  32.     term *t;
  33.     
  34.     t = push_proto(f->arity);
  35.     ARG(t,0) = (term *)f;
  36.     t->flags = STRUCT;
  37.     /* no argument initialisation here */
  38.     return(t);
  39. }
  40.  
  41. /*    create an integer prototype    */
  42.  
  43. term *int_proto(i)
  44. long i;
  45. {
  46.     term *t;
  47.     
  48.     t = push_proto(0);
  49.     t->flags = INT;
  50.     VALUE(t) = i;
  51.     return(t);
  52. }
  53.  
  54. /*    create a variable prototype    */
  55.  
  56. term *var_proto(pos)
  57. short pos;                /* the # of that local var */
  58. {
  59.     term *t;
  60.     
  61.     t = push_proto(0);
  62.     t->flags = VAR;
  63.     REF(t) = (term *)pos;
  64.     return(t);
  65. }
  66.  
  67. /*    create a 'standard' term prototype    */
  68.  
  69. term *term_copy(f)
  70. functor *f;
  71. {
  72.     term *t;
  73.     
  74.     t = push_copy(f->arity);
  75.     ARG(t,0) = (term *)f;
  76.     t->flags = STRUCT;
  77.     /* no argument initialisation here */
  78.     return(t);
  79. }
  80. /*    create an integer copy    */
  81.  
  82. term *int_copy(i)
  83. long i;
  84. {
  85.     term *t;
  86.     
  87.     t = push_copy(1);
  88.     t->flags = INT;
  89.     VALUE(t) = i;
  90.     return(t);
  91. }
  92.  
  93. /*    create a variable copy    */
  94.  
  95. term *var_copy()
  96. {
  97.     term *t;
  98.     
  99.     t = push_copy(1);
  100.     t->flags = VAR;
  101.     REF(t) = FREEVAR;
  102.     return(t);
  103. }
  104.  
  105. /*    create a anonymous variable copy */
  106.  
  107. term *anonymous_copy()
  108. {
  109.     term *t;
  110.     
  111.     t = var_copy();
  112.     t->flags |= ANONYMOUS;
  113.     return(t);
  114. }
  115.  
  116. /*    Bind two variables    */
  117. /*    Rule :  Bind the variable that lies higher in the areas to */
  118. /*        the lower variable    */
  119.  
  120. void bind_2_vars(v1, v2)
  121. register term *v1, *v2;
  122. {
  123.     if (v1 != v2)            /* sanity check */
  124.     {
  125.         if (v1 < v2)        /* v1 lower than v2 */
  126.         {
  127.             BIND_VAR(v2, v1);
  128.         }
  129.         else
  130.         {
  131.             BIND_VAR(v1, v2);
  132.         }
  133.     }
  134. }
  135.  
  136. /*    return the n'th argument of term t within the given enviroment    */
  137. /*    enviroment means here the activation record for this term */
  138. /*    in conjunction with the set of framevariables of that term */
  139. /*    Note! If we deal with a copystack term, we got no activation record */
  140. /*    neither a frame. */
  141.  
  142. term *argument(t, e, n)
  143. register term *t;
  144. register env *e;
  145. register short n;
  146. {
  147.     register term *arg;
  148.  
  149.     arg = ARG(t,n);            /* get the n'th argument */
  150.     
  151.     if (! ISVAR(arg))        /* stop at non vars */
  152.         return(arg);
  153.     
  154.     if (ISPROTO(arg)&&!ISANOPROTO(arg))/* proto vars got a frame var */
  155.         arg = (term *)(e->frame + VALUE(arg));
  156.     
  157.     while (TRUE)            /* run through binding chain */
  158.     {
  159.         if ((! ISVAR(arg)) ||    /* stop at non vars */
  160.             (REF(arg) == FREEVAR)) /* and at unbound vars */
  161.             return(arg);
  162.         else
  163.             arg = REF(arg);
  164.     }
  165. }
  166.  
  167. /*    Derefer the term, if it's a variable */
  168.  
  169. term *deref(t, e)
  170. register term *t;
  171. env *e;
  172. {
  173.     if (! ISVAR(t))            /* stop at non vars */
  174.         return(t);
  175.     
  176.     if (ISPROTO(t)&&!ISANOPROTO(t))/* proto vars got a frame var */
  177.         t = (term *)(e->frame + VALUE(t));
  178.     
  179.     while (TRUE)            /* run through binding chain */
  180.     {
  181.         if ((! ISVAR(t)) ||    /* stop at non vars */
  182.             (REF(t) == FREEVAR)) /* and at unbound vars */
  183.             return(t);
  184.         else
  185.             t = REF(t);
  186.     }
  187. }
  188.  
  189. /*    create a term's instance if necessary    */
  190. /*    if we bind a variable to a prototype term, we MUST create a */
  191. /*    duplicate term if he has some variables */
  192. /*    Otherwise we would end up with global sideeffects when binding */
  193. /*    this prototypes variables. */
  194.  
  195. term *term_instance(t, e)
  196. register term *t;
  197. register env *e;
  198. {
  199.     register short i;
  200.     short arity;
  201.     register term *p;
  202.     register term *arg;
  203.     
  204.     if (! ISPROTO(t))        /* non prototypes */
  205.         return(t);        /* need not to be copied */
  206.  
  207.     if (ISANOPROTO(t))        /* a anonymous variable */
  208.         return(anonymous_copy());
  209.             
  210.     if (ISVAR(t))            /* instance of a var prototype */
  211.     {
  212.         p = var_copy();        /* create a copy first */
  213.         /* bind the old frame with the new copy */
  214. #ifdef VAX
  215.         BIND_VAR((term *)(e->frame+VALUE(t)), p);
  216. #else
  217.         arg = (term *)(e->frame+VALUE(t));
  218.         BIND_VAR(arg, p);
  219. #endif
  220.         return(p);
  221.     }
  222.     
  223.     if (ISINT(t))            /* instance of a int prototype */
  224.         return(int_copy(VALUE(t)));    /* easy */
  225.     
  226.     /* create instance for 'normal' terms recursivly */
  227.     
  228.     arity = ARITY(t);        /* number of arguments */
  229.     p = term_copy(FUNC(t));        /* create body of term */
  230.  
  231.     for (i=1; i<=arity; i++)    /* create all arguments */
  232.     {
  233.         arg = argument(t, e, i);/* get argument first */
  234.         if (ISFRAME(arg))    /* a unbound framevariable */
  235.         {
  236.             term *p1;
  237.             
  238.             p1 = var_copy();
  239.             BIND_VAR(arg, p1);
  240.             ARG(p,i) = p1;
  241.         }
  242.         else
  243.             ARG(p,i) = term_instance(arg, e);
  244.     }
  245.     return(p);
  246. }
  247.  
  248. /*    Match two terms */
  249. /*    Basic unification */
  250.  
  251. short term_unify(a, ae, b, be)
  252. register term *a, *b;
  253. register env *ae;
  254. env *be;
  255. {
  256.     register short success = TRUE;
  257.     register short n, arity;
  258.     
  259.     if (ISSTRUCT(a) && ISSTRUCT(b))    /* 'normal' terms */
  260.     {
  261.         if (FUNC(a) != FUNC(b)) /* not equal */
  262.             return(FALSE);
  263.         else
  264.         {
  265.             arity = ARITY(a);
  266.             for (n=1; n<=arity && success; n++)
  267.                 success = term_unify(argument(a,ae,n),ae,
  268.                              argument(b,be,n),be);
  269.         }
  270.     }
  271.     else
  272.     {
  273.         if (ISANOPROTO(a) || ISANOPROTO(b))
  274.             return(TRUE);
  275.             
  276.         if (ISVAR(a))
  277.             if (ISVAR(b))
  278.                 bind_2_vars(a, b);
  279.             else
  280.             {
  281.                 BIND_VAR(a, term_instance(b, be));
  282.             }
  283.         else
  284.             if (ISVAR(b))
  285.             {
  286.                 BIND_VAR(b, term_instance(a, ae));
  287.             }
  288.             else
  289.                 return(VALUE(a) == VALUE(b));
  290.     }
  291.     return(success);
  292. }
  293.  
  294.