bi_type.c File Reference

Builtins for doing type heierachy stuff. More...

Go to the source code of this file.

Functions
static long	c_children ()
	c_children More...
static long	c_parents ()
	c_parents More...
static long	c_smallest ()
	c_smallest More...
int	isSubTypeValue (ptr_psi_term arg1, ptr_psi_term arg2)
	isSubTypeValue More...
static long	isa (ptr_psi_term arg1, ptr_psi_term arg2)
	isa More...
static long	isa_select (ptr_psi_term arg1, ptr_psi_term arg2, long sel)
	isa_select More...
static long	c_isa_main (long sel)
	c_isa_main More...
static long	c_isa_le ()
	c_isa_le More...
static long	c_isa_lt ()
	c_isa_lt More...
static long	c_isa_ge ()
	c_isa_ge More...
static long	c_isa_gt ()
	c_isa_gt More...
static long	c_isa_eq ()
	c_isa_eq More...
static long	c_isa_nle ()
	c_isa_nle More...
static long	c_isa_nlt ()
	c_isa_nlt More...
static long	c_isa_nge ()
	c_isa_nge More...
static long	c_isa_ngt ()
	c_isa_ngt More...
static long	c_isa_neq ()
	c_isa_neq More...
static long	c_isa_cmp ()
	c_isa_cmp More...
static long	c_isa_ncmp ()
	c_isa_ncmp More...
static long	c_is_function ()
	c_is_function More...
static long	c_is_persistent ()
	c_is_persistent More...
static long	c_is_predicate ()
	c_is_predicate More...
static long	c_is_sort ()
	c_is_sort More...
static long	c_is_value ()
	c_is_value More...
static long	c_is_number ()
	static long c_is_number More...
long	c_isa_subsort ()
	long c_isa_subsort More...
long	isValue (ptr_psi_term p)
	isValue(p) More...
long	c_glb ()
	long c_glb More...
long	c_lub ()
	long c_lub More...
void	insert_type_builtins ()
	void insert_type_builtins More...

Detailed Description

Builtins for doing type heierachy stuff.

Definition in file bi_type.c.

Function Documentation

static long c_children ( )

static

c_children

Return a list of roots of the children types of T (except bottom).

Definition at line 30 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, wl_definition::children, collect_symbols(), curry(), deref, deref_args, deref_ptr, get_two_args(), greatest_sel, hidden_type(), wl_int_list::next, NULL, push_goal(), real, resid_aim, set_1, stack_cons(), stack_nil(), stack_psi_term(), top, TRUE, wl_psi_term::type, unify, wl_int_list::value_1, and wl_psi_term::value_3.

{
  long success=TRUE;
  ptr_psi_term funct,result,arg1,arg2,t,p1;
  ptr_int_list p;
  
  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  get_two_args(funct->attr_list,&arg1,&arg2);
  
  if (!arg1) {
    curry();
    return success;
  }

  deref(arg1);
  deref_args(funct,set_1);
  resid_aim=NULL;
  
  if (arg1->type==top)
    t=collect_symbols(greatest_sel); /*  RM: Feb  3 1993  */
  else {
    p=arg1->type->children;

    /* Hack: check there's enough memory to build the list */
    /*  RM: Jul 22 1993  */
    /*
      { int count=0;
      while(p) {
      count++;
      p=p->next;
      }
      if (heap_pointer-stack_pointer < 3*count*sizeof(psi_term)) {
      goal_stack=aim;
      garbage();
      return success;
      }
    */
    
    t=stack_nil();
    if (!(arg1->type==real && arg1->value_3)) /* PVR 15.2.94 */
      while (p) {
        ptr_definition ptype;

        ptype = (ptr_definition) p->value_1;
        if (hidden_type(ptype)) { p=p->next; continue; }
        p1 = stack_psi_term(0);
        p1->type = ptype;
        t=stack_cons(p1,t);
        p = p->next;
      }
  }
  push_goal(unify,result,t,NULL);

  return success;
}

long c_glb

(

)

long c_glb

greatest lower bound (djd)

C_GLB(A,B) Return glb(A,B). Continued calls will return each following type in the disjunction of the glb of A,B.

Definition at line 709 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), decode(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), glb(), isSubTypeValue(), isValue(), makePsiTerm(), wl_int_list::next, NULL, push_choice_point(), push_goal(), resid_aim, set_1_2, TRUE, wl_psi_term::type, type_disj, unify, wl_int_list::value_1, and wl_psi_term::value_3.

