lefun.c File Reference

lefun More...

Go to the source code of this file.

Functions
ptr_psi_term	stack_psi_term (long stat)
	stack_psi_term More...
ptr_psi_term	real_stack_psi_term (long stat, REAL thereal)
	real_stack_psi_term More...
ptr_psi_term	heap_psi_term (long stat)
	heap_psi_term More...
void	residuate_double (ptr_psi_term t, ptr_psi_term u)
	residuate_double More...
void	residuate (ptr_psi_term t)
	residuate More...
void	residuate2 (ptr_psi_term u, ptr_psi_term v)
	residuate2 More...
void	residuate3 (ptr_psi_term u, ptr_psi_term v, ptr_psi_term w)
	residuate3 More...
void	curry ()
	curry More...
long	residuateGoalOnVar (ptr_goal g, ptr_psi_term var, ptr_psi_term othervar)
	residuateGoalOnVar More...
long	do_residuation_user ()
	do_residuation_user() More...
long	do_residuation ()
	do_residuation More...
void	do_currying ()
	do_currying More...
void	release_resid_main (ptr_psi_term t, long trailflag)
	release_resid_main More...
void	release_resid (ptr_psi_term t)
	release_resid More...
void	release_resid_notrail (ptr_psi_term t)
	release_resid_notrail More...
void	append_resid (ptr_psi_term u, ptr_psi_term v)
	append_resid More...
long	eval_aim ()
	eval_aim More...
void	match_attr1 (ptr_node *u, ptr_node v, ptr_resid_block rb)
	void match_attr1 More...
void	match_attr2 (ptr_node *u, ptr_node v, ptr_resid_block rb)
	match_attr2 More...
void	match_attr3 (ptr_node *u, ptr_node v, ptr_resid_block rb)
	match_attr3 More...
void	match_attr (ptr_node *u, ptr_node v, ptr_resid_block rb)
	match_attr More...
long	match_aim ()
	match_aim More...
long	i_eval_args (ptr_node n)
	i_eval_args More...
long	eval_args (ptr_node n)
	eval_args More...
void	check_disj (ptr_psi_term t)
	check_disj More...
void	check_func (ptr_psi_term t)
	check_func More...
long	check_type (ptr_psi_term t)
	check_type More...
long	i_check_out (ptr_psi_term t)
	i_check_out More...
long	f_check_out (ptr_psi_term t)
	f_check_out More...
long	check_out (ptr_psi_term t)
long	deref_eval (ptr_psi_term t)
	deref_eval More...
long	deref_rec_eval (ptr_psi_term t)
	deref_rec_eval More...
void	deref_rec_body (ptr_psi_term t)
	deref_rec_body More...
void	deref_rec_args (ptr_node n)
	deref_rec_args More...
long	deref_args_eval (ptr_psi_term t, long set)
	deref_args_eval More...
long	in_set (char *str, long set)
	in_set More...
void	deref_rec_args_exc (ptr_node n, long set)
	deref_rec_args_exc More...
void	deref2_eval (ptr_psi_term t)
	deref2_eval More...
void	deref2_rec_eval (ptr_psi_term t)
	deref2_rec_eval More...
void	save_resid (ptr_resid_block rb, ptr_psi_term match_date)
	save_resid More...
void	restore_resid (ptr_resid_block rb, ptr_psi_term *match_date)
	restore_resid More...
void	eval_global_var (ptr_psi_term t)
	eval_global_var More...
void	init_global_vars ()
	init_global_vars More...

Variables
static long	attr_missing
static long	check_func_flag
static long	deref_flag

Detailed Description

lefun

Definition in file lefun.c.

Function Documentation

void append_resid	(	ptr_psi_term	u,
		ptr_psi_term	v
	)

append_resid

Parameters

u	- ptr_psi_term u
v	- ptr_psi_term v

APPEND_RESID(u,v) Append the residuations pending on V to U. This routine does not check that the same constraint is not present twice in the end on U. This doesn't matter since RELEASE_RESID ensures that the same constraint is not released more than once.

Definition at line 474 of file lefun.c.

References push_ptr_value(), wl_psi_term::resid, and resid_ptr.

{
  ptr_residuation *g;
  
  g= &(u->resid);
  while (*g)
    g = &((*g)->next);
  
  push_ptr_value(resid_ptr,(GENERIC *)g);
  *g=v->resid;
}

void check_disj

(

ptr_psi_term

t

)

check_disj

Parameters

t	- ptr_psi_term t

CHECK_DISJ(t) Deal with disjunctions.

Definition at line 910 of file lefun.c.

References disj, fail, NULL, push_goal(), traceline(), TRUE, and wl_psi_term::value_3.

{
  traceline("push disjunction goal %P\n",t);
  if (t->value_3)
    push_goal(disj,t,t,(GENERIC)TRUE); /* 18.2 PVR */
  else
    push_goal(fail,NULL,NULL,NULL);
}

void check_func

(

ptr_psi_term

t

)

check_func

Parameters

t	- ptr_psi_term t

CHECK_FUNC(t) Deal with an unevaluated function: push an 'eval' goal for it, which will cause it to be evaluated.

Definition at line 928 of file lefun.c.

References wl_psi_term::attr_list, check_func_flag, check_out(), copy(), wl_psi_term::coref, disjunction, eval, eval_args(), wl_definition::evaluate_args, get_one_arg(), iff, push_goal(), push_psi_ptr_value(), RMASK, wl_definition::rule, stack_copy_psi_term(), stack_psi_term(), wl_psi_term::status, such_that, traceline(), TRUE, and wl_psi_term::type.

{
  ptr_psi_term result,t1,copy;

  /* Check for embedded definitions
     RM: Dec 16 1992  Re-instated this check then disabled it again
     if (resid_aim) {
     Errorline("embedded functions appeared in %P.\n",resid_aim->aaaa_1);
     fail_all();
     }
     else */ {
    
    traceline("setting up function call %P\n",t);
    /* Create a psi-term to put the result */
    result = stack_psi_term(0);
    
    /* Make a partial copy of the calling term */
    copy=stack_copy_psi_term(*t);
    copy->status &= ~RMASK;
  
    /* Bind the calling term to the result */
    /* push_ptr_value(psi_term_ptr,(GENERIC *)&(t->coref)); */
    push_psi_ptr_value(t,(GENERIC *)&(t->coref));
    t->coref=result;

    /* Evaluate the copy of the calling term */
    push_goal(eval,copy,result,(GENERIC)t->type->rule);
  
    /* Avoid evaluation for built-in functions with unevaluated arguments */
    /* (cond and such_that) */
    check_func_flag=TRUE;
    if (t->type==iff) {
      get_one_arg(t->attr_list,&t1);
      if (t1) {
    /* mark_eval(t1); 24.8 */
        (void)check_out(t1);
      }
    }
    else if(t->type==disjunction) {
    }
    else if (t->type!=such_that) {
      if (t->type->evaluate_args)
        (void)eval_args(t->attr_list);
      /* else mark_quote_tree(t->attr_list); 24.8 25.8 */
    }
  }
}

