Wild Life  2.29
 All Data Structures Files Functions Variables Typedefs Macros
Functions | Variables
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
ptr_psi_termu
ptr_psi_termv

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.

475 {
476  ptr_residuation *g;
477 
478  g= &(u->resid);
479  while (*g)
480  g = &((*g)->next);
481 
483  *g=v->resid;
484 }
ptr_residuation resid
Definition: def_struct.h:173
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
unsigned long * GENERIC
Definition: def_struct.h:17
#define resid_ptr
Definition: def_const.h:171
void check_disj ( ptr_psi_term  t)

check_disj

Parameters
ptr_psi_termt

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.

911 {
912  traceline("push disjunction goal %P\n",t);
913  if (t->value_3)
914  push_goal(disj,t,t,(GENERIC)TRUE); /* 18.2 PVR */
915  else
917 }
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define NULL
Definition: def_const.h:203
void traceline(char *format,...)
traceline
Definition: error.c:186
#define TRUE
Definition: def_const.h:127
GENERIC value_3
Definition: def_struct.h:170
#define fail
Definition: def_const.h:272
#define disj
Definition: def_const.h:276
unsigned long * GENERIC
Definition: def_struct.h:17
void check_func ( ptr_psi_term  t)

check_func

Parameters
ptr_psi_termt

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.

929 {
930  ptr_psi_term result,t1,copy;
931 
932  /* Check for embedded definitions
933  RM: Dec 16 1992 Re-instated this check then disabled it again
934  if (resid_aim) {
935  Errorline("embedded functions appeared in %P.\n",resid_aim->aaaa_1);
936  fail_all();
937  }
938  else */ {
939 
940  traceline("setting up function call %P\n",t);
941  /* Create a psi-term to put the result */
942  result = stack_psi_term(0);
943 
944  /* Make a partial copy of the calling term */
945  copy=stack_copy_psi_term(*t);
946  copy->status &= ~RMASK;
947 
948  /* Bind the calling term to the result */
949  /* push_ptr_value(psi_term_ptr,(GENERIC *)&(t->coref)); */
950  push_psi_ptr_value(t,(GENERIC *)&(t->coref));
951  t->coref=result;
952 
953  /* Evaluate the copy of the calling term */
954  push_goal(eval,copy,result,(GENERIC)t->type->rule);
955 
956  /* Avoid evaluation for built-in functions with unevaluated arguments */
957  /* (cond and such_that) */
959  if (t->type==iff) {
960  get_one_arg(t->attr_list,&t1);
961  if (t1) {
962  /* mark_eval(t1); 24.8 */
963  (void)check_out(t1);
964  }
965  }
966  else if(t->type==disjunction) {
967  }
968  else if (t->type!=such_that) {
969  if (t->type->evaluate_args)
970  (void)eval_args(t->attr_list);
971  /* else mark_quote_tree(t->attr_list); 24.8 25.8 */
972  }
973  }
974 }
ptr_definition such_that
Definition: def_glob.h:105
long eval_args(ptr_node n)
eval_args
Definition: lefun.c:889
char evaluate_args
Definition: def_struct.h:136
long check_out(ptr_psi_term t)
Definition: lefun.c:1083
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define eval
Definition: def_const.h:278
void traceline(char *format,...)
traceline
Definition: error.c:186
#define TRUE
Definition: def_const.h:127
ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
copy
Definition: copy.c:248
#define RMASK
Definition: def_const.h:159
ptr_definition iff
Definition: def_glob.h:92
ptr_pair_list rule
Definition: def_struct.h:126
ptr_definition disjunction
Definition: def_glob.h:84
ptr_psi_term coref
Definition: def_struct.h:172
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
static long check_func_flag
Definition: lefun.c:13
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
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, heap_pointer, RMASK, wl_psi_term::status, traceline(), TRUE, wl_psi_term::type, wl_definition::type_def, and type_it.

1084 {
1085  long flag=FALSE;
1086  deref_ptr(t);
1087 
1088  /* traceline("PVR: entering check_out with status %d and term %P\n",
1089  t->status,t); for brunobug.lf PVR 14.2.94 */
1090  traceline("PVR: entering check_out with status %d and term %P\n",
1091  t->status,t); /* for brunobug.lf PVR 14.2.94 */
1092 
1093  if (t->status || (GENERIC)t>=heap_pointer) /* RM: Feb 8 1993 */
1094  flag=TRUE;
1095  else {
1096  t->status |= RMASK;
1097 
1098  switch((long)t->type->type_def) { /* RM: Feb 8 1993 */
1099 
1100  case (long)function_it:
1101  if (check_func_flag) {
1102  check_func(t);
1103  flag=TRUE;
1104  }
1105  else {
1106  /* Function evaluation handled during matching and unification */
1107  flag=TRUE;
1108  }
1109  break;
1110 
1111  case (long)type_it:
1112  flag=check_type(t);
1113  break;
1114 
1115  case (long)global: /* RM: Feb 8 1993 */
1116  eval_global_var(t);
1117  (void)check_out(t);
1118  flag=FALSE;
1119  break;
1120 
1121  default:
1122  flag=eval_args(t->attr_list);
1123  }
1124  t->status &= ~RMASK;
1125  }
1126 
1127  return flag;
1128 }
#define function_it
Definition: def_const.h:362
long eval_args(ptr_node n)
eval_args
Definition: lefun.c:889
void eval_global_var(ptr_psi_term t)
eval_global_var
Definition: lefun.c:1440
long check_out(ptr_psi_term t)
Definition: lefun.c:1083
#define global
Definition: def_const.h:364
def_type type_def
Definition: def_struct.h:133
long check_type(ptr_psi_term t)
check_type
Definition: lefun.c:990
void traceline(char *format,...)
traceline
Definition: error.c:186
#define type_it
Definition: def_const.h:363
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define RMASK
Definition: def_const.h:159
#define FALSE
Definition: def_const.h:128
void check_func(ptr_psi_term t)
check_func
Definition: lefun.c:928
GENERIC heap_pointer
Definition: def_glob.h:12
static long check_func_flag
Definition: lefun.c:13
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
long check_type ( ptr_psi_term  t)

check_type

Parameters
ptr_psi_termt

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.