{
  ptr_psi_term func,arg1,arg2, result, other;
  ptr_definition ans;
  ptr_int_list complexType;
  ptr_int_list decodedType = NULL;
  long ret;
  
  func=aim->aaaa_1;
  deref_ptr(func);
  get_two_args(func->attr_list,&arg1,&arg2);

  if ((!arg1) || (!arg2)) {
    curry();
    return TRUE;
  }
  result = aim->bbbb_1;
  deref(result);
  deref(arg1);
  deref(arg2);
  deref_args(func, set_1_2);

  if ((ret=glb(arg1->type, arg2->type, &ans, &complexType)) == 0)
    return FALSE;

  if ((ret != 4)&&(isValue(arg1)||isValue(arg2))) {
    /* glb is one of arg1->type or arg2->type AND at least one is a value */
    if (!isSubTypeValue(arg1, arg2) && !isSubTypeValue(arg2, arg1))
      return FALSE;
  }
  if (!ans) {
    decodedType = decode(complexType);
    ans = (ptr_definition)decodedType->value_1;
    decodedType = decodedType->next;
  }
  other=makePsiTerm(ans);

  if (isValue(arg1)) other->value_3=arg1->value_3;
  if (isValue(arg2)) other->value_3=arg2->value_3;
    
  if (isValue(arg1) || isValue(arg2)) {
    if (decodedType) {
      Errorline("glb of multiple-inheritance value sorts not yet implemented.\n");
      return FALSE;
    }
  }
    
  if (decodedType)
    push_choice_point(type_disj, result,(ptr_psi_term) decodedType,(GENERIC) NULL);

  resid_aim = NULL;
  push_goal(unify,result,other,NULL);
  return TRUE;
}

static long c_is_function ( )

static

c_is_function

Succeed iff argument is a function (built-in or user-defined).

Definition at line 500 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, function_it, get_one_arg(), set_1, TRUE, wl_psi_term::type, wl_definition::type_def, and unify_bool_result().

{
  int success=TRUE,ans;
  ptr_psi_term arg1,funct,result;

  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  get_one_arg(funct->attr_list,&arg1);
  if (arg1) {
    deref(arg1);
    deref_args(funct,set_1);
    ans=(arg1->type->type_def==(def_type)function_it);
    unify_bool_result(result,ans);
  }
  else curry();

  return success;
}

static long c_is_number ( )

static

static long c_is_number

Return true iff argument is an actual number.

Definition at line 636 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_two_args(), NULL, real, set_1, sub_type(), TRUE, wl_psi_term::type, unify_bool_result(), and wl_psi_term::value_3.

{
  long success=TRUE,ans;
  ptr_psi_term arg1,arg2,funct,result;

  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  get_two_args(funct->attr_list,&arg1,&arg2);
  if (arg1) {
    deref(arg1);
    deref_args(funct,set_1);
    ans=sub_type(arg1->type,real) && (arg1->value_3!=NULL);
    unify_bool_result(result,ans);
  }
  else curry();

  return success;
}

static long c_is_persistent ( )

static

c_is_persistent

Succeed iff argument is a quoted persistent or on the heap.

Definition at line 526 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_one_arg(), global_it, wl_definition::global_value, heap_pointer, set_1, TRUE, wl_psi_term::type, wl_definition::type_def, and unify_bool_result().

{
  int success=TRUE,ans;
  ptr_psi_term arg1,glob,result;

  glob=aim->aaaa_1;
  deref_ptr(glob);
  result=aim->bbbb_1;
  get_one_arg(glob->attr_list,&arg1);
  if (arg1) {
    deref(arg1);
    deref_args(glob,set_1);
    ans=(
     arg1->type->type_def==(def_type)global_it &&
     (GENERIC)arg1->type->global_value>=heap_pointer
     ) ||
      (GENERIC)arg1>=heap_pointer;
    unify_bool_result(result,ans);
  }
  else curry();
  
  return success;
}

static long c_is_predicate ( )

static

c_is_predicate

Succeed iff argument is a predicate (built-in or user-defined).

Definition at line 556 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_one_arg(), predicate_it, set_1, TRUE, wl_psi_term::type, wl_definition::type_def, and unify_bool_result().

{
  int success=TRUE,ans;
  ptr_psi_term arg1,funct,result;

  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  get_one_arg(funct->attr_list,&arg1);
  if (arg1) {
    deref(arg1);
    deref_args(funct,set_1);
    ans=(arg1->type->type_def==(def_type)predicate_it);
    unify_bool_result(result,ans);
  }
  else curry();

  return success;
}