long check_out

(

ptr_psi_term

t

)

Definition at line 1083 of file lefun.c.

References wl_psi_term::attr_list, check_func(), check_func_flag, check_type(), deref_ptr, eval_args(), eval_global_var(), FALSE, function_it, global_it, heap_pointer, RMASK, wl_psi_term::status, traceline(), TRUE, wl_psi_term::type, wl_definition::type_def, and type_it.

{
  long flag=FALSE;
  deref_ptr(t);

  /* traceline("PVR: entering check_out with status %d and term %P\n",
            t->status,t); for brunobug.lf PVR 14.2.94 */
  traceline("PVR: entering check_out with status %d and term %P\n",
            t->status,t); /* for brunobug.lf PVR 14.2.94 */

  if (t->status || (GENERIC)t>=heap_pointer) /*  RM: Feb  8 1993  */
    flag=TRUE;
  else {
    t->status |= RMASK;

    switch((long)t->type->type_def) { /*  RM: Feb  8 1993  */
      
    case (long)function_it:
      if (check_func_flag) {
    check_func(t);
    flag=TRUE;
      }
      else {
    /* Function evaluation handled during matching and unification */
    flag=TRUE;
      }
      break;

    case (long)type_it:
      flag=check_type(t);
      break;

    case (long)global_it: /*  RM: Feb  8 1993  */
      eval_global_var(t);
      (void)check_out(t);
      flag=FALSE;
      break;
      
    default:
      flag=eval_args(t->attr_list);
    }
    t->status &= ~RMASK;
  }

  return flag;  
}

long check_type

(

ptr_psi_term

t

)

check_type

Parameters

t	- ptr_psi_term t

CHECK_TYPE(t) Here we deal with a type which may need checking. This routine will have to be modified to deal with the infinite loops currently caused by definitions such as:

:: H:husband(spouse => wife(spouse => H)). :: W:wife(spouse => husband(spouse => W)).

Definition at line 990 of file lefun.c.

References wl_definition::always_check, wl_psi_term::attr_list, eval_args(), FALSE, fetch_def(), int_ptr, wl_definition::properties, push2_ptr_value(), RMASK, SMASK, wl_psi_term::status, TRUE, and wl_psi_term::type.

{
  long flag=FALSE;

  push2_ptr_value(int_ptr,(GENERIC *)&(t->status),(GENERIC) (t->status & SMASK));
  /* push_ptr_value(int_ptr,(GENERIC *)&(t->status)); */
  
  if (t->type->properties) {
    if (t->attr_list || t->type->always_check) {
      /* Check all constraints here: */
      fetch_def(t, TRUE); /* PVR 18.2.94 */
      /* t->status=(2 & SMASK) | (t->status & RMASK); PVR 18.2.94 */

      (void)eval_args(t->attr_list);
      flag=FALSE;
    }
    else {
      /* definition pending on more information */
      t->status= (2 & SMASK) | (t->status & RMASK);
      flag=TRUE;
    }
  }
  else {
    
    /*  RM: Dec 15 1992  I don't know what this is for
    if (!ovverlap_type(t->type,alist))
    t->status= (4 & SMASK) | (t->status & RMASK);
    */
    
    flag=eval_args(t->attr_list);
  }
  
  return flag;
}

void curry

(

)

curry

Decide that the current function will have to be curried. This has become so simple it could be a MACRO. The real work is done by DO_CURRY.

Definition at line 174 of file lefun.c.

References can_curry, curried, and TRUE.

{
  if (can_curry)
    curried=TRUE;
}

void deref2_eval

(

ptr_psi_term

t

)

deref2_eval

Parameters

t	- ptr_psi_term t

Definition at line 1356 of file lefun.c.

References check_func(), deref_ptr, eval_global_var(), function_it, global_it, wl_psi_term::status, wl_psi_term::type, and wl_definition::type_def.

{
  deref_ptr(t);
  if (t->status==0) {
    if (t->type->type_def==(def_type)function_it) {
      check_func(t);
    }
    else 
      if(t->type->type_def==(def_type)global_it) { /*  RM: Feb 10 1993  */
        eval_global_var(t);
    deref_ptr(t);/*  RM: Jun 25 1993  */
    deref2_eval(t);
      }
      else {
    t->status=4;
      }
  }
}

void deref2_rec_eval

(

ptr_psi_term

t

)

deref2_rec_eval

Parameters

t	- ptr_psi_term t

Same as deref_rec_eval, but assumes goal_stack already restored.

Definition at line 1382 of file lefun.c.

References deref_ptr, and deref_rec_body().

{
  deref_ptr(t);
  deref_rec_body(t);
}

long deref_args_eval	(	ptr_psi_term	t,
		long	set
	)

deref_args_eval

Parameters

t	- ptr_psi_term t
set	- long set

Same as deref_rec_eval, but doesn't look at either the top level or the arguments in the set.

Definition at line 1294 of file lefun.c.

References aim, wl_psi_term::attr_list, deref_flag, deref_rec_args_exc(), FALSE, and goal_stack.

{
  ptr_goal save = goal_stack;
  ptr_goal top_loc = aim;

  deref_flag = FALSE;
  goal_stack = top_loc;
  deref_rec_args_exc(t->attr_list,set);
  if (!deref_flag) goal_stack = save;
  return (deref_flag);
}

long deref_eval

(

ptr_psi_term

t

)

deref_eval

Parameters

t	- ptr_psi_term t

deref_eval(P) If the psi-term P is a function, call check_func to push eval goals so that the function will be evaluated. Then return TRUE so that the caller can itself return. This only looks at the top level.

Definition at line 1180 of file lefun.c.

References aim, check_func(), deref_flag, deref_ptr, eval_global_var(), FALSE, function_it, global_it, goal_stack, heap_pointer, int_ptr, push_ptr_value(), wl_psi_term::status, TRUE, wl_psi_term::type, and wl_definition::type_def.