991 {
992  long flag=FALSE;
993 
995  /* push_ptr_value(int_ptr,(GENERIC *)&(t->status)); */
996 
997  if (t->type->properties) {
998  if (t->attr_list || t->type->always_check) {
999  /* Check all constraints here: */
1000  fetch_def(t, TRUE); /* PVR 18.2.94 */
1001  /* t->status=(2 & SMASK) | (t->status & RMASK); PVR 18.2.94 */
1002 
1003  (void)eval_args(t->attr_list);
1004  flag=FALSE;
1005  }
1006  else {
1007  /* definition pending on more information */
1008  t->status= (2 & SMASK) | (t->status & RMASK);
1009  flag=TRUE;
1010  }
1011  }
1012  else {
1013 
1014  /* RM: Dec 15 1992 I don't know what this is for
1015  if (!ovverlap_type(t->type,alist))
1016  t->status= (4 & SMASK) | (t->status & RMASK);
1017  */
1018 
1019  flag=eval_args(t->attr_list);
1020  }
1021 
1022  return flag;
1023 }
long eval_args(ptr_node n)
eval_args
Definition: lefun.c:889
void push2_ptr_value(type_ptr t, GENERIC *p, GENERIC v)
push2_ptr_value
Definition: login.c:573
char always_check
Definition: def_struct.h:134
void fetch_def(ptr_psi_term u, long allflag)
fetch_def
Definition: login.c:1208
#define TRUE
Definition: def_const.h:127
#define RMASK
Definition: def_const.h:159
#define FALSE
Definition: def_const.h:128
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_triple_list properties
Definition: def_struct.h:127
#define SMASK
Definition: def_const.h:160
ptr_node attr_list
Definition: def_struct.h:171
#define int_ptr
Definition: def_const.h:172
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.

175 {
176  if (can_curry)
177  curried=TRUE;
178 }
#define TRUE
Definition: def_const.h:127
long can_curry
Definition: def_glob.h:224
long curried
Definition: def_glob.h:223
void deref2_eval ( ptr_psi_term  t)

deref2_eval

Parameters
ptr_psi_termt

Definition at line 1356 of file lefun.c.

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

1357 {
1358  deref_ptr(t);
1359  if (t->status==0) {
1360  if (t->type->type_def==(def_type)function_it) {
1361  check_func(t);
1362  }
1363  else
1364  if(t->type->type_def==(def_type)global) { /* RM: Feb 10 1993 */
1365  eval_global_var(t);
1366  deref_ptr(t);/* RM: Jun 25 1993 */
1367  deref2_eval(t);
1368  }
1369  else {
1370  t->status=4;
1371  }
1372  }
1373 }
#define function_it
Definition: def_const.h:362
void deref2_eval(ptr_psi_term t)
deref2_eval
Definition: lefun.c:1356
void eval_global_var(ptr_psi_term t)
eval_global_var
Definition: lefun.c:1440
#define global
Definition: def_const.h:364
def_type type_def
Definition: def_struct.h:133
#define deref_ptr(P)
Definition: def_macro.h:95
void check_func(ptr_psi_term t)
check_func
Definition: lefun.c:928
ptr_definition type
Definition: def_struct.h:165
void deref2_rec_eval ( ptr_psi_term  t)

deref2_rec_eval

Parameters
ptr_psi_termt

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().

1383 {
1384  deref_ptr(t);
1385  deref_rec_body(t);
1386 }
#define deref_ptr(P)
Definition: def_macro.h:95
void deref_rec_body(ptr_psi_term t)
deref_rec_body
Definition: lefun.c:1243
long deref_args_eval ( ptr_psi_term  t,
long  set 
)

deref_args_eval

Parameters
ptr_psi_termt
longset

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.

1295 {
1296  ptr_goal save = goal_stack;
1297  ptr_goal top_loc = aim;
1298 
1299  deref_flag = FALSE;
1300  goal_stack = top_loc;
1301  deref_rec_args_exc(t->attr_list,set);
1302  if (!deref_flag) goal_stack = save;
1303  return (deref_flag);
1304 }
ptr_goal goal_stack
Definition: def_glob.h:50
static long deref_flag
Definition: lefun.c:1166
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
void deref_rec_args_exc(ptr_node n, long set)
deref_rec_args_exc
Definition: lefun.c:1332
ptr_node attr_list
Definition: def_struct.h:171
long deref_eval ( ptr_psi_term  t)

deref_eval

Parameters
ptr_psi_termt

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, goal_stack, heap_pointer, int_ptr, push_ptr_value(), wl_psi_term::status, TRUE, wl_psi_term::type, and wl_definition::type_def.

1181 {
1182  ptr_goal save=goal_stack;
1183 
1184  deref_flag=FALSE;
1185  goal_stack=aim;
1186 
1187  if (t->status==0) {
1188  if(t->type->type_def==(def_type)function_it) {
1189  check_func(t); /* Push eval goals to evaluate the function. */
1190  deref_flag=TRUE; /* TRUE so that caller will return to main_prove. */
1191  }
1192  else
1193  if(t->type->type_def==(def_type)global) { /* RM: Feb 10 1993 */
1194  eval_global_var(t);
1195  deref_ptr(t);/* RM: Jun 25 1993 */
1197  }
1198  else {
1199  if (((long)t->status)!=2) {
1200  if((GENERIC)t<heap_pointer)
1201  push_ptr_value(int_ptr,(GENERIC *)&(t->status)); /* RM: Jul 15 1993 */
1202  t->status=4;
1203  deref_flag=FALSE;
1204  }
1205  }
1206  }
1207  else
1208  deref_flag=FALSE;
1209 
1210  if (!deref_flag) goal_stack=save;
1211  return (deref_flag);
1212 }
#define function_it
Definition: def_const.h:362
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
long deref_eval(ptr_psi_term t)
deref_eval
Definition: lefun.c:1180
void eval_global_var(ptr_psi_term t)
eval_global_var
Definition: lefun.c:1440
ptr_goal goal_stack
Definition: def_glob.h:50
static long deref_flag
Definition: lefun.c:1166
#define global
Definition: def_const.h:364
def_type type_def
Definition: def_struct.h:133
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
void check_func(ptr_psi_term t)
check_func
Definition: lefun.c:928
ptr_goal aim
Definition: def_glob.h:49
GENERIC heap_pointer
Definition: def_glob.h:12
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
#define int_ptr
Definition: def_const.h:172
void deref_rec_args ( ptr_node  n)

deref_rec_args

Parameters
ptr_noden

Definition at line 1272 of file lefun.c.

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

1273 {
1274  ptr_psi_term t1;
1275 
1276  if (n) {
1277  deref_rec_args(n->right);
1278  t1 = (ptr_psi_term) (n->data);
1279  deref_ptr(t1);
1280  deref_rec_body(t1);
1281  deref_rec_args(n->left);
1282  }
1283 }
void deref_rec_args(ptr_node n)
deref_rec_args
Definition: lefun.c:1272
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void deref_rec_body(ptr_psi_term t)
deref_rec_body
Definition: lefun.c:1243
ptr_node right
Definition: def_struct.h:184
void deref_rec_args_exc ( ptr_node  n,
long  set 
)

deref_rec_args_exc

Parameters
ptr_noden
longset

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.