static long c_is_sort ( )

static

c_is_sort

Succeed iff argument is a sort (built-in or user-defined).

Definition at line 582 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_one_arg(), set_1, TRUE, wl_psi_term::type, wl_definition::type_def, type_it, and unify_bool_result().

{
  int success=TRUE,ans;
  ptr_psi_term arg1,funct,result;

  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  get_one_arg(funct->attr_list,&arg1);
  if (arg1) {
    deref(arg1);
    deref_args(funct,set_1);
    ans=(arg1->type->type_def==(def_type)type_it);
    unify_bool_result(result,ans);
  }
  else curry();

  return success;
}

static long c_is_value ( )

static

c_is_value

Return true iff argument has a value, i.e. if it is implemented in a quirky way in Wild_Life. This is true for integers, reals, strings (which are potentially infinite sets of objects), and list objects.

Definition at line 610 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_two_args(), NULL, set_1, TRUE, unify_bool_result(), and wl_psi_term::value_3.

{
  long success=TRUE,ans;
  ptr_psi_term arg1,arg2,funct,result;

  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  get_two_args(funct->attr_list,&arg1,&arg2);
  if (arg1) {
    deref(arg1);
    deref_args(funct,set_1);
    ans=(arg1->value_3!=NULL);
    unify_bool_result(result,ans);
  }
  else curry();

  return success;
}

static long c_isa_cmp ( )

static

c_isa_cmp

Definition at line 480 of file bi_type.c.

References c_isa_main(), and isa_cmp_sel.

{
  return c_isa_main(isa_cmp_sel);
}

static long c_isa_eq ( )

static

c_isa_eq

Type t1 equals t2 in the hierarchy, i.e. t1 is equal to t2. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 391 of file bi_type.c.

References c_isa_main(), and isa_eq_sel.

{
  return c_isa_main(isa_eq_sel);
}

static long c_isa_ge ( )

static

c_isa_ge

Type t2 isa t1 in the hierarchy, i.e. t2 is less than or equal to t1. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 359 of file bi_type.c.

References c_isa_main(), and isa_ge_sel.

{
  return c_isa_main(isa_ge_sel);
}

static long c_isa_gt ( )

static

c_isa_gt

Type t2 is lt t1 in the hierarchy, i.e. t2 is less than to t1. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 375 of file bi_type.c.

References c_isa_main(), and isa_gt_sel.

{
  return c_isa_main(isa_gt_sel);
}

static long c_isa_le ( )

static

c_isa_le

Type t1 isa t2 in the hierarchy, i.e. t1 is less than or equal to t2. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 327 of file bi_type.c.

References c_isa_main(), and isa_le_sel.

{
  return c_isa_main(isa_le_sel);
}

static long c_isa_lt ( )

static

c_isa_lt

Type t1 is lt t2 in the hierarchy, i.e. t1 is less than t2. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 343 of file bi_type.c.

References c_isa_main(), and isa_lt_sel.

{
  return c_isa_main(isa_lt_sel);
}

static long c_isa_main ( long  sel )

static

c_isa_main

Parameters

sel	- long sel

Main routine to handle all the isa built-in functions.

Definition at line 295 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_two_args(), isa_select(), set_1_2, TRUE, and unify_bool_result().

{
  long success=TRUE,ans;
  ptr_psi_term arg1,arg2,funct,result;

  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  get_two_args(funct->attr_list,&arg1,&arg2);
  if (arg1 && arg2) {
    deref(arg1);
    deref(arg2);
    deref_args(funct,set_1_2);
    ans=isa_select(arg1,arg2,sel);
    unify_bool_result(result,ans);
  }
  else curry();

  return success;
}

static long c_isa_ncmp ( )

static

c_isa_ncmp

Definition at line 489 of file bi_type.c.

References c_isa_main(), and isa_ncmp_sel.

{
  return c_isa_main(isa_ncmp_sel);
}

static long c_isa_neq ( )

static

c_isa_neq

Type t1 is not eq t2 in the hierarchy, i.e. t1 is not equal to t2. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 471 of file bi_type.c.

References c_isa_main(), and isa_neq_sel.

{
  return c_isa_main(isa_neq_sel);
}

static long c_isa_nge ( )

static

c_isa_nge

Type t2 is not lt t1 in the hierarchy, i.e. t2 is not less than or equal to t1. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 439 of file bi_type.c.

