home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / SOURCE / LUB.C < prev    next >
C/C++ Source or Header  |  1996-06-04  |  5KB  |  230 lines
  1. /*                                    tab:4
  2.  *
  3.  * lub.c - find least upper bound of the root sorts of two psi terms
  4.  *
  5.  * Copyright (c) 1992 Digital Equipment Corporation
  6.  * All Rights Reserved.
  7.  *
  8.  * The standard digital prl copyrights exist and where compatible
  9.  * the below also exists.
  10.  * Permission to use, copy, modify, and distribute this
  11.  * software and its documentation for any purpose and without
  12.  * fee is hereby granted, provided that the above copyright
  13.  * notice appear in all copies.  Copyright holder(s) make no
  14.  * representation about the suitability of this software for
  15.  * any purpose. It is provided "as is" without express or
  16.  * implied warranty.
  17.  *
  18.  * Author:             Seth Copen Goldstein
  19.  * Version:            26
  20.  * Creation Date:    Fri Jun  5 12:14:39 1992
  21.  * Filename:        lub.c
  22.  * History:
  23.  */
  24. /*     $Id: lub.c,v 1.3 1995/08/25 21:34:37 duchier Exp $     */
  25.  
  26. #ifndef lint
  27. static char vcid[] = "$Id: lub.c,v 1.3 1995/08/25 21:34:37 duchier Exp $";
  28. #endif /* lint */
  29.  
  30. #include "extern.h"
  31. #include "login.h"
  32. #include "trees.h"
  33. #include "print.h"
  34. #include "memory.h"
  35. #include "error.h"
  36. #include "token.h"
  37.  
  38. extern ptr_definition built_in;
  39.  
  40. ptr_int_list appendIntList(tail, more)
  41. ptr_int_list tail;                /* attach copies of more to tail */
  42. ptr_int_list more;
  43. {
  44.     while (more)
  45.     {
  46.         tail->next = STACK_ALLOC(int_list);
  47.         tail= tail->next;
  48.         tail->value = more->value;
  49.         tail->next = NULL;
  50.         more = more->next;
  51.     }
  52.     return tail;
  53. }
  54.  
  55. /* Set flags bit for all ancestors (i.e., higher up) of head */
  56. void
  57. mark_ancestors(def, flags)
  58.      ptr_definition def;
  59.      long *flags;
  60. {
  61.   ptr_int_list par;
  62.   
  63.   par=def->parents;
  64.   while (par) {
  65.     ptr_definition p;
  66.     long len;
  67.   
  68.     p=(ptr_definition)par->value;
  69.     len=bit_length(p->code);
  70.     if (!flags[len]) {
  71.       flags[len]=1;
  72.       mark_ancestors(p, flags);
  73.     }
  74.     par=par->next;
  75.   }
  76. }
  77.  
  78. static long bfs(p, ans, pattern, flags)
  79. ptr_definition p;
  80. ptr_int_list ans;
  81. ptr_int_list pattern;
  82. long *flags;
  83. {
  84.     ptr_int_list head = STACK_ALLOC(int_list);
  85.     ptr_int_list tail;
  86.     ptr_int_list par;
  87.     long len;
  88.     long found = 0;
  89.     
  90.     if (p == top)
  91.     {
  92.         or_codes(ans, top);
  93.         return;
  94.     }
  95.  
  96. /*    print_code(pattern);*/
  97. /*    printf("\n");*/
  98.  
  99.     par = p->parents;
  100.     if (par == NULL)
  101.         return 0;                /* only parent is top */
  102.     
  103.     assert(par->value != NULL);
  104.  
  105.     head->value = par->value;
  106.     head->next  = NULL;
  107.     par = par->next;
  108.     tail = appendIntList(head, par);
  109.  
  110.     while (head)
  111.     {
  112. /*        pc(head->value);*/
  113.         len = bit_length(((ptr_definition )head->value)->code);
  114.         if (!flags[len])
  115.         {
  116.             /* we havn't checked this type before */
  117.             
  118.             if (!((ptr_definition )head->value == top) &&
  119.                 !((ptr_definition )head->value == built_in) &&
  120.                 (sub_CodeType(pattern,((ptr_definition)head->value)->code)))
  121.             {
  122.                 or_codes(ans, ((ptr_definition)head->value)->code);
  123. /*                print_code(ans);*/
  124. /*                printf("ans\n");*/
  125.                 found++;
  126.                 /* must set flags of ALL ancestors of head! */
  127.                 mark_ancestors((ptr_definition)head->value,flags);
  128.             }
  129.             else
  130.                 tail = appendIntList(tail,
  131.                                      ((ptr_definition )head->value)->parents);
  132.             flags[len] = 1;
  133.         }
  134.         head = head->next;
  135.     }
  136.     return found;
  137. }
  138.  
  139.  
  140. /******************************************/
  141. /* make a decoded type list from one type */
  142. /******************************************/
  143.  
  144. static ptr_int_list makeUnitList(x)
  145. ptr_definition x;
  146. {
  147.     ptr_int_list ans;
  148.  
  149.     ans = STACK_ALLOC(int_list);
  150.     ans->value = (GENERIC )x;
  151.     ans->next = NULL;
  152.     return ans;
  153. }
  154.  
  155. /*****************************************************************************/
  156. /* returns a decoded type list of the root sorts that make up the least upper
  157.  * bound of the two terms, a &b.  Deals with  speacial cases of integers,
  158.  * strings, etc.
  159.  */
  160. /*****************************************************************************/
  161.  
  162. ptr_int_list lub(a,b,pp)
  163. ptr_psi_term a;
  164. ptr_psi_term b;
  165. ptr_psi_term *pp;
  166. {
  167.     extern long type_count;        /* the number of sorts in the hierarchy */
  168.     ptr_definition ta;            /* type of psi term a */
  169.     ptr_definition tb;            /* type of psi term b */
  170.     long *flags;                    /* set to 1 if this type has been checked in
  171.                                  * the lub search.
  172.                                  */
  173.     ptr_int_list ans;
  174.     ptr_int_list pattern;
  175.     long found;
  176.     
  177.     ta = a->type;
  178.     tb = b->type;
  179.     
  180.     /* special cases first */
  181.     
  182.     if (isValue(a) && isValue(b) && sub_type(ta,tb) && sub_type(tb,ta))
  183.     {
  184.         /* special case of two values being of same type.  Check that they
  185.          * might actually be same value before returning the type
  186.          */
  187.         if (isSubTypeValue(a, b))
  188.         {
  189.             /* since we alreadyuu know they are both values, isSubTypeValue
  190.              * returns TRUE if they are same value, else false
  191.              */
  192.             
  193.             *pp = a;
  194.             return NULL;
  195.         }
  196.     }
  197.     
  198.     if (sub_type(ta, tb)) return makeUnitList(tb);
  199.     if (sub_type(tb, ta)) return makeUnitList(ta);
  200.  
  201.     /* ta has the lub of tb&ta without the high bit set, search upwards for a
  202.      * type that has the same lower bits as ta
  203.      */
  204.  
  205.     /* get the pattern to search for */
  206.     
  207.     pattern = copyTypeCode(ta->code);
  208.     or_codes(pattern, tb->code);        /* pattern to search for */
  209.     ans = copyTypeCode(pattern);        /* resulting pattern */
  210.     
  211.     /* initialize the table to be non-searched */
  212.     
  213.     flags = (long *)stack_alloc(sizeof(unsigned long) * type_count);
  214.     memset(flags, 0, sizeof(unsigned long) * type_count);
  215.  
  216.     /* now do a breadth first search for each of arg1 and arg2 */
  217.  
  218.     found  = bfs(ta, ans, pattern, flags);
  219.     found += bfs(tb, ans, pattern, flags);
  220.  
  221.     if (found)
  222.         ans = decode(ans);
  223.     else
  224.         ans = makeUnitList(top);
  225.     
  226.     return ans;
  227. }
  228.  
  229.  
  230.