{
  ptr_goal save=goal_stack;

  deref_flag=FALSE;
  goal_stack=aim;

  if (t->status==0) {
    if(t->type->type_def==(def_type)function_it) {
      check_func(t);    /* Push eval goals to evaluate the function. */
      deref_flag=TRUE;  /* TRUE so that caller will return to main_prove. */
    }
    else
      if(t->type->type_def==(def_type)global_it) { /*  RM: Feb 10 1993  */
    eval_global_var(t);
    deref_ptr(t);/*  RM: Jun 25 1993  */
    deref_flag=deref_eval(t);
      }
      else {
    if (((long)t->status)!=2) {
      if((GENERIC)t<heap_pointer)
        push_ptr_value(int_ptr,(GENERIC *)&(t->status)); /*  RM: Jul 15 1993  */
      t->status=4;
      deref_flag=FALSE;
    }
      }
  }
  else
    deref_flag=FALSE;
  
  if (!deref_flag) goal_stack=save;
  return (deref_flag);
}

void deref_rec_args

(

ptr_node

n

)

deref_rec_args

Parameters

n	- ptr_node n

Definition at line 1272 of file lefun.c.

References wl_node::data, deref_ptr, deref_rec_body(), wl_node::left, and wl_node::right.

{
  ptr_psi_term t1;
  
  if (n) {
    deref_rec_args(n->right);
    t1 = (ptr_psi_term) (n->data);
    deref_ptr(t1);
    deref_rec_body(t1);
    deref_rec_args(n->left);
  }
}

void deref_rec_args_exc	(	ptr_node	n,
		long	set
	)

deref_rec_args_exc

Parameters

n	- ptr_node n
set	- long set

Definition at line 1332 of file lefun.c.

References wl_node::data, deref_ptr, deref_rec_body(), in_set(), wl_node::key, wl_node::left, and wl_node::right.

{
  ptr_psi_term t;
  
  if (n) {
    deref_rec_args_exc(n->right,set);
    if (!in_set(n->key,set)) {
      t = (ptr_psi_term) (n->data);
      deref_ptr(t);
      deref_rec_body(t);
    }
    deref_rec_args_exc(n->left,set);
  }
}

void deref_rec_body

(

ptr_psi_term

t

)

deref_rec_body

Parameters

t	- ptr_psi_term t

Definition at line 1243 of file lefun.c.

References wl_psi_term::attr_list, check_func(), deref_flag, deref_ptr, deref_rec_args(), eval_global_var(), function_it, global_it, heap_pointer, int_ptr, push_ptr_value(), wl_psi_term::status, TRUE, wl_psi_term::type, and wl_definition::type_def.

{
  if (t->status==0) {
    if (t->type->type_def==(def_type)function_it) {
      check_func(t);
      deref_flag=TRUE;
    }
    else
      if(t->type->type_def==(def_type)global_it) { /*  RM: Feb 10 1993  */
    eval_global_var(t);
    deref_ptr(t);/*  RM: Jun 25 1993  */
    deref_rec_body(t);
      }
      else {
    /* if (t->status!=2) Tried adding this -- PVR 9.2.94 */
      if((GENERIC)t<heap_pointer)
        push_ptr_value(int_ptr,(GENERIC *)&(t->status));/*  RM: Jul 15 1993  */
      t->status=4;
      deref_rec_args(t->attr_list);
      }
  }
}

long deref_rec_eval

(

ptr_psi_term

t

)

deref_rec_eval

Parameters

t	- ptr_psi_term t

deref_rec(P) If the psi-term P recursively contains any functions, then push eval goals to evaluate all of them. Set a global variable deref_flag if this is the case.

Definition at line 1226 of file lefun.c.

References aim, deref_flag, deref_rec_body(), FALSE, and goal_stack.

{
  ptr_goal save=goal_stack;

  deref_flag=FALSE;
  goal_stack=aim;
  deref_rec_body(t);
  if (!deref_flag) goal_stack=save;
  return (deref_flag);
}

void do_currying

(

)

do_currying

This performs CURRYing: all that needs to be done is to yield the calling term as the result after having given up on evaluation. In effect the calling psi-term is left intact.

Definition at line 383 of file lefun.c.

References wl_goal::aaaa_1, wl_goal::bbbb_1, goal_stack, wl_goal::next, NULL, push_goal(), resid_aim, traceline(), and unify_noeval.

{
  ptr_psi_term funct,result;

  /* PVR 5.11 undo(resid_limit); */
  /* PVR 5.11 choice_stack=cut_point; */
  goal_stack=resid_aim->next;
  funct=(ptr_psi_term )resid_aim->aaaa_1;
  result=(ptr_psi_term )resid_aim->bbbb_1;
    
  traceline("currying %P\n",funct);
   
  push_goal(unify_noeval,funct,result,NULL);
  resid_aim=NULL;
}

long do_residuation

(

)

do_residuation

C-defined routines do all stack manipulation themselves

Definition at line 336 of file lefun.c.

References wl_goal::aaaa_1, deref_ptr, FALSE, wl_resid_list::next, wl_resid_list::othervar, print_resid_message(), resid_aim, resid_vars, residuateGoalOnVar(), trace, traceline(), tracing(), TRUE, and wl_resid_list::var.

{
  long success;
  ptr_psi_term t,u;
  //  ptr_goal *gs;
  
  /* This undoes perfectly valid work! */
  /* The old version of Wild_Life did not trail anything
     during matching, so I think this was a nop for it. */
  /* PVR 11.5 undo(resid_limit); */
  /* PVR 11.5 choice_stack=cut_point; */

  /* PVR 9.2.94 */
  /* goal_stack=resid_aim->next; */

  if (trace) {
    tracing();
    print_resid_message(resid_aim->aaaa_1,resid_vars);
  }

  while (resid_vars) {
    
    t=resid_vars->var; /* 21.9 */
    u=resid_vars->othervar; /* 21.9 */
    /* PVR */ deref_ptr(t);
    resid_vars=resid_vars->next;
    traceline("residuating on %P (other = %P)\n",t,u);
    
    success=residuateGoalOnVar(resid_aim, t, u); /* 21.9 */
    if (!success) { /* 21.9 */
      traceline("failure because of disentailment\n");
      return FALSE;
    }
  }
  
  traceline("no failure because of disentailment\n");
  return TRUE; /* 21.9 */
}

long do_residuation_user

(

)

do_residuation_user()