References c_isa_main(), and isa_nge_sel.

{
  return c_isa_main(isa_nge_sel);
}

static long c_isa_ngt ( )

static

c_isa_ngt

Type t2 is not t1 in the hierarchy, i.e. t2 is not less than t1. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 455 of file bi_type.c.

References c_isa_main(), and isa_ngt_sel.

{
  return c_isa_main(isa_ngt_sel);
}

static long c_isa_nle ( )

static

c_isa_nle

Type t1 is not a t2 in the hierarchy, i.e. t1 is not less than or equal to t2. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 407 of file bi_type.c.

References c_isa_main(), and isa_nle_sel.

{
  return c_isa_main(isa_nle_sel);
}

static long c_isa_nlt ( )

static

c_isa_nlt

Type t1 is not lt t2 in the hierarchy, i.e. t1 is not less than to t2. This boolean function requires two arguments and never residuates. It will curry if insufficient arguments are given. It works correctly on the 'value' types, i.e. on integers, reals, strings, and lists. For lists, it looks only at the top level, i.e. whether the object is nil or a cons cell.

Definition at line 423 of file bi_type.c.

References c_isa_main(), and isa_nlt_sel.

{
  return c_isa_main(isa_nlt_sel);
}

long c_isa_subsort

(

)

long c_isa_subsort

C_ISA_SUBSORT(A,B) if A is a subsort of B => succeed and residuate on B else => fail

Definition at line 664 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref, deref_args, deref_ptr, FALSE, get_two_args(), isa(), reportAndAbort(), residuate(), set_1_2, and TRUE.

{
  ptr_psi_term pred,arg1,arg2;

  pred=aim->aaaa_1;
  deref_ptr(pred);
  get_two_args(pred->attr_list,&arg1,&arg2);

  if (!arg1) (void)reportAndAbort(pred,"no first argument");
  deref(arg1);
  
  if (!arg2) (void)reportAndAbort(pred,"no second argument");
  deref(arg2);

  deref_args(pred, set_1_2);

  if (isa(arg1, arg2))
    {
      residuate(arg2);
      return TRUE;
    }
  return FALSE;
}

long c_lub

(

)

long c_lub

least upper bound (djd) C_LUB(A,B) Return lub(A,B). Continued calls will return each following type in the disjunction of the lub of A,B.

Definition at line 773 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_two_args(), lub(), makePsiTerm(), wl_int_list::next, NULL, push_choice_point(), push_goal(), resid_aim, set_1_2, TRUE, type_disj, unify, and wl_int_list::value_1.

{
  ptr_psi_term func,arg1,arg2, result, other;
  ptr_definition ans=NULL;
  ptr_int_list decodedType = NULL;
  
  func=aim->aaaa_1;
  deref_ptr(func);
  get_two_args(func->attr_list,&arg1,&arg2);

  if ((!arg1) || (!arg2))
    {
      curry();
      return TRUE;
    }
  result = aim->bbbb_1;
  deref(result);
  deref(arg1);
  deref(arg2);
  deref_args(func, set_1_2);

  /* now lets find the list of types that is the lub */
  
  decodedType = lub(arg1, arg2, &other);

  if (decodedType) {
    ans = (ptr_definition)decodedType->value_1;
    decodedType = decodedType->next;
    other = makePsiTerm(ans);
  }

  if (decodedType)
    push_choice_point(type_disj, result,(ptr_psi_term) decodedType,(GENERIC) NULL);
    
  resid_aim = NULL;
  push_goal(unify,result,other,NULL);
  return TRUE;
}

static long c_parents ( )

static

c_parents

Return a list of roots of the parent types of T.

Definition at line 96 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_two_args(), hidden_type(), integer, wl_int_list::next, NULL, wl_definition::parents, push_goal(), quoted_string, real, resid_aim, set_1, stack_cons(), stack_nil(), stack_psi_term(), top, TRUE, wl_psi_term::type, unify, wl_int_list::value_1, and wl_psi_term::value_3.