1333 {
1334  ptr_psi_term t;
1335 
1336  if (n) {
1337  deref_rec_args_exc(n->right,set);
1338  if (!in_set(n->key,set)) {
1339  t = (ptr_psi_term) (n->data);
1340  deref_ptr(t);
1341  deref_rec_body(t);
1342  }
1343  deref_rec_args_exc(n->left,set);
1344  }
1345 }
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
char * key
Definition: def_struct.h:182
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void deref_rec_body(ptr_psi_term t)
deref_rec_body
Definition: lefun.c:1243
void deref_rec_args_exc(ptr_node n, long set)
deref_rec_args_exc
Definition: lefun.c:1332
long in_set(char *str, long set)
in_set
Definition: lefun.c:1316
ptr_node right
Definition: def_struct.h:184
void deref_rec_body ( ptr_psi_term  t)

deref_rec_body

Parameters
ptr_psi_termt

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, heap_pointer, int_ptr, push_ptr_value(), wl_psi_term::status, TRUE, wl_psi_term::type, and wl_definition::type_def.

1244 {
1245  if (t->status==0) {
1246  if (t->type->type_def==(def_type)function_it) {
1247  check_func(t);
1248  deref_flag=TRUE;
1249  }
1250  else
1251  if(t->type->type_def==(def_type)global) { /* RM: Feb 10 1993 */
1252  eval_global_var(t);
1253  deref_ptr(t);/* RM: Jun 25 1993 */
1254  deref_rec_body(t);
1255  }
1256  else {
1257  /* if (t->status!=2) Tried adding this -- PVR 9.2.94 */
1258  if((GENERIC)t<heap_pointer)
1259  push_ptr_value(int_ptr,(GENERIC *)&(t->status));/* RM: Jul 15 1993 */
1260  t->status=4;
1262  }
1263  }
1264 }
#define function_it
Definition: def_const.h:362
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
void eval_global_var(ptr_psi_term t)
eval_global_var
Definition: lefun.c:1440
void deref_rec_args(ptr_node n)
deref_rec_args
Definition: lefun.c:1272
static long deref_flag
Definition: lefun.c:1166
#define global
Definition: def_const.h:364
def_type type_def
Definition: def_struct.h:133
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
void check_func(ptr_psi_term t)
check_func
Definition: lefun.c:928
GENERIC heap_pointer
Definition: def_glob.h:12
void deref_rec_body(ptr_psi_term t)
deref_rec_body
Definition: lefun.c:1243
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
#define int_ptr
Definition: def_const.h:172
long deref_rec_eval ( ptr_psi_term  t)

deref_rec_eval

Parameters
ptr_psi_termt

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.

1227 {
1228  ptr_goal save=goal_stack;
1229 
1230  deref_flag=FALSE;
1231  goal_stack=aim;
1232  deref_rec_body(t);
1233  if (!deref_flag) goal_stack=save;
1234  return (deref_flag);
1235 }
ptr_goal goal_stack
Definition: def_glob.h:50
static long deref_flag
Definition: lefun.c:1166
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
void deref_rec_body(ptr_psi_term t)
deref_rec_body
Definition: lefun.c:1243
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.