Undo anything that matching may have done, then create a residuated expression. Check that the same constraint does not hang several times on the same variable.

This routine takes time proportional to the square of the number of residuations. This is too slow; eventually it should be sped up, especially if equality constraints are often used.

Definition at line 324 of file lefun.c.

References do_residuation(), goal_stack, wl_goal::next, and resid_aim.

{
  goal_stack=resid_aim->next; /* reset goal stack */
  return do_residuation();
}

long eval_aim

(

)

eval_aim

EVAL_AIM() Evaluate a function. This copies the current definition of the function and stacking the various goals that are necessary to evaluate the function correctly. It creates an extra psi-term (with value top) in which to write the result.

Definition at line 497 of file lefun.c.

References wl_goal::aaaa_1, wl_pair_list::aaaa_2, aim, wl_goal::bbbb_1, wl_pair_list::bbbb_2, c_rule, can_curry, wl_goal::cccc_1, choice_stack, clear_copy(), curried, deref_ptr, do_currying(), do_residuation(), eval, eval_copy(), eval_cut, FALSE, int_ptr, match, MAX_BUILT_INS, wl_pair_list::next, NULL, push2_ptr_value(), push_choice_point(), push_goal(), quote_copy(), resid_aim, resid_vars, save_resid(), SMASK, STACK, STACK_ALLOC, stack_pointer, wl_psi_term::status, traceline(), TRUE, and unify.

{
  long success=TRUE;
  ptr_psi_term funct,result,head,body;
  ptr_pair_list rule;
  /* RESID */ ptr_resid_block rb;
  ptr_choice_point cutpt;
  ptr_psi_term match_date; /* 13.6 */
 
  funct=(ptr_psi_term )aim->aaaa_1;
  deref_ptr(funct);

  /*  RM: Jun 18 1993  */
  push2_ptr_value(int_ptr,(GENERIC *)&(funct->status),(GENERIC)(funct->status & SMASK));
  funct->status=4;
  
  /* if (!funct->type->evaluate_args) mark_quote(funct); 25.8 */ /* 18.2 PVR */
  result=(ptr_psi_term )aim->bbbb_1;
  rule=(ptr_pair_list )aim->cccc_1;

  match_date=(ptr_psi_term )stack_pointer;
  cutpt=choice_stack; /* 13.6 */

  /* For currying and residuation */
  curried=FALSE;
  can_curry=TRUE;
  /* resid_aim=aim; */
  resid_vars=NULL;
  /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
      
  if (rule) {
    traceline("evaluate %P\n",funct);
    if ((unsigned long)rule<=MAX_BUILT_INS) {
      
      resid_aim=aim;
      success=c_rule[(unsigned long)rule]();

      if (curried)
    do_currying();
      else
    if (resid_vars)
      success=do_residuation(); /* 21.9 */
    else {
      /* resid_aim=NULL; */
        }
    }
    else {
      while (rule && (rule->aaaa_2==NULL || rule->bbbb_2==NULL)) {
        rule=rule->next;
        traceline("alternative rule has been retracted\n");
      }
      if (rule) {
        /* push_choice_point(eval,funct,result,rule->next); */ /* 17.6 */

        resid_aim=aim;
        /* RESID */ rb = STACK_ALLOC(resid_block);
        /* RESID */ save_resid(rb,match_date);
        /* RESID */ /* resid_aim = NULL; */

        clear_copy();

    /*  RM: Jun 18 1993: no functions in head */
    /*  if (TRUE)
        head=eval_copy(rule->aaaa_1,STACK);
        else */
    
    head=quote_copy(rule->aaaa_2,STACK);
        body=eval_copy(rule->bbbb_2,STACK);
    head->status=4;
    
        if (rule->next) /* 17.6 */
          push_choice_point(eval,funct,result,(GENERIC)rule->next);

        push_goal(unify,body,result,NULL);
        /* RESID */ push_goal(eval_cut,body,(ptr_psi_term)cutpt,(GENERIC)rb); /* 13.6 */
        /* RESID */ push_goal(match,funct,head,(GENERIC)rb);
        /* eval_args(head->attr_list); */
      }
      else {
        success=FALSE;
        /* resid_aim=NULL; */
      }
    }
  }
  else {
    success=FALSE;
    /* resid_aim=NULL; */
  }
  resid_aim=NULL;
  /* match_date=NULL; */ /* 13.6 */
  return success;
}

long eval_args

(

ptr_node

n

)

eval_args

Parameters

n	- ptr_node n

EVAL_ARGS(n) N is an attribute tree, the attributes must be examined, if any reveal themselves to need evaluating then return FALSE.

Definition at line 889 of file lefun.c.

References check_out(), wl_node::data, wl_node::left, wl_node::right, and TRUE.

{
  long flag=TRUE;
  
  if (n) {
    flag = eval_args(n->right);
    flag = check_out((ptr_psi_term)n->data) && flag;
    flag = eval_args(n->left) && flag;
  }
  
  return flag;
}

void eval_global_var

(

ptr_psi_term

t

)

eval_global_var

Parameters

t	- ptr_psi_term t

EVAL_GLOBAL_VAR(t) Dereference a global variable.

Definition at line 1440 of file lefun.c.

References wl_stack::aaaa_3, wl_stack::bbbb_3, clear_copy(), wl_psi_term::coref, deref_ptr, eval_copy(), global_it, wl_definition::global_value, wl_definition::init_value, wl_stack::next, NULL, psi_term_ptr, push_psi_ptr_value(), STACK, STACK_ALLOC, traceline(), wl_psi_term::type, wl_stack::type, wl_definition::type_def, and undo_stack.

{
  deref_ptr(t);

  /* Global variable (not persistent) */

  traceline("dereferencing variable %P\n",t);
  
  /* Trails the heap RM: Nov 10 1993  */
  if(!t->type->global_value) {

    /* Trail the heap !! */
    {
      ptr_stack n;
      n=STACK_ALLOC(stack);
      n->type=psi_term_ptr;
      n->aaaa_3= (GENERIC *) &(t->type->global_value);
      n->bbbb_3= (GENERIC *) NULL;
      n->next=undo_stack;
      undo_stack=n;
    }


    clear_copy();
    t->type->global_value=eval_copy(t->type->init_value,STACK);

  }

  /* var_occurred=TRUE; RM: Feb  4 1994  */

  if(t->type->type_def==(def_type)global_it && t!=t->type->global_value) {
    /*traceline("dereferencing variable %P\n",t);*/
    push_psi_ptr_value(t,(GENERIC *)&(t->coref));
    t->coref=t->type->global_value;
  }
}