{
  long success=TRUE;
  ptr_psi_term funct,result,arg1,arg2,t,p1;
  ptr_int_list p;

  funct=aim->aaaa_1;
  deref_ptr(funct);
  result=aim->bbbb_1;
  get_two_args(funct->attr_list,&arg1,&arg2);
  if (arg1) {
    deref(arg1);
    deref_args(funct,set_1);
    resid_aim=NULL;
    t=stack_nil();  /*  RM: Dec 14 1992  */
    p = arg1->type->parents;
    if (arg1->type!=top && p==NULL) {
      /* Top is the only parent */
      p1 = stack_psi_term(4);
      p1->type = (ptr_definition) top;
      t=stack_cons(p1,t); /*  RM: Dec 14 1992  */
    }
    else {
      if ((arg1->type==quoted_string || arg1->type==integer ||
       arg1->type==real) && arg1->value_3!=NULL) {
        /* arg1 is a string, long or real: return a list with arg1 as
           argument, where arg1->value_2 = NULL, MH */
        p1 = stack_psi_term(4);
        p1->type = arg1->type;
        t=stack_cons(p1,t); /*  RM: Dec 14 1992  */
      }
      else {
        /* Look at the parents list */
        while (p) {
          ptr_definition ptype;

          ptype = (ptr_definition) p->value_1;
          if (hidden_type(ptype)) { p=p->next; continue; }
          p1 = stack_psi_term(4);
          p1->type = ptype;
      t=stack_cons(p1,t); /*  RM: Dec 14 1992  */
          p = p->next;
        }
      }
    }
    push_goal(unify,result,t,NULL);
  }
  else
    curry();

  return success;
}

static long c_smallest ( )

static

c_smallest

Return the parents of bottom. This function has no arguments.

Definition at line 159 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_goal::bbbb_1, collect_symbols(), deref_args, least_sel, NULL, push_goal(), set_empty, TRUE, and unify.

{
  long success=TRUE;
  ptr_psi_term result, g, t;

  g=aim->aaaa_1;
  deref_args(g,set_empty);
  result=aim->bbbb_1;
  t=collect_symbols(least_sel); /*  RM: Feb  3 1993  */
  push_goal(unify,result,t,NULL);
  
  return success;
}

void insert_type_builtins

(

)

void insert_type_builtins

Definition at line 817 of file bi_type.c.

References bi_module, c_children(), c_glb(), c_is_function(), c_is_number(), c_is_persistent(), c_is_predicate(), c_is_sort(), c_is_value(), c_isa_cmp(), c_isa_eq(), c_isa_ge(), c_isa_gt(), c_isa_le(), c_isa_lt(), c_isa_ncmp(), c_isa_neq(), c_isa_nge(), c_isa_ngt(), c_isa_nle(), c_isa_nlt(), c_isa_subsort(), c_lub(), c_parents(), c_smallest(), function_it, new_built_in(), predicate_it, and syntax_module.

{
  /* Sort comparisons */
  new_built_in(syntax_module,":=<",(def_type)function_it,c_isa_le);
  new_built_in(syntax_module,":<",(def_type)function_it,c_isa_lt);
  new_built_in(syntax_module,":>=",(def_type)function_it,c_isa_ge);
  new_built_in(syntax_module,":>",(def_type)function_it,c_isa_gt);
  new_built_in(syntax_module,":==",(def_type)function_it,c_isa_eq);
  new_built_in(syntax_module,":><",(def_type)function_it,c_isa_cmp);
  new_built_in(syntax_module,":\\=<",(def_type)function_it,c_isa_nle);
  new_built_in(syntax_module,":\\<",(def_type)function_it,c_isa_nlt);
  new_built_in(syntax_module,":\\>=",(def_type)function_it,c_isa_nge);
  new_built_in(syntax_module,":\\>",(def_type)function_it,c_isa_ngt);
  new_built_in(syntax_module,":\\==",(def_type)function_it,c_isa_neq);
  new_built_in(syntax_module,":\\><",(def_type)function_it,c_isa_ncmp);

  /* Type checks */
  new_built_in(bi_module,"is_value",(def_type)function_it,c_is_value);
  new_built_in(bi_module,"is_number",(def_type)function_it,c_is_number);
  new_built_in(bi_module,"is_function",(def_type)function_it,c_is_function);
  new_built_in(bi_module,"is_predicate",(def_type)function_it,c_is_predicate);
  new_built_in(bi_module,"is_sort",(def_type)function_it,c_is_sort);
  new_built_in(bi_module,"is_persistent",(def_type)function_it,c_is_persistent);
  
  /* Sort hierarchy maneuvering */
  new_built_in(bi_module,"children",(def_type)function_it,c_children);
  new_built_in(bi_module,"parents",(def_type)function_it,c_parents);
  new_built_in(bi_module,"least_sorts",(def_type)function_it,c_smallest);
  new_built_in(bi_module,"subsort",(def_type)predicate_it,c_isa_subsort);
  new_built_in(bi_module,"glb",(def_type)function_it,c_glb);
  new_built_in(bi_module,"lub",(def_type)function_it,c_lub);
}

