lub.c File Reference

least upper bound of the root sorts of two psi terms More...

Go to the source code of this file.

Functions
ptr_int_list	appendIntList (ptr_int_list tail, ptr_int_list more)
	appendIntList More...
void	mark_ancestors (ptr_definition def, long *flags)
	mark_ancestors More...
static long	bfs (ptr_definition p, ptr_int_list ans, ptr_int_list pattern, long *flags)
	bfs More...
static ptr_int_list	makeUnitList (ptr_definition x)
	makeUnitList More...
ptr_int_list	lub (ptr_psi_term a, ptr_psi_term b, ptr_psi_term *pp)

Detailed Description

least upper bound of the root sorts of two psi terms

lub.c - find least upper bound of the root sorts of two psi terms

Definition in file lub.c.

Function Documentation

ptr_int_list appendIntList	(	ptr_int_list	tail,
		ptr_int_list	more
	)

appendIntList

Parameters

tail	- ptr_int_list tail
more	- ptr_int_list more

attach copies of more to tail

Definition at line 40 of file lub.c.

References wl_int_list::next, NULL, STACK_ALLOC, and wl_int_list::value_1.

{
  while (more)
    {
      tail->next = STACK_ALLOC(int_list);
      tail= tail->next;
      tail->value_1 = more->value_1;
      tail->next = NULL;
      more = more->next;
    }
  return tail;
}

static long bfs ( ptr_definition  p, ptr_int_list  ans, ptr_int_list  pattern, long *  flags  )

static

bfs

Parameters

p	- ptr_definition p
ans	- ptr_int_list ans
pattern	- ptr_int_list pattern
flags	- long *flags)

Definition at line 88 of file lub.c.

References appendIntList(), assert, bit_length(), built_in, mark_ancestors(), wl_int_list::next, NULL, or_codes(), wl_definition::parents, STACK_ALLOC, sub_CodeType(), top, and wl_int_list::value_1.

{
  ptr_int_list head = STACK_ALLOC(int_list);
  ptr_int_list tail;
  ptr_int_list par;
  long len;
  long found = 0;
    
  if (p == top)
    {
      or_codes((ptr_int_list)ans, (ptr_int_list)top);
      return 0; // ADDED 0 DJD 2.05
    }

  /*    print_code(pattern);*/
  /*    printf("\n");*/

  par = p->parents;
  if (par == NULL)
    return 0;               /* only parent is top */
    
  assert(par->value_1 != NULL);

  head->value_1 = par->value_1;
  head->next  = NULL;
  par = par->next;
  tail = appendIntList(head, par);

  while (head)
    {
      /*        pc(head->value);*/
      len = bit_length(((ptr_definition )head->value_1)->code);
      if (!flags[len])
    {
      /* we havn't checked this type before */
            
      if (!((ptr_definition )head->value_1 == top) &&
          !((ptr_definition )head->value_1 == built_in) &&
          (sub_CodeType(pattern,((ptr_definition)head->value_1)->code)))
        {
          or_codes(ans, ((ptr_definition)head->value_1)->code);
          /*                print_code(ans);*/
          /*                printf("ans\n");*/
          found++;
          /* must set flags of ALL ancestors of head! */
          mark_ancestors((ptr_definition)head->value_1,flags);
        }
      else
        tail = appendIntList(tail,
                 ((ptr_definition )head->value_1)->parents);
      flags[len] = 1;
    }
      head = head->next;
    }
  return found;
}

ptr_int_list lub	(	ptr_psi_term	a,
		ptr_psi_term	b,
		ptr_psi_term *	pp
	)

Definition at line 173 of file lub.c.

References bfs(), wl_definition::code, copyTypeCode(), decode(), isSubTypeValue(), isValue(), makeUnitList(), NULL, or_codes(), stack_alloc(), sub_type(), top, wl_psi_term::type, and type_count.

{
  ptr_definition ta;            /* type of psi term a */
  ptr_definition tb;            /* type of psi term b */
  long *flags;                  /* set to 1 if this type has been checked in
                         * the lub search.
                         */
  ptr_int_list ans;
  ptr_int_list pattern;
  long found;
    
  ta = a->type;
  tb = b->type;
    
  /* special cases first */
    
  if (isValue(a) && isValue(b) && sub_type(ta,tb) && sub_type(tb,ta))
    {
      /* special case of two values being of same type.  Check that they
       * might actually be same value before returning the type
       */
      if (isSubTypeValue(a, b))
    {
      /* since we alreadyuu know they are both values, isSubTypeValue
       * returns TRUE if they are same value, else false
       */
            
      *pp = a;
      return NULL;
    }
    }
    
  if (sub_type(ta, tb)) return makeUnitList(tb);
  if (sub_type(tb, ta)) return makeUnitList(ta);

  /* ta has the lub of tb&ta without the high bit set, search upwards for a
   * type that has the same lower bits as ta
   */

  /* get the pattern to search for */
    
  pattern = copyTypeCode(ta->code);
  or_codes(pattern, tb->code);      /* pattern to search for */
  ans = copyTypeCode(pattern);      /* resulting pattern */
    
  /* initialize the table to be non-searched */
    
  flags = (long *)stack_alloc(sizeof(unsigned long) * type_count);
  memset(flags, 0, sizeof(unsigned long) * type_count);

  /* now do a breadth first search for each of arg1 and arg2 */

  found  = bfs(ta, ans, pattern, flags);
  found += bfs(tb, ans, pattern, flags);

  if (found)
    ans = decode(ans);
  else
    ans = makeUnitList(top);
    
  return ans;
}

static ptr_int_list makeUnitList ( ptr_definition  x )

static

makeUnitList

Parameters

x	- ptr_definition x

make a decoded type list from one type

Definition at line 152 of file lub.c.

References wl_int_list::next, NULL, STACK_ALLOC, and wl_int_list::value_1.

{
  ptr_int_list ans;

  ans = STACK_ALLOC(int_list);
  ans->value_1 = (GENERIC )x;
  ans->next = NULL;
  return ans;
}

void mark_ancestors	(	ptr_definition	def,
		long *	flags
	)

mark_ancestors

Parameters

def	- ptr_definition def
flags	- long *flags

Set flags bit for all ancestors (i.e., higher up) of head

Definition at line 60 of file lub.c.

References bit_length(), wl_definition::code, wl_int_list::next, wl_definition::parents, and wl_int_list::value_1.

{
  ptr_int_list par;
  
  par=def->parents;
  while (par) {
    ptr_definition p;
    long len;
  
    p=(ptr_definition)par->value_1;
    len=bit_length(p->code);
    if (!flags[len]) {
      flags[len]=1;
      mark_ancestors(p, flags);
    }
    par=par->next;
  }
}