long f_check_out

(

ptr_psi_term

t

)

f_check_out

Parameters

t	- ptr_psi_term t

• f_check_out(t) checks out functions too.

Definition at line 1046 of file lefun.c.

References check_func_flag, check_out(), and TRUE.

{
  check_func_flag=TRUE;
  return check_out(t);
}

ptr_psi_term heap_psi_term

(

long

stat

)

heap_psi_term

Parameters

stat	- long stat

Create a new psi_term on the heap with value '@' (top) and no attributes.

Definition at line 75 of file lefun.c.

References wl_psi_term::attr_list, wl_psi_term::coref, FALSE, wl_psi_term::flags, global_time_stamp, HEAP_ALLOC, NULL, QUOTED_TRUE, wl_psi_term::resid, wl_psi_term::status, top, wl_psi_term::type, and wl_psi_term::value_3.

{
  ptr_psi_term result;

  result=HEAP_ALLOC(psi_term);
  result->type=top;
  result->status=stat;
  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
  result->attr_list=NULL;
  result->coref=NULL;
#ifdef TS
  result->time_stamp=global_time_stamp; /* 9.6 */
#endif
  result->resid=NULL;
  result->value_3=NULL;

  return result;
}

long i_check_out

(

ptr_psi_term

t

)

i_check_out

Parameters

t	- ptr_psi_term t

• i_check_out(t) checks out everything except functions. When a function is encountered, check_out returns immediately without looking inside it.

Definition at line 1033 of file lefun.c.

References check_func_flag, check_out(), and FALSE.

{
  check_func_flag=FALSE;
  return check_out(t);
}

long i_eval_args

(

ptr_node

n

)

i_eval_args

Parameters

n	- ptr_node n

I_EVAL_ARGS(n) N is an attribute tree, the attributes must be examined, if any reveal themselves to need evaluating then return FALSE.

Definition at line 874 of file lefun.c.

References check_func_flag, eval_args(), and FALSE.

{
  check_func_flag=FALSE;
  return eval_args(n);
}

long in_set	(	char *	str,
		long	set
	)

in_set

Parameters

str	- char *str
set	- long set

Return TRUE iff string (considered as number) is in the set This routine only recognizes the strings "1", "2", "3", represented as numbers 1, 2, 4.

Definition at line 1316 of file lefun.c.

References FALSE, featcmp(), and TRUE.

{
  if (set&1 && !featcmp(str,"1")) return TRUE;
  if (set&2 && !featcmp(str,"2")) return TRUE;
  if (set&4 && !featcmp(str,"3")) return TRUE;
  if (set&8 && !featcmp(str,"4")) return TRUE;
  return FALSE;
}

void init_global_vars

(

)

init_global_vars

INIT_GLOBAL_VARS() Initialize all non-persistent global variables.

Definition at line 1484 of file lefun.c.

References first_definition, wl_definition::global_value, heap_pointer, wl_definition::next, and NULL.

{
  ptr_definition def;

  /* printf("initializing global vars...\n"); */
  
  /*
    for(def=first_definition;def;def=def->next) {
    if(def->type==global_it && ((GENERIC)def->global_value<heap_pointer)) {
    clear_copy();
    def->global_value=eval_copy(def->init_value,STACK); 
    }
    }
    */

  for(def=first_definition;def;def=def->next)
    if((GENERIC)(def->global_value)<(GENERIC)heap_pointer)
      def->global_value=NULL;
}

long match_aim

(

)

match_aim

long match_aim() MATCH_AIM() This is very similar to UNIFY_AIM, only matching cannot modify the calling psi_term. The first argument is the calling term (which may not be changed) and the second argument is the function definition (which may be changed). Residuate the expression if the calling term is more general than the function definition.

Definition at line 770 of file lefun.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, attr_missing, wl_goal::bbbb_1, can_curry, wl_goal::cccc_1, wl_psi_term::coref, curried, cut, deref_ptr, FALSE, FUNC_ARG, integer, match_attr(), matches(), NULL, overlap_type(), quoted_string, REAL, real, resid_aim, residuate_double(), restore_resid(), save_resid(), sys_bytedata, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

{
  long success=TRUE;
  ptr_psi_term u,v; // ,tmp;
  REAL r;
  long /* less, */ lesseq;
  ptr_resid_block rb;
  ptr_psi_term match_date;
  
  u=(ptr_psi_term )aim->aaaa_1;
  v=(ptr_psi_term )aim->bbbb_1;
  deref_ptr(u);
  deref_ptr(v);
  rb=(ptr_resid_block)aim->cccc_1;
  restore_resid(rb,&match_date);
  
  if (u!=v) {
    if ((success=matches(u->type,v->type,&lesseq))) {
      if (lesseq) {
        if (u->type!=cut || v->type!=cut) { /* Ignore value field for cut! */
          if (v->value_3) {
            if (u->value_3) {
              if (overlap_type(v->type,real))
                success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
              else if (overlap_type(v->type,quoted_string))
                success=(strcmp((char *)u->value_3,(char *)v->value_3)==0);
          /* DENYS: BYTEDATA */
              else if (overlap_type(v->type,sys_bytedata)) {
        unsigned long ulen = *((unsigned long *) u->value_3);
        unsigned long vlen = *((unsigned long *) v->value_3);
                success=(ulen==vlen && bcmp((char *)u->value_3,(char *)v->value_3,ulen)==0);
          }
            }
            else
              residuate_double(u,v);
          }
        }
      }
      else if (u->value_3) {
        /* Here we have U <| V but U and V have values which cannot match. */
        success=TRUE;
          
        if (v->value_3) {
          if (overlap_type(v->type,real))
            success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
        }
        else if (overlap_type(u->type,integer)) {
          r= *((REAL *)u->value_3);
          success=(r==floor(r));
        }
          
        if (success) residuate_double(u,v);
      } 
      else
        residuate_double(u,v);
                  
      if (success) {
        if (FUNC_ARG(u) && FUNC_ARG(v)) { /*  RM: Feb 10 1993  */
          /* residuate2(u,v); 21.9 */
          residuate_double(u,v); /* 21.9 */
          residuate_double(v,u); /* 21.9 */
    }
        else if (FUNC_ARG(v)) {  /*  RM: Feb 10 1993  */
          residuate_double(v,u); /* 21.9 */
        }
        else {
          v->coref=u;
        } /* 21.9 */
      attr_missing=FALSE;
      match_attr(&(u->attr_list),v->attr_list,rb);
      if (attr_missing) {
            if (can_curry)
              curried=TRUE;
            else
              residuate_double(u,v);
          }
        /* } 21.9 */
      }
    }
  }

  can_curry=FALSE;
  save_resid(rb,match_date); /* updated resid_block */
  /* This should be a useless statement: */
  resid_aim = NULL;
  
  return success;
}