static static long isa ( ptr_psi_term  arg1, ptr_psi_term  arg2  )

static

isa

Parameters

arg1	- ptr_psi_term arg1
arg2	- ptr_psi_term arg2

Boolean utility function that implements isa

Definition at line 219 of file bi_type.c.

References cut, integer, isSubTypeValue(), matches(), real, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

{
  long ans;

  if (  arg1->type==arg2->type
    || (  (arg1->type==real || arg1->type==integer)
          && (arg2->type==real || arg2->type==integer)
          && (arg1->value_3 || arg2->value_3)
          )
    ) {

    if(arg1->type==cut) /*  RM: Jan 21 1993  */
      ans=TRUE;
    else
      ans=isSubTypeValue(arg1, arg2);
  }
  else {
    (void)matches(arg1->type, arg2->type, &ans);
  }

  /*Errorline("isa %P %P -> %d\n",arg1,arg2,ans);*/

  return ans;
}

static long isa_select ( ptr_psi_term  arg1, ptr_psi_term  arg2, long  sel  )

static

isa_select

Parameters

arg1	- ptr_psi_term arg1
arg2	- ptr_psi_term arg2
sel	- long sel - one of several values defined in def_const.h

Utility that selects one of several isa functions

Definition at line 253 of file bi_type.c.

References isa(), isa_cmp_sel, isa_eq_sel, isa_ge_sel, isa_gt_sel, isa_le_sel, isa_lt_sel, isa_ncmp_sel, isa_neq_sel, isa_nge_sel, isa_ngt_sel, isa_nle_sel, and isa_nlt_sel.

{
  long ans;

  switch (sel) {
  case isa_le_sel: ans=isa(arg1,arg2);
    break;
  case isa_lt_sel: ans=isa(arg1,arg2) && !isa(arg2,arg1);
    break;
  case isa_ge_sel: ans=isa(arg2,arg1);
    break;
  case isa_gt_sel: ans=isa(arg2,arg1) && !isa(arg1,arg2);
    break;
  case isa_eq_sel: ans=isa(arg1,arg2) && isa(arg2,arg1);
    break;

  case isa_nle_sel: ans= !isa(arg1,arg2);
    break;
  case isa_nlt_sel: ans= !(isa(arg1,arg2) && !isa(arg2,arg1));
    break;
  case isa_nge_sel: ans= !isa(arg2,arg1);
    break;
  case isa_ngt_sel: ans= !(isa(arg2,arg1) && !isa(arg1,arg2));
    break;
  case isa_neq_sel: ans= !(isa(arg1,arg2) && isa(arg2,arg1));
    break;

  case isa_cmp_sel: ans=isa(arg1,arg2) || isa(arg2,arg1);
    break;
  case isa_ncmp_sel: ans= !(isa(arg1,arg2) || isa(arg2,arg1));
    break;
  }
  return ans;
}

int isSubTypeValue	(	ptr_psi_term	arg1,
		ptr_psi_term	arg2
	)

isSubTypeValue

Parameters

arg1	- ptr_psi_term arg1
arg2	- ptr_psi_term arg2

Definition at line 180 of file bi_type.c.

References FALSE, integer, quoted_string, REAL, real, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

{
  long ans=TRUE;
  
  /* we already know that either arg1->type == arg2->type or that at both
   * of the two are either long or real
   */
  
  if (arg2->value_3) {
    if (arg1->value_3) {
      if (arg1->type==real || arg1->type==integer) {
        ans=( *(REAL *)arg1->value_3 == *(REAL *)arg2->value_3);
      }
      else if (arg1->type==quoted_string) {
        ans=(strcmp((char *)arg1->value_3,(char *)arg2->value_3)==0);
      }
    }
    else
      ans=FALSE;
  }
  else {
    if (arg1->value_3 && (arg1->type==real || arg1->type==integer)) {
      if (arg2->type==integer)
        ans=(*(REAL *)arg1->value_3 == floor(*(REAL *)arg1->value_3));
      else
        ans=TRUE;
    }
  }
  return ans;
}

long isValue

(

ptr_psi_term

p

)

isValue(p)

Parameters

p	- ptr_psi_term p

Definition at line 694 of file bi_type.c.

References NULL, and wl_psi_term::value_3.

{
  return (p->value_3 != NULL);
}