384 {
385  ptr_psi_term funct,result;
386 
387  /* PVR 5.11 undo(resid_limit); */
388  /* PVR 5.11 choice_stack=cut_point; */
390  funct=(ptr_psi_term )resid_aim->aaaa_1;
391  result=(ptr_psi_term )resid_aim->bbbb_1;
392 
393  traceline("currying %P\n",funct);
394 
395  push_goal(unify_noeval,funct,result,NULL);
396  resid_aim=NULL;
397 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_goal goal_stack
Definition: def_glob.h:50
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
void traceline(char *format,...)
traceline
Definition: error.c:186
#define unify_noeval
Definition: def_const.h:275
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_goal next
Definition: def_struct.h:227
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.

337 {
338  long success;
339  ptr_psi_term t,u;
340  // ptr_goal *gs;
341 
342  /* This undoes perfectly valid work! */
343  /* The old version of Wild_Life did not trail anything
344  during matching, so I think this was a nop for it. */
345  /* PVR 11.5 undo(resid_limit); */
346  /* PVR 11.5 choice_stack=cut_point; */
347 
348  /* PVR 9.2.94 */
349  /* goal_stack=resid_aim->next; */
350 
351  if (trace) {
352  tracing();
354  }
355 
356  while (resid_vars) {
357 
358  t=resid_vars->var; /* 21.9 */
359  u=resid_vars->othervar; /* 21.9 */
360  /* PVR */ deref_ptr(t);
362  traceline("residuating on %P (other = %P)\n",t,u);
363 
364  success=residuateGoalOnVar(resid_aim, t, u); /* 21.9 */
365  if (!success) { /* 21.9 */
366  traceline("failure because of disentailment\n");
367  return FALSE;
368  }
369  }
370 
371  traceline("no failure because of disentailment\n");
372  return TRUE; /* 21.9 */
373 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void tracing()
tracing
Definition: error.c:678
ptr_resid_list next
Definition: def_struct.h:62
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_resid_list resid_vars
Definition: def_glob.h:221
long trace
Definition: def_glob.h:272
void traceline(char *format,...)
traceline
Definition: error.c:186
#define deref_ptr(P)
Definition: def_macro.h:95
void print_resid_message(ptr_psi_term t, ptr_resid_list r)
print_resid_message
Definition: print.c:1690
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_psi_term var
Definition: def_struct.h:60
ptr_psi_term othervar
Definition: def_struct.h:61
long residuateGoalOnVar(ptr_goal g, ptr_psi_term var, ptr_psi_term othervar)
residuateGoalOnVar
Definition: lefun.c:192
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.

325 {
326  goal_stack=resid_aim->next; /* reset goal stack */
327  return do_residuation();
328 }
long do_residuation()
do_residuation
Definition: lefun.c:336
ptr_goal goal_stack
Definition: def_glob.h:50
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_goal next
Definition: def_struct.h:227
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.

498 {
499  long success=TRUE;
500  ptr_psi_term funct,result,head,body;
501  ptr_pair_list rule;
502  /* RESID */ ptr_resid_block rb;
503  ptr_choice_point cutpt;
504  ptr_psi_term match_date; /* 13.6 */
505 
506  funct=(ptr_psi_term )aim->aaaa_1;
507  deref_ptr(funct);
508 
509  /* RM: Jun 18 1993 */
510  push2_ptr_value(int_ptr,(GENERIC *)&(funct->status),(GENERIC)(funct->status & SMASK));
511  funct->status=4;
512 
513  /* if (!funct->type->evaluate_args) mark_quote(funct); 25.8 */ /* 18.2 PVR */
514  result=(ptr_psi_term )aim->bbbb_1;
515  rule=(ptr_pair_list )aim->cccc_1;
516 
517  match_date=(ptr_psi_term )stack_pointer;
518  cutpt=choice_stack; /* 13.6 */
519 
520  /* For currying and residuation */
521  curried=FALSE;
522  can_curry=TRUE;
523  /* resid_aim=aim; */
525  /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
526 
527  if (rule) {
528  traceline("evaluate %P\n",funct);
529  if ((unsigned long)rule<=MAX_BUILT_INS) {
530 
531  resid_aim=aim;
532  success=c_rule[(unsigned long)rule]();
533 
534  if (curried)
535  do_currying();
536  else
537  if (resid_vars)
538  success=do_residuation(); /* 21.9 */
539  else {
540  /* resid_aim=NULL; */
541  }
542  }
543  else {
544  while (rule && (rule->aaaa_2==NULL || rule->bbbb_2==NULL)) {
545  rule=rule->next;
546  traceline("alternative rule has been retracted\n");
547  }
548  if (rule) {
549  /* push_choice_point(eval,funct,result,rule->next); */ /* 17.6 */
550 
551  resid_aim=aim;
552  /* RESID */ rb = STACK_ALLOC(resid_block);
553  /* RESID */ save_resid(rb,match_date);
554  /* RESID */ /* resid_aim = NULL; */
555 
556  clear_copy();
557 
558  /* RM: Jun 18 1993: no functions in head */
559  /* if (TRUE)
560  head=eval_copy(rule->aaaa_1,STACK);
561  else */
562 
563  head=quote_copy(rule->aaaa_2,STACK);
564  body=eval_copy(rule->bbbb_2,STACK);
565  head->status=4;
566 
567  if (rule->next) /* 17.6 */
568  push_choice_point(eval,funct,result,(GENERIC)rule->next);
569 
570  push_goal(unify,body,result,NULL);
571  /* RESID */ push_goal(eval_cut,body,(ptr_psi_term)cutpt,(GENERIC)rb); /* 13.6 */
572  /* RESID */ push_goal(match,funct,head,(GENERIC)rb);
573  /* eval_args(head->attr_list); */
574  }
575  else {
576  success=FALSE;
577  /* resid_aim=NULL; */
578  }
579  }
580  }
581  else {
582  success=FALSE;
583  /* resid_aim=NULL; */
584  }
585  resid_aim=NULL;
586  /* match_date=NULL; */ /* 13.6 */
587  return success;
588 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_psi_term aaaa_2
Definition: def_struct.h:189
long do_residuation()
do_residuation
Definition: lefun.c:336
void clear_copy()
clear_copy
Definition: copy.c:53
void push2_ptr_value(type_ptr t, GENERIC *p, GENERIC v)
push2_ptr_value
Definition: login.c:573
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_choice_point
Definition: login.c:638
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
ptr_pair_list next
Definition: def_struct.h:191
GENERIC cccc_1
Definition: def_struct.h:226
long(* c_rule[MAX_BUILT_INS])()
Definition: def_glob.h:247
void do_currying()
do_currying
Definition: lefun.c:383
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_resid_list resid_vars
Definition: def_glob.h:221
#define eval
Definition: def_const.h:278
void traceline(char *format,...)
traceline
Definition: error.c:186
ptr_psi_term quote_copy(ptr_psi_term t, long heap_flag)
quote_copy
Definition: copy.c:186
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define match
Definition: def_const.h:283
#define FALSE
Definition: def_const.h:128
ptr_psi_term bbbb_2
Definition: def_struct.h:190
ptr_goal aim
Definition: def_glob.h:49
#define STACK_ALLOC(A)
Definition: def_macro.h:16
#define unify
Definition: def_const.h:274
long can_curry
Definition: def_glob.h:224
long curried
Definition: def_glob.h:223
#define eval_cut
Definition: def_const.h:279
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void save_resid(ptr_resid_block rb, ptr_psi_term match_date)
save_resid
Definition: lefun.c:1398
#define MAX_BUILT_INS
Definition: def_const.h:82
GENERIC stack_pointer
Definition: def_glob.h:14
ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
eval_copy
Definition: copy.c:196
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
#define SMASK
Definition: def_const.h:160
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define STACK
Definition: def_const.h:148
#define int_ptr
Definition: def_const.h:172
long eval_args ( ptr_node  n)

eval_args

Parameters
ptr_noden

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.

890 {
891  long flag=TRUE;
892 
893  if (n) {
894  flag = eval_args(n->right);
895  flag = check_out((ptr_psi_term)n->data) && flag;
896  flag = eval_args(n->left) && flag;
897  }
898 
899  return flag;
900 }
long eval_args(ptr_node n)
eval_args
Definition: lefun.c:889
long check_out(ptr_psi_term t)
Definition: lefun.c:1083
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define TRUE
Definition: def_const.h:127
ptr_node right
Definition: def_struct.h:184
void eval_global_var ( ptr_psi_term  t)

eval_global_var

Parameters
ptr_psi_termt

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, 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.

1441 {
1442  deref_ptr(t);
1443 
1444  /* Global variable (not persistent) */
1445 
1446  traceline("dereferencing variable %P\n",t);
1447 
1448  /* Trails the heap RM: Nov 10 1993 */
1449  if(!t->type->global_value) {
1450 
1451  /* Trail the heap !! */
1452  {
1453  ptr_stack n;
1454  n=STACK_ALLOC(stack);
1455  n->type=psi_term_ptr;
1456  n->aaaa_3= (GENERIC *) &(t->type->global_value);
1457  n->bbbb_3= (GENERIC *) NULL;
1458  n->next=undo_stack;
1459  undo_stack=n;
1460  }
1461 
1462 
1463  clear_copy();
1465 
1466  }
1467 
1468  /* var_occurred=TRUE; RM: Feb 4 1994 */
1469 
1470  if(t->type->type_def==(def_type)global && t!=t->type->global_value) {
1471  /*traceline("dereferencing variable %P\n",t);*/
1472  push_psi_ptr_value(t,(GENERIC *)&(t->coref));
1473  t->coref=t->type->global_value;
1474  }
1475 }
ptr_psi_term init_value
Definition: def_struct.h:142
void clear_copy()
clear_copy
Definition: copy.c:53
#define global
Definition: def_const.h:364
GENERIC * bbbb_3
Definition: def_struct.h:218
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
def_type type_def
Definition: def_struct.h:133
#define NULL
Definition: def_const.h:203
void traceline(char *format,...)
traceline
Definition: error.c:186
ptr_stack undo_stack
Definition: def_glob.h:53
#define deref_ptr(P)
Definition: def_macro.h:95
type_ptr type
Definition: def_struct.h:216
ptr_psi_term global_value
Definition: def_struct.h:141
ptr_psi_term coref
Definition: def_struct.h:172
#define STACK_ALLOC(A)
Definition: def_macro.h:16
GENERIC * aaaa_3
Definition: def_struct.h:217
ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
eval_copy
Definition: copy.c:196
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
#define STACK
Definition: def_const.h:148
#define psi_term_ptr
Definition: def_const.h:170
long f_check_out ( ptr_psi_term  t)

f_check_out

Parameters
ptr_psi_termt
  • f_check_out(t) checks out functions too.

Definition at line 1046 of file lefun.c.

References check_func_flag, check_out(), and TRUE.

1048 {
1050  return check_out(t);
1051 }
long check_out(ptr_psi_term t)
Definition: lefun.c:1083
#define TRUE
Definition: def_const.h:127
static long check_func_flag
Definition: lefun.c:13
ptr_psi_term heap_psi_term ( long  stat)

heap_psi_term

Parameters
longstat

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.

76 {
77  ptr_psi_term result;
78 
79  result=HEAP_ALLOC(psi_term);
80  result->type=top;
81  result->status=stat;
82  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
83  result->attr_list=NULL;
84  result->coref=NULL;
85 #ifdef TS
86  result->time_stamp=global_time_stamp; /* 9.6 */
87 #endif
88  result->resid=NULL;
89  result->value_3=NULL;
90 
91  return result;
92 }
ptr_residuation resid
Definition: def_struct.h:173
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term coref
Definition: def_struct.h:172
unsigned long global_time_stamp
Definition: login.c:28
ptr_definition type
Definition: def_struct.h:165
#define QUOTED_TRUE
Definition: def_const.h:123
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_node attr_list
Definition: def_struct.h:171
long i_check_out ( ptr_psi_term  t)

i_check_out

Parameters
ptr_psi_termt
  • 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.

1034 {
1036  return check_out(t);
1037 }
long check_out(ptr_psi_term t)
Definition: lefun.c:1083
#define FALSE
Definition: def_const.h:128
static long check_func_flag
Definition: lefun.c:13
long i_eval_args ( ptr_node  n)

i_eval_args

Parameters
ptr_noden

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.

875 {
877  return eval_args(n);
878 }
long eval_args(ptr_node n)
eval_args
Definition: lefun.c:889
#define FALSE
Definition: def_const.h:128
static long check_func_flag
Definition: lefun.c:13
long in_set ( char *  str,
long  set 
)

in_set

Parameters
char*str
longset

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.

1317 {
1318  if (set&1 && !featcmp(str,"1")) return TRUE;
1319  if (set&2 && !featcmp(str,"2")) return TRUE;
1320  if (set&4 && !featcmp(str,"3")) return TRUE;
1321  if (set&8 && !featcmp(str,"4")) return TRUE;
1322  return FALSE;
1323 }
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
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.

1486 {
1487  ptr_definition def;
1488 
1489  /* printf("initializing global vars...\n"); */
1490 
1491  /*
1492  for(def=first_definition;def;def=def->next) {
1493  if(def->type==global && ((GENERIC)def->global_value<heap_pointer)) {
1494  clear_copy();
1495  def->global_value=eval_copy(def->init_value,STACK);
1496  }
1497  }
1498  */
1499 
1500  for(def=first_definition;def;def=def->next)
1502  def->global_value=NULL;
1503 }
#define NULL
Definition: def_const.h:203
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_psi_term global_value
Definition: def_struct.h:141
GENERIC heap_pointer
Definition: def_glob.h:12
unsigned long * GENERIC
Definition: def_struct.h:17
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.

771 {
772  long success=TRUE;
773  ptr_psi_term u,v; // ,tmp;
774  REAL r;
775  long /* less, */ lesseq;
776  ptr_resid_block rb;
777  ptr_psi_term match_date;
778 
779  u=(ptr_psi_term )aim->aaaa_1;
780  v=(ptr_psi_term )aim->bbbb_1;
781  deref_ptr(u);
782  deref_ptr(v);
784  restore_resid(rb,&match_date);
785 
786  if (u!=v) {
787  if ((success=matches(u->type,v->type,&lesseq))) {
788  if (lesseq) {
789  if (u->type!=cut || v->type!=cut) { /* Ignore value field for cut! */
790  if (v->value_3) {
791  if (u->value_3) {
792  if (overlap_type(v->type,real))
793  success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
794  else if (overlap_type(v->type,quoted_string))
795  success=(strcmp((char *)u->value_3,(char *)v->value_3)==0);
796  /* DENYS: BYTEDATA */
797  else if (overlap_type(v->type,sys_bytedata)) {
798  unsigned long ulen = *((unsigned long *) u->value_3);
799  unsigned long vlen = *((unsigned long *) v->value_3);
800  success=(ulen==vlen && bcmp((char *)u->value_3,(char *)v->value_3,ulen)==0);
801  }
802  }
803  else
804  residuate_double(u,v);
805  }
806  }
807  }
808  else if (u->value_3) {
809  /* Here we have U <| V but U and V have values which cannot match. */
810  success=TRUE;
811 
812  if (v->value_3) {
813  if (overlap_type(v->type,real))
814  success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
815  }
816  else if (overlap_type(u->type,integer)) {
817  r= *((REAL *)u->value_3);
818  success=(r==floor(r));
819  }
820 
821  if (success) residuate_double(u,v);
822  }
823  else
824  residuate_double(u,v);
825 
826  if (success) {
827  if (FUNC_ARG(u) && FUNC_ARG(v)) { /* RM: Feb 10 1993 */
828  /* residuate2(u,v); 21.9 */
829  residuate_double(u,v); /* 21.9 */
830  residuate_double(v,u); /* 21.9 */
831  }
832  else if (FUNC_ARG(v)) { /* RM: Feb 10 1993 */
833  residuate_double(v,u); /* 21.9 */
834  }
835  else {
836  v->coref=u;
837  } /* 21.9 */
839  match_attr(&(u->attr_list),v->attr_list,rb);
840  if (attr_missing) {
841  if (can_curry)
842  curried=TRUE;
843  else
844  residuate_double(u,v);
845  }
846  /* } 21.9 */
847  }
848  }
849  }
850 
852  save_resid(rb,match_date); /* updated resid_block */
853  /* This should be a useless statement: */
854  resid_aim = NULL;
855 
856  return success;
857 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
struct wl_resid_block * ptr_resid_block
Definition: def_struct.h:244
static long attr_missing
Definition: lefun.c:12
GENERIC cccc_1
Definition: def_struct.h:226
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
matches
Definition: types.c:1666
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
#define REAL
Definition: def_const.h:72
void residuate_double(ptr_psi_term t, ptr_psi_term u)
residuate_double
Definition: lefun.c:107
ptr_definition real
Definition: def_glob.h:102
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition integer
Definition: def_glob.h:93
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
ptr_psi_term coref
Definition: def_struct.h:172
long can_curry
Definition: def_glob.h:224
#define FUNC_ARG(t)
Definition: def_macro.h:26
ptr_definition sys_bytedata
Definition: def_glob.h:336
long curried
Definition: def_glob.h:223
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void save_resid(ptr_resid_block rb, ptr_psi_term match_date)
save_resid
Definition: lefun.c:1398
ptr_definition cut
Definition: def_glob.h:83
void match_attr(ptr_node *u, ptr_node v, ptr_resid_block rb)
match_attr
Definition: lefun.c:752
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
void restore_resid(ptr_resid_block rb, ptr_psi_term *match_date)
restore_resid
Definition: lefun.c:1417
void match_attr ( ptr_node u,
ptr_node  v,
ptr_resid_block  rb 
)

match_attr

Parameters
ptr_node*u
ptr_nodev
ptr_resid_blockrb

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().

753 {
754  match_attr1(u,v,rb); /* Match corresponding arguments (third) */
755  match_attr2(u,v,rb); /* Evaluate lone arguments (second) */
756  match_attr3(u,v,rb); /* Evaluate corresponding arguments (first) */
757 }
void match_attr2(ptr_node *u, ptr_node v, ptr_resid_block rb)
match_attr2
Definition: lefun.c:644
void match_attr1(ptr_node *u, ptr_node v, ptr_resid_block rb)
void match_attr1
Definition: lefun.c:599
void match_attr3(ptr_node *u, ptr_node v, ptr_resid_block rb)
match_attr3
Definition: lefun.c:700
void match_attr1 ( ptr_node u,
ptr_node  v,
ptr_resid_block  rb 
)

void match_attr1

Parameters
ptr_node*u
ptr_nodev
ptr_resid_blockrb

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.

600 {
601  long cmp;
602  ptr_node temp;
603 
604  if (v) {
605  if (*u==NULL)
607  else {
608  cmp=featcmp((*u)->key,v->key);
609  if(cmp==0) {
610  ptr_psi_term t;
611  /* RESID */ match_attr1(&((*u)->right),v->right,rb);
612  t = (ptr_psi_term) (*u)->data;
613  /* RESID */ push_goal(match,(ptr_psi_term)(*u)->data,(ptr_psi_term)v->data,(GENERIC)rb);
614  /* deref2_eval(t); */
615  /* RESID */ match_attr1(&((*u)->left),v->left,rb);
616  }
617  else if (cmp>0) {
618  temp=v->right;
619  v->right=NULL;
620  /* RESID */ match_attr1(u,temp,rb);
621  /* RESID */ match_attr1(&((*u)->left),v,rb);
622  v->right=temp;
623  }
624  else {
625  temp=v->left;
626  v->left=NULL;
627  /* RESID */ match_attr1(&((*u)->right),v,rb);
628  /* RESID */ match_attr1(u,temp,rb);
629  v->left=temp;
630  }
631  }
632  }
633 }
static long attr_missing
Definition: lefun.c:12
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
#define TRUE
Definition: def_const.h:127
#define match
Definition: def_const.h:283
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
void match_attr1(ptr_node *u, ptr_node v, ptr_resid_block rb)
void match_attr1
Definition: lefun.c:599
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node right
Definition: def_struct.h:184
void match_attr2 ( ptr_node u,
ptr_node  v,
ptr_resid_block  rb 
)

match_attr2

Parameters
ptr_node*u
ptr_nodev
ptr_resid_blockrb

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.

645 {
646  long cmp;
647  ptr_node temp;
648 
649  if (v) {
650  if (*u==NULL) { /* PVR 12.03 */
651  ptr_psi_term t;
652  match_attr1(u,v->right,rb);
653  t = (ptr_psi_term) v->data;
654  deref2_rec_eval(t);
655  match_attr1(u,v->left,rb);
656  }
657  else {
658  cmp=featcmp((*u)->key,v->key);
659  if(cmp==0) {
660  /* RESID */ match_attr2(&((*u)->right),v->right,rb);
661  /* RESID */ match_attr2(&((*u)->left),v->left,rb);
662  }
663  else if (cmp>0) {
664  temp=v->right;
665  v->right=NULL;
666  /* RESID */ match_attr2(u,temp,rb);
667  /* RESID */ match_attr2(&((*u)->left),v,rb);
668  v->right=temp;
669  }
670  else {
671  temp=v->left;
672  v->left=NULL;
673  /* RESID */ match_attr2(&((*u)->right),v,rb);
674  /* RESID */ match_attr2(u,temp,rb);
675  v->left=temp;
676  }
677  }
678  }
679  else if (*u!=NULL) {
680  ptr_psi_term t /* , empty */ ;
681  match_attr1(&((*u)->right),v,rb);
682  t = (ptr_psi_term) (*u)->data;
683  /* Create a new psi-term to put the (useless) result: */
684  /* This is needed so that *all* arguments of a function call */
685  /* are evaluated, which avoids incorrect 'Yes' answers. */
686  deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
687  match_attr1(&((*u)->left),v,rb);
688  }
689 }
void match_attr2(ptr_node *u, ptr_node v, ptr_resid_block rb)
match_attr2
Definition: lefun.c:644
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
void match_attr1(ptr_node *u, ptr_node v, ptr_resid_block rb)
void match_attr1
Definition: lefun.c:599
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void deref2_rec_eval(ptr_psi_term t)
deref2_rec_eval
Definition: lefun.c:1382
ptr_node right
Definition: def_struct.h:184
void match_attr3 ( ptr_node u,
ptr_node  v,
ptr_resid_block  rb 
)

match_attr3

Parameters
ptr_node*u
ptr_nodev
ptr_resid_blockrb

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.

701 {
702  long cmp;
703  ptr_node temp;
704 
705  if (v) {
706  if (*u==NULL)
708  else {
709  cmp=featcmp((*u)->key,v->key);
710  if(cmp==0) {
711  ptr_psi_term t1,t2;
712  /* RESID */ match_attr3(&((*u)->right),v->right,rb);
713  t1 = (ptr_psi_term) (*u)->data;
714  t2 = (ptr_psi_term) v->data;
715  /* RESID */ /* push_goal(match,(*u)->data,v->data,rb); */
716  deref2_eval(t1); /* Assumes goal_stack is already restored. */
717  deref2_eval(t2); /* PVR 12.03 */
718  /* RESID */ match_attr3(&((*u)->left),v->left,rb);
719  }
720  else if (cmp>0) {
721  temp=v->right;
722  v->right=NULL;
723  /* RESID */ match_attr3(u,temp,rb);
724  /* RESID */ match_attr3(&((*u)->left),v,rb);
725  v->right=temp;
726  }
727  else {
728  temp=v->left;
729  v->left=NULL;
730  /* RESID */ match_attr3(&((*u)->right),v,rb);
731  /* RESID */ match_attr3(u,temp,rb);
732  v->left=temp;
733  }
734  }
735  }
736 }
void deref2_eval(ptr_psi_term t)
deref2_eval
Definition: lefun.c:1356
static long attr_missing
Definition: lefun.c:12
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
#define TRUE
Definition: def_const.h:127
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void match_attr3(ptr_node *u, ptr_node v, ptr_resid_block rb)
match_attr3
Definition: lefun.c:700
ptr_node right
Definition: def_struct.h:184
ptr_psi_term real_stack_psi_term ( long  stat,
REAL  thereal 
)

real_stack_psi_term

Parameters
longstat 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.

49 {
50  ptr_psi_term result;
51 
52  result=STACK_ALLOC(psi_term);
53  result->type = (thereal==floor(thereal)) ? integer : real;
54  result->status=stat;
55  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
56  result->attr_list=NULL;
57  result->coref=NULL;
58 #ifdef TS
59  result->time_stamp=global_time_stamp; /* 9.6 */
60 #endif
61  result->resid=NULL;
62  result->value_3=heap_alloc(sizeof(REAL));
63  (* (REAL *)(result->value_3)) = thereal;
64 
65  return result;
66 }
ptr_residuation resid
Definition: def_struct.h:173
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
ptr_definition real
Definition: def_glob.h:102
ptr_definition integer
Definition: def_glob.h:93
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term coref
Definition: def_struct.h:172
#define STACK_ALLOC(A)
Definition: def_macro.h:16
unsigned long global_time_stamp
Definition: login.c:28
ptr_definition type
Definition: def_struct.h:165
#define QUOTED_TRUE
Definition: def_const.h:123
ptr_node attr_list
Definition: def_struct.h:171
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
void release_resid ( ptr_psi_term  t)

release_resid

Parameters
ptr_psi_termt

Definition at line 445 of file lefun.c.

References release_resid_main(), and TRUE.

446 {
448 }
#define TRUE
Definition: def_const.h:127
void release_resid_main(ptr_psi_term t, long trailflag)
release_resid_main
Definition: lefun.c:411
void release_resid_main ( ptr_psi_term  t,
long  trailflag 
)

release_resid_main

Parameters
ptr_psi_termt
longtrailflag

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().

412 {
413  ptr_goal g;
414  ptr_residuation r;
415 
416  if ((r=t->resid)) {
417  if (trailflag) push_ptr_value(resid_ptr,(GENERIC *)&(t->resid));
418  t->resid=NULL;
419 
420  while (r) {
421  g=r->goal;
422  if (g->pending) {
423 
425  g->pending=FALSE;
426 
428 
429  g->next=goal_stack;
430  goal_stack=g;
431 
432  traceline("releasing %P\n",g->aaaa_1);
433  }
434  r=r->next;
435  }
436  }
437 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_residuation resid
Definition: def_struct.h:173
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
ptr_goal goal_stack
Definition: def_glob.h:50
ptr_goal goal
Definition: def_struct.h:156
ptr_residuation next
Definition: def_struct.h:157
#define NULL
Definition: def_const.h:203
void traceline(char *format,...)
traceline
Definition: error.c:186
#define FALSE
Definition: def_const.h:128
unsigned long * GENERIC
Definition: def_struct.h:17
#define resid_ptr
Definition: def_const.h:171
#define goal_ptr
Definition: def_const.h:175
ptr_definition pending
Definition: def_struct.h:228
ptr_goal next
Definition: def_struct.h:227
#define int_ptr
Definition: def_const.h:172
void release_resid_notrail ( ptr_psi_term  t)

release_resid_notrail

Parameters
ptr_psi_termt

Definition at line 456 of file lefun.c.

References FALSE, and release_resid_main().

458 {
460 }
#define FALSE
Definition: def_const.h:128
void release_resid_main(ptr_psi_term t, long trailflag)
release_resid_main
Definition: lefun.c:411
void residuate ( ptr_psi_term  t)

residuate

Parameters
ptr_psi_termt

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.

126 {
127  ptr_resid_list curr;
128 
129  curr=STACK_ALLOC(resid_list);
130  curr->var=t;
131  curr->othervar=NULL; /* 21.9 */
132  curr->next=resid_vars;
133  resid_vars=curr;
134 }
ptr_resid_list next
Definition: def_struct.h:62
#define NULL
Definition: def_const.h:203
ptr_resid_list resid_vars
Definition: def_glob.h:221
ptr_psi_term var
Definition: def_struct.h:60
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_psi_term othervar
Definition: def_struct.h:61
void residuate2 ( ptr_psi_term  u,
ptr_psi_term  v 
)

residuate2

Parameters
ptr_psi_termu
ptr_psi_termv

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

Definition at line 144 of file lefun.c.

References residuate().

145 {
146  residuate(u);
147  if (v && u!=v) residuate(v);
148 }
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void residuate3 ( ptr_psi_term  u,
ptr_psi_term  v,
ptr_psi_term  w 
)

residuate3

Parameters
ptr_psi_termu
ptr_psi_termv
ptr_psi_termw

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

Definition at line 159 of file lefun.c.

References residuate().

160 {
161  residuate(u);
162  if (v && u!=v) residuate(v);
163  if (w && u!=w && v!=w) residuate(w);
164 }
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void residuate_double ( ptr_psi_term  t,
ptr_psi_term  u 
)

residuate_double

Parameters
ptr_psi_termt 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.

108 {
109  ptr_resid_list curr;
110 
111  curr=STACK_ALLOC(resid_list);
112  curr->var=t;
113  curr->othervar=u;
114  curr->next=resid_vars;
115  resid_vars=curr;
116 }
ptr_resid_list next
Definition: def_struct.h:62
ptr_resid_list resid_vars
Definition: def_glob.h:221
ptr_psi_term var
Definition: def_struct.h:60
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_psi_term othervar
Definition: def_struct.h:61
long residuateGoalOnVar ( ptr_goal  g,
ptr_psi_term  var,
ptr_psi_term  othervar 
)

residuateGoalOnVar

Parameters
ptr_goalg
ptr_psi_termvar
ptr_psi_termothervar

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.

193 {
194  long result;
195  long resflag,resflag2;
196  GENERIC rescode,rescode2;
197  GENERIC resvalue;
198  GENERIC resvalue2;
199  /* Set to FALSE if the goal is already residuated on the var: */
200  long not_found = TRUE;
201  /* Points to a pointer to a residuation structure. Used so we can */
202  /* add the goal to the end of the residuation list, so that it can */
203  /* can be undone later if backtracking happens. See the call to */
204  /* push_ptr_value. */
205  ptr_residuation *r;
206 
207  /* 5.8 PVR */
208  if ((GENERIC)var>=heap_pointer) {
209  Errorline("attempt to residuate on psi-term %P in the heap.\n",var);
210 
211  return FALSE;
212  }
213 
214  r= &(var->resid);
215 
216  while (not_found && *r) {
217  if ((*r)->goal == g) { /* This goal is already attached */
218  /* Keep track of best sort so far */
219  /* Glb_code(..) tries to keep 'sortflag' TRUE if possible. */
220  result=glb_code((*r)->sortflag,(*r)->bestsort,
221  TRUE,(GENERIC)var->type,
222  &resflag,&rescode);
223  result=glb_value(result,resflag,rescode,(GENERIC)(*r)->value_2,var->value_3,
224  &resvalue); /* 6.10 */
225  if (!result)
226  return FALSE; /* 21.9 */
227  else if (othervar) {
228  result=glb_code(resflag,rescode,TRUE,(GENERIC)othervar->type,
229  &resflag2,&rescode2);
230  result=glb_value(result,resflag2,rescode2,resvalue,othervar->value_3,
231  &resvalue2); /* 6.10 */
232  if (!result) {
233  return FALSE;
234  }
235  else {
236  /* The value field only has to be trailed once, since its value */
237  /* does not change, once given. */
238  if ((*r)->value_2==NULL && resvalue2!=NULL) { /* 6.10 */
239  push_ptr_value(int_ptr,(GENERIC *)&((*r)->value_2));
240  }
241  if ((*r)->bestsort!=rescode2) {
242  push_ptr_value(((*r)->sortflag?def_ptr:code_ptr),
243  &((*r)->bestsort));
244  (*r)->bestsort=rescode2; /* 21.9 */
245  }
246  if ((*r)->sortflag!=resflag2) {
247  push_ptr_value(int_ptr,(GENERIC *)&((*r)->sortflag));
248  (*r)->sortflag=resflag2; /* 21.9 */
249  }
250  }
251  }
252  else {
253  if ((*r)->value_2==NULL && resvalue!=NULL) { /* 6.10 */
254  push_ptr_value(int_ptr,(GENERIC *)&((*r)->value_2));
255  }
256  if ((*r)->bestsort!=rescode) {
257  push_ptr_value(((*r)->sortflag?def_ptr:code_ptr),
258  &((*r)->bestsort));
259  (*r)->bestsort=rescode; /* 21.9 */
260  }
261  if ((*r)->sortflag!=resflag) {
262  push_ptr_value(int_ptr,(GENERIC *)&((*r)->sortflag));
263  (*r)->sortflag=resflag; /* 21.9 */
264  }
265  }
266  not_found = FALSE;
267  }
268  else
269  r= &((*r)->next); /* look at the next one */
270  }
271 
272  if (not_found) {
273  /* We must attach this goal & the variable's sort onto this variable */
274 
277  if (othervar) {
278  result=glb_code(TRUE,(GENERIC)var->type,TRUE,(GENERIC)othervar->type,&resflag,&rescode);
279  result=glb_value(result,resflag,rescode,var->value_3,othervar->value_3,
280  &resvalue); /* 6.10 */
281  if (!result) {
282  return FALSE;
283  }
284  else {
285  (*r)->sortflag=resflag;
286  (*r)->bestsort=rescode; /* 21.9 */
287  (*r)->value_2=resvalue; /* 6.10 */
288  }
289  }
290  else {
291  (*r)->sortflag=TRUE;
292  (*r)->bestsort=(GENERIC)var->type; /* 21.9 */
293  (*r)->value_2=var->value_3; /* 6.10 */
294  }
295  (*r)->goal=g;
296  (*r)->next=NULL;
297  }
298 
299  if (!(g->pending)) {
300  /* this goal is not pending, so make sure it will be put on the goal
301  * stack later
302  */
305  }
306 
307  return TRUE; /* 21.9 */
308 }
ptr_residuation resid
Definition: def_struct.h:173
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
long glb_value(long result, long f, GENERIC c, GENERIC value1, GENERIC value2, GENERIC *value)
glb_value
Definition: types.c:1290
#define def_ptr
Definition: def_const.h:173
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Errorline.
Definition: error.c:465
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define code_ptr
Definition: def_const.h:174
struct wl_definition * ptr_definition
Definition: def_struct.h:31
GENERIC value_3
Definition: def_struct.h:170
GENERIC heap_pointer
Definition: def_glob.h:12
#define STACK_ALLOC(A)
Definition: def_macro.h:16
long glb_code(long f1, GENERIC c1, long f2, GENERIC c2, long *f3, GENERIC *c3)
glb_code
Definition: types.c:1351
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
#define resid_ptr
Definition: def_const.h:171
ptr_definition pending
Definition: def_struct.h:228
ptr_goal next
Definition: def_struct.h:227
#define int_ptr
Definition: def_const.h:172
void restore_resid ( ptr_resid_block  rb,
ptr_psi_term match_date 
)

restore_resid

Parameters
ptr_resid_blockrb
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.

1418 {
1419  if (rb) {
1420  can_curry = (rb->cc_cr&2)?TRUE:FALSE; /* 11.9 */
1421  curried = (rb->cc_cr&1)?TRUE:FALSE; /* 11.9 */
1422  resid_aim = rb->ra;
1423  resid_vars = rb->rv;
1424  /* curried = rb->cr; 11.9 */
1425  /* can_curry = rb->cc; 11.9 */
1426  *match_date = rb->md;
1427  }
1428 }
ptr_goal ra
Definition: def_struct.h:248
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_resid_list resid_vars
Definition: def_glob.h:221
#define TRUE
Definition: def_const.h:127
ptr_psi_term md
Definition: def_struct.h:252
#define FALSE
Definition: def_const.h:128
long can_curry
Definition: def_glob.h:224
long curried
Definition: def_glob.h:223
ptr_resid_list rv
Definition: def_struct.h:251
void save_resid ( ptr_resid_block  rb,
ptr_psi_term  match_date 
)

save_resid

Parameters
ptr_resid_blockrb
ptr_psi_termmatch_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.

1399 {
1400  if (rb) {
1401  rb->cc_cr = (can_curry<<1) + curried; /* 11.9 */
1402  rb->ra = resid_aim;
1403  rb->rv = resid_vars;
1404  /* rb->cr = curried; 11.9 */
1405  /* rb->cc = can_curry; 11.9 */
1406  rb->md = match_date;
1407  }
1408 }
ptr_goal ra
Definition: def_struct.h:248
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_resid_list resid_vars
Definition: def_glob.h:221
ptr_psi_term md
Definition: def_struct.h:252
long can_curry
Definition: def_glob.h:224
long curried
Definition: def_glob.h:223
ptr_resid_list rv
Definition: def_struct.h:251
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.

22 {
23  ptr_psi_term result;
24 
25  result=STACK_ALLOC(psi_term);
26  result->type=top;
27  result->status=stat;
28  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
29  result->attr_list=NULL;
30  result->coref=NULL;
31 #ifdef TS
32  result->time_stamp=global_time_stamp; /* 9.6 */
33 #endif
34  result->resid=NULL;
35  result->value_3=NULL;
36 
37  return result;
38 }
ptr_residuation resid
Definition: def_struct.h:173
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term coref
Definition: def_struct.h:172
#define STACK_ALLOC(A)
Definition: def_macro.h:16
unsigned long global_time_stamp
Definition: login.c:28
ptr_definition type
Definition: def_struct.h:165
#define QUOTED_TRUE
Definition: def_const.h:123
ptr_node attr_list
Definition: def_struct.h:171

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.