void match_attr	(	ptr_node *	u,
		ptr_node	v,
		ptr_resid_block	rb
	)

match_attr

Parameters

u	- ptr_node *u
v	- ptr_node v
rb	- ptr_resid_block rb

MATCH_ATTR(u,v) Match the attribute trees of psi_terms U and V. If V has an attribute that U doesn't then curry. U is the calling term, V is the definition. This routine is careful to push nested eval and match goals in descending order of feature names.

Definition at line 752 of file lefun.c.

References match_attr1(), match_attr2(), and match_attr3().

{
  match_attr1(u,v,rb); /* Match corresponding arguments (third) */
  match_attr2(u,v,rb); /* Evaluate lone arguments (second) */
  match_attr3(u,v,rb); /* Evaluate corresponding arguments (first) */
}

void match_attr1	(	ptr_node *	u,
		ptr_node	v,
		ptr_resid_block	rb
	)

void match_attr1

Parameters

u	- ptr_node *u
v	- ptr_node v
rb	- ptr_resid_block rb

Match the corresponding arguments

Definition at line 599 of file lefun.c.

References attr_missing, wl_node::data, featcmp(), wl_node::key, wl_node::left, match, NULL, push_goal(), wl_node::right, and TRUE.

{
  long cmp;
  ptr_node temp;
  
  if (v) {
    if (*u==NULL)
      attr_missing=TRUE;
    else {
      cmp=featcmp((*u)->key,v->key);
      if(cmp==0) {
        ptr_psi_term t;
    /* RESID */ match_attr1(&((*u)->right),v->right,rb);
        t = (ptr_psi_term) (*u)->data;
    /* RESID */ push_goal(match,(ptr_psi_term)(*u)->data,(ptr_psi_term)v->data,(GENERIC)rb);
        /* deref2_eval(t); */
    /* RESID */ match_attr1(&((*u)->left),v->left,rb);
      }
      else if (cmp>0) {
        temp=v->right;
        v->right=NULL;
    /* RESID */ match_attr1(u,temp,rb);
    /* RESID */ match_attr1(&((*u)->left),v,rb);
    v->right=temp;
      }
      else {
    temp=v->left;
    v->left=NULL;
    /* RESID */ match_attr1(&((*u)->right),v,rb);
    /* RESID */ match_attr1(u,temp,rb);
    v->left=temp;
      }
    }
  }
}

void match_attr2	(	ptr_node *	u,
		ptr_node	v,
		ptr_resid_block	rb
	)

match_attr2

Parameters

u	- ptr_node *u
v	- ptr_node v
rb	- ptr_resid_block rb

Evaluate the lone arguments (for lazy failure + eager success)

Definition at line 644 of file lefun.c.

References wl_node::data, deref2_rec_eval(), featcmp(), wl_node::key, wl_node::left, match_attr1(), NULL, and wl_node::right.

{
  long cmp;
  ptr_node temp;
  
  if (v) {
    if (*u==NULL) { /* PVR 12.03 */
      ptr_psi_term t;
      match_attr1(u,v->right,rb);
      t = (ptr_psi_term) v->data;
      deref2_rec_eval(t);
      match_attr1(u,v->left,rb);
    }
    else {
      cmp=featcmp((*u)->key,v->key);
      if(cmp==0) {
    /* RESID */ match_attr2(&((*u)->right),v->right,rb);
    /* RESID */ match_attr2(&((*u)->left),v->left,rb);
      }
      else if (cmp>0) {
        temp=v->right;
        v->right=NULL;
    /* RESID */ match_attr2(u,temp,rb);
    /* RESID */ match_attr2(&((*u)->left),v,rb);
    v->right=temp;
      }
      else {
    temp=v->left;
    v->left=NULL;
    /* RESID */ match_attr2(&((*u)->right),v,rb);
    /* RESID */ match_attr2(u,temp,rb);
    v->left=temp;
      }
    }
  }
  else if (*u!=NULL) {
    ptr_psi_term t /* , empty */ ;
    match_attr1(&((*u)->right),v,rb);
    t = (ptr_psi_term) (*u)->data;
    /* Create a new psi-term to put the (useless) result: */
    /* This is needed so that *all* arguments of a function call */
    /* are evaluated, which avoids incorrect 'Yes' answers.      */
    deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
    match_attr1(&((*u)->left),v,rb);
  }
}

void match_attr3	(	ptr_node *	u,
		ptr_node	v,
		ptr_resid_block	rb
	)

match_attr3

Parameters

u	- ptr_node *u
v	- ptr_node v
rb	- ptr_resid_block rb

Evaluate the corresponding arguments

Definition at line 700 of file lefun.c.

References attr_missing, wl_node::data, deref2_eval(), featcmp(), wl_node::key, wl_node::left, NULL, wl_node::right, and TRUE.

{
  long cmp;
  ptr_node temp;
  
  if (v) {
    if (*u==NULL)
      attr_missing=TRUE;
    else {
      cmp=featcmp((*u)->key,v->key);
      if(cmp==0) {
        ptr_psi_term t1,t2;
    /* RESID */ match_attr3(&((*u)->right),v->right,rb);
        t1 = (ptr_psi_term) (*u)->data;
        t2 = (ptr_psi_term) v->data;
    /* RESID */ /* push_goal(match,(*u)->data,v->data,rb); */
        deref2_eval(t1); /* Assumes goal_stack is already restored. */
        deref2_eval(t2); /* PVR 12.03 */
    /* RESID */ match_attr3(&((*u)->left),v->left,rb);
      }
      else if (cmp>0) {
        temp=v->right;
        v->right=NULL;
    /* RESID */ match_attr3(u,temp,rb);
    /* RESID */ match_attr3(&((*u)->left),v,rb);
    v->right=temp;
      }
      else {
    temp=v->left;
    v->left=NULL;
    /* RESID */ match_attr3(&((*u)->right),v,rb);
    /* RESID */ match_attr3(u,temp,rb);
    v->left=temp;
      }
    }
  }
}

ptr_psi_term real_stack_psi_term	(	long	stat,
		REAL	thereal
	)

real_stack_psi_term

Parameters

stat	- long stat
thereal	- REAL thereal

Create a new psi_term on the stack with a real number value.

Definition at line 48 of file lefun.c.

References wl_psi_term::attr_list, wl_psi_term::coref, FALSE, wl_psi_term::flags, global_time_stamp, heap_alloc(), integer, NULL, QUOTED_TRUE, REAL, real, wl_psi_term::resid, STACK_ALLOC, wl_psi_term::status, wl_psi_term::type, and wl_psi_term::value_3.

{
  ptr_psi_term result;

  result=STACK_ALLOC(psi_term);
  result->type = (thereal==floor(thereal)) ? integer : real;
  result->status=stat;
  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
  result->attr_list=NULL;
  result->coref=NULL;
#ifdef TS
  result->time_stamp=global_time_stamp; /* 9.6 */
#endif
  result->resid=NULL;
  result->value_3=heap_alloc(sizeof(REAL));
  (* (REAL *)(result->value_3)) = thereal;

  return result;
}

void release_resid

(

ptr_psi_term

t

)

release_resid

Parameters

t	- ptr_psi_term t

Definition at line 445 of file lefun.c.

References release_resid_main(), and TRUE.

{
  release_resid_main(t,TRUE);
}

void release_resid_main	(	ptr_psi_term	t,
		long	trailflag
	)

release_resid_main

Parameters

t	- ptr_psi_term t
trailflag	- long trailflag

Release the residuations pending on the Residuation Variable T. This is done by simply pushing the residuated goals onto the goal-stack. A goal is not added if already present on the stack. Two versions of this routine exist: one which trails t and one which never trails t.

Definition at line 411 of file lefun.c.

References wl_goal::aaaa_1, FALSE, wl_residuation::goal, goal_ptr, goal_stack, int_ptr, wl_residuation::next, wl_goal::next, NULL, wl_goal::pending, push_ptr_value(), wl_psi_term::resid, resid_ptr, and traceline().

{
  ptr_goal g;
  ptr_residuation r;
  
  if ((r=t->resid)) {
    if (trailflag) push_ptr_value(resid_ptr,(GENERIC *)&(t->resid));
    t->resid=NULL;
    
    while (r) {
      g=r->goal;
      if (g->pending) {
    
    push_ptr_value(int_ptr,(GENERIC *)&(g->pending));
    g->pending=FALSE;
    
    push_ptr_value(goal_ptr,(GENERIC *)&(g->next));
    
    g->next=goal_stack;
    goal_stack=g;
    
        traceline("releasing %P\n",g->aaaa_1);
      }
      r=r->next;
    }
  }
}

void release_resid_notrail

(

ptr_psi_term

t

)

release_resid_notrail

Parameters

t	- ptr_psi_term t

Definition at line 456 of file lefun.c.

References FALSE, and release_resid_main().

{
  release_resid_main(t,FALSE);
}

void residuate

(

ptr_psi_term

t

)

residuate

Parameters

t	- ptr_psi_term t

Residuate the current expression with T in the Residuation Variable set.

Definition at line 125 of file lefun.c.

References wl_resid_list::next, NULL, wl_resid_list::othervar, resid_vars, STACK_ALLOC, and wl_resid_list::var.

{
  ptr_resid_list curr;

  curr=STACK_ALLOC(resid_list);
  curr->var=t;
  curr->othervar=NULL; /* 21.9 */
  curr->next=resid_vars;
  resid_vars=curr;
}

void residuate2	(	ptr_psi_term	u,
		ptr_psi_term	v
	)

residuate2

Parameters

u	- ptr_psi_term u
v	- ptr_psi_term v

Residuate the current function on the two variables U and V.

Definition at line 144 of file lefun.c.

References residuate().

{
  residuate(u);
  if (v && u!=v) residuate(v);
}

void residuate3	(	ptr_psi_term	u,
		ptr_psi_term	v,
		ptr_psi_term	w
	)

residuate3

Parameters

u	- ptr_psi_term u
v	- ptr_psi_term v
w	- ptr_psi_term w

Residuate the current function on the three variables U, V, and W.

Definition at line 159 of file lefun.c.

References residuate().

{
  residuate(u);
  if (v && u!=v) residuate(v);
  if (w && u!=w && v!=w) residuate(w);
} 

void residuate_double	(	ptr_psi_term	t,
		ptr_psi_term	u
	)

residuate_double

Parameters

t	- ptr_psi_term t
u	- ptr_psi_term u

Residuate the current expression with T in the Residuation Variable set. Also store the other variable, so that its sort can be used in the 'bestsort' calculation needed to implement disequality constraints.

Definition at line 107 of file lefun.c.

References wl_resid_list::next, wl_resid_list::othervar, resid_vars, STACK_ALLOC, and wl_resid_list::var.

{
  ptr_resid_list curr;

  curr=STACK_ALLOC(resid_list);
  curr->var=t;
  curr->othervar=u;
  curr->next=resid_vars;
  resid_vars=curr;
}

long residuateGoalOnVar	(	ptr_goal	g,
		ptr_psi_term	var,
		ptr_psi_term	othervar
	)

residuateGoalOnVar

Parameters

g	- ptr_goal g
var	- ptr_psi_term var
othervar	- ptr_psi_term othervar

Add the goal to the variable's residuation list. Also update the residuation's 'bestsort' field if it exists (needed to implement complete disequality semantics). The 'othervar' parameter is needed for this.

Definition at line 192 of file lefun.c.

References code_ptr, def_ptr, Errorline(), FALSE, glb_code(), glb_value(), heap_pointer, int_ptr, wl_goal::next, NULL, wl_goal::pending, push_ptr_value(), wl_psi_term::resid, resid_ptr, STACK_ALLOC, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

{
  long result;
  long resflag,resflag2;
  GENERIC rescode,rescode2;
  GENERIC resvalue;
  GENERIC resvalue2;
  /* Set to FALSE if the goal is already residuated on the var: */
  long not_found = TRUE;
  /* Points to a pointer to a residuation structure.  Used so we can */
  /* add the goal to the end of the residuation list, so that it can */
  /* can be undone later if backtracking happens.  See the call to   */
  /* push_ptr_value.  */
  ptr_residuation *r;
    
  /* 5.8 PVR */
  if ((GENERIC)var>=heap_pointer) {
    Errorline("attempt to residuate on psi-term %P in the heap.\n",var);

    return FALSE;
  }

  r= &(var->resid);
    
  while (not_found && *r) {
    if ((*r)->goal == g) { /* This goal is already attached */
      /* Keep track of best sort so far */
      /* Glb_code(..) tries to keep 'sortflag' TRUE if possible. */
      result=glb_code((*r)->sortflag,(*r)->bestsort,
              TRUE,(GENERIC)var->type,
              &resflag,&rescode);
      result=glb_value(result,resflag,rescode,(GENERIC)(*r)->value_2,var->value_3,
               &resvalue); /* 6.10 */
      if (!result)
        return FALSE; /* 21.9 */
      else if (othervar) {
    result=glb_code(resflag,rescode,TRUE,(GENERIC)othervar->type,
            &resflag2,&rescode2);
        result=glb_value(result,resflag2,rescode2,resvalue,othervar->value_3,
             &resvalue2); /* 6.10 */
        if (!result) {
          return FALSE;
        }
        else {
      /* The value field only has to be trailed once, since its value */
      /* does not change, once given. */
      if ((*r)->value_2==NULL && resvalue2!=NULL) { /* 6.10 */
        push_ptr_value(int_ptr,(GENERIC *)&((*r)->value_2));
      }
      if ((*r)->bestsort!=rescode2) {
            push_ptr_value(((*r)->sortflag?def_ptr:code_ptr),
               &((*r)->bestsort));
            (*r)->bestsort=rescode2; /* 21.9 */
      }
      if ((*r)->sortflag!=resflag2) {
            push_ptr_value(int_ptr,(GENERIC *)&((*r)->sortflag));
            (*r)->sortflag=resflag2; /* 21.9 */
      }
    }
      }
      else {
    if ((*r)->value_2==NULL && resvalue!=NULL) { /* 6.10 */
      push_ptr_value(int_ptr,(GENERIC *)&((*r)->value_2));
    }
    if ((*r)->bestsort!=rescode) {
          push_ptr_value(((*r)->sortflag?def_ptr:code_ptr),
                     &((*r)->bestsort));
          (*r)->bestsort=rescode; /* 21.9 */
    }
    if ((*r)->sortflag!=resflag) {
          push_ptr_value(int_ptr,(GENERIC *)&((*r)->sortflag));
          (*r)->sortflag=resflag; /* 21.9 */
    }
      }
      not_found = FALSE;
    }
    else
      r= &((*r)->next);  /* look at the next one */
  }
  
  if (not_found) {
    /* We must attach this goal & the variable's sort onto this variable */
    
    push_ptr_value(resid_ptr,(GENERIC *)r);
    *r=STACK_ALLOC(residuation);
    if (othervar) {
      result=glb_code(TRUE,(GENERIC)var->type,TRUE,(GENERIC)othervar->type,&resflag,&rescode);
      result=glb_value(result,resflag,rescode,var->value_3,othervar->value_3,
               &resvalue); /* 6.10 */
      if (!result) {
        return FALSE;
      }
      else {
    (*r)->sortflag=resflag;
        (*r)->bestsort=rescode; /* 21.9 */
    (*r)->value_2=resvalue; /* 6.10 */
      }
    }
    else {
      (*r)->sortflag=TRUE;
      (*r)->bestsort=(GENERIC)var->type; /* 21.9 */
      (*r)->value_2=var->value_3; /* 6.10 */
    }
    (*r)->goal=g;
    (*r)->next=NULL;
  }
  
  if (!(g->pending)) {
    /* this goal is not pending, so make sure it will be put on the goal
     * stack later
     */
    push_ptr_value(int_ptr,(GENERIC *)&(g->pending));
    g->pending=(ptr_definition)TRUE;
  }
  
  return TRUE; /* 21.9 */
}

void restore_resid	(	ptr_resid_block	rb,
		ptr_psi_term *	match_date
	)

restore_resid

Parameters

rb	- ptr_resid_block rb
match_date	- ptr_psi_term *match_date

Definition at line 1417 of file lefun.c.

References can_curry, wl_resid_block::cc_cr, curried, FALSE, wl_resid_block::md, wl_resid_block::ra, resid_aim, resid_vars, wl_resid_block::rv, and TRUE.

{
   if (rb) {
      can_curry = (rb->cc_cr&2)?TRUE:FALSE; /* 11.9 */
      curried   = (rb->cc_cr&1)?TRUE:FALSE; /* 11.9 */
      resid_aim = rb->ra;
      resid_vars = rb->rv;
      /* curried = rb->cr; 11.9 */
      /* can_curry = rb->cc; 11.9 */
      *match_date = rb->md;
   }
}

void save_resid	(	ptr_resid_block	rb,
		ptr_psi_term	match_date
	)

save_resid

Parameters

rb	- ptr_resid_block rb
match_date	- ptr_psi_term match_date

Saving & restoring residuation information

Definition at line 1398 of file lefun.c.

References can_curry, wl_resid_block::cc_cr, curried, wl_resid_block::md, wl_resid_block::ra, resid_aim, resid_vars, and wl_resid_block::rv.

{
   if (rb) {
      rb->cc_cr = (can_curry<<1) + curried; /* 11.9 */
      rb->ra = resid_aim;
      rb->rv = resid_vars;
      /* rb->cr = curried; 11.9 */
      /* rb->cc = can_curry; 11.9 */
      rb->md = match_date;
   }
}

ptr_psi_term stack_psi_term

(

long

stat

)

stack_psi_term

Create a new psi_term on the stack with value '@' (top) and no attributes.

Definition at line 21 of file lefun.c.

References wl_psi_term::attr_list, wl_psi_term::coref, FALSE, wl_psi_term::flags, global_time_stamp, NULL, QUOTED_TRUE, wl_psi_term::resid, STACK_ALLOC, wl_psi_term::status, top, wl_psi_term::type, and wl_psi_term::value_3.

{
  ptr_psi_term result;

  result=STACK_ALLOC(psi_term);
  result->type=top;
  result->status=stat;
  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
  result->attr_list=NULL;
  result->coref=NULL;
#ifdef TS
  result->time_stamp=global_time_stamp; /* 9.6 */
#endif
  result->resid=NULL;
  result->value_3=NULL;

  return result;
}

Variable Documentation

long attr_missing

static

Definition at line 12 of file lefun.c.

long check_func_flag

static

Definition at line 13 of file lefun.c.

long deref_flag

static

Definition at line 1166 of file lefun.c.