Wild Life  2.29
 All Data Structures Files Functions Variables Typedefs Macros
Functions | Variables
lefun.c File Reference

Go to the source code of this file.

Functions

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

Variables

static long attr_missing
 
static long check_func_flag
 
static long deref_flag
 

Function Documentation

void append_resid ( ptr_psi_term  u,
ptr_psi_term  v 
)

Definition at line 434 of file lefun.c.

References push_ptr_value(), and resid_ptr.

436 {
437  ptr_residuation *g;
438 
439  g= &(u->resid);
440  while (*g)
441  g = &((*g)->next);
442 
444  *g=v->resid;
445 }
ptr_residuation resid
Definition: def_struct.h:173
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
unsigned long * GENERIC
Definition: def_struct.h:17
#define resid_ptr
Definition: def_const.h:171
void check_disj ( ptr_psi_term  t)

Definition at line 845 of file lefun.c.

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

847 {
848  traceline("push disjunction goal %P\n",t);
849  if (t->value_3)
850  push_goal(disj,t,t,(GENERIC)TRUE); /* 18.2 PVR */
851  else
853 }
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define NULL
Definition: def_const.h:203
void traceline(char *format,...)
Definition: error.c:157
#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)

Definition at line 861 of file lefun.c.

References check_func_flag, check_out(), copy(), disjunction, eval, eval_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.

863 {
864  ptr_psi_term result,t1,copy;
865 
866  /* Check for embedded definitions
867  RM: Dec 16 1992 Re-instated this check then disabled it again
868  if (resid_aim) {
869  Errorline("embedded functions appeared in %P.\n",resid_aim->aaaa_1);
870  fail_all();
871  }
872  else */ {
873 
874  traceline("setting up function call %P\n",t);
875  /* Create a psi-term to put the result */
876  result = stack_psi_term(0);
877 
878  /* Make a partial copy of the calling term */
879  copy=stack_copy_psi_term(*t);
880  copy->status &= ~RMASK;
881 
882  /* Bind the calling term to the result */
883  /* push_ptr_value(psi_term_ptr,(GENERIC *)&(t->coref)); */
884  push_psi_ptr_value(t,(GENERIC *)&(t->coref));
885  t->coref=result;
886 
887  /* Evaluate the copy of the calling term */
888  push_goal(eval,copy,result,(GENERIC)t->type->rule);
889 
890  /* Avoid evaluation for built-in functions with unevaluated arguments */
891  /* (cond and such_that) */
893  if (t->type==iff) {
894  get_one_arg(t->attr_list,&t1);
895  if (t1) {
896  /* mark_eval(t1); 24.8 */
897  (void)check_out(t1);
898  }
899  }
900  else if(t->type==disjunction) {
901  }
902  else if (t->type!=such_that) {
903  if (t->type->evaluate_args)
904  (void)eval_args(t->attr_list);
905  /* else mark_quote_tree(t->attr_list); 24.8 25.8 */
906  }
907  }
908 }
ptr_definition such_that
Definition: def_glob.h:105
long eval_args(ptr_node n)
Definition: lefun.c:826
char evaluate_args
Definition: def_struct.h:136
long check_out(ptr_psi_term t)
Definition: lefun.c:999
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
Definition: login.c:443
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define eval
Definition: def_const.h:278
void traceline(char *format,...)
Definition: error.c:157
#define TRUE
Definition: def_const.h:127
ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
Definition: copy.c:219
#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)
Definition: parser.c:183
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
static long check_func_flag
Definition: lefun.c:11
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 999 of file lefun.c.

References check_func(), check_func_flag, check_type(), deref_ptr, eval_args(), eval_global_var(), FALSE, function_it, global, heap_pointer, RMASK, traceline(), TRUE, and type_it.

1001 {
1002  long flag=FALSE;
1003  deref_ptr(t);
1004 
1005  /* traceline("PVR: entering check_out with status %d and term %P\n",
1006  t->status,t); for brunobug.lf PVR 14.2.94 */
1007  traceline("PVR: entering check_out with status %d and term %P\n",
1008  t->status,t); /* for brunobug.lf PVR 14.2.94 */
1009 
1010  if (t->status || (GENERIC)t>=heap_pointer) /* RM: Feb 8 1993 */
1011  flag=TRUE;
1012  else {
1013  t->status |= RMASK;
1014 
1015  switch((long)t->type->type_def) { /* RM: Feb 8 1993 */
1016 
1017  case (long)function_it:
1018  if (check_func_flag) {
1019  check_func(t);
1020  flag=TRUE;
1021  }
1022  else {
1023  /* Function evaluation handled during matching and unification */
1024  flag=TRUE;
1025  }
1026  break;
1027 
1028  case (long)type_it:
1029  flag=check_type(t);
1030  break;
1031 
1032  case (long)global: /* RM: Feb 8 1993 */
1033  eval_global_var(t);
1034  (void)check_out(t);
1035  flag=FALSE;
1036  break;
1037 
1038  default:
1039  flag=eval_args(t->attr_list);
1040  }
1041  t->status &= ~RMASK;
1042  }
1043 
1044  return flag;
1045 }
#define function_it
Definition: def_const.h:362
long eval_args(ptr_node n)
Definition: lefun.c:826
void eval_global_var(ptr_psi_term t)
Definition: lefun.c:1291
long check_out(ptr_psi_term t)
Definition: lefun.c:999
#define global
Definition: def_const.h:364
def_type type_def
Definition: def_struct.h:133
long check_type(ptr_psi_term t)
Definition: lefun.c:922
void traceline(char *format,...)
Definition: error.c:157
#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)
Definition: lefun.c:861
GENERIC heap_pointer
Definition: def_glob.h:12
static long check_func_flag
Definition: lefun.c:11
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)

Definition at line 922 of file lefun.c.

References eval_args(), FALSE, fetch_def(), int_ptr, push2_ptr_value(), RMASK, SMASK, and TRUE.

924 {
925  long flag=FALSE;
926 
928  /* push_ptr_value(int_ptr,(GENERIC *)&(t->status)); */
929 
930  if (t->type->properties) {
931  if (t->attr_list || t->type->always_check) {
932  /* Check all constraints here: */
933  fetch_def(t, TRUE); /* PVR 18.2.94 */
934  /* t->status=(2 & SMASK) | (t->status & RMASK); PVR 18.2.94 */
935 
936  (void)eval_args(t->attr_list);
937  flag=FALSE;
938  }
939  else {
940  /* definition pending on more information */
941  t->status= (2 & SMASK) | (t->status & RMASK);
942  flag=TRUE;
943  }
944  }
945  else {
946 
947  /* RM: Dec 15 1992 I don't know what this is for
948  if (!ovverlap_type(t->type,alist))
949  t->status= (4 & SMASK) | (t->status & RMASK);
950  */
951 
952  flag=eval_args(t->attr_list);
953  }
954 
955  return flag;
956 }
long eval_args(ptr_node n)
Definition: lefun.c:826
void push2_ptr_value(type_ptr t, GENERIC *p, GENERIC v)
Definition: login.c:531
char always_check
Definition: def_struct.h:134
void fetch_def(ptr_psi_term u, long allflag)
Definition: login.c:1128
#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 ( )

Definition at line 157 of file lefun.c.

References can_curry, curried, and TRUE.

158 {
159  if (can_curry)
160  curried=TRUE;
161 }
#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)

Definition at line 1224 of file lefun.c.

References check_func(), deref_ptr, eval_global_var(), function_it, and global.

1226 {
1227  deref_ptr(t);
1228  if (t->status==0) {
1229  if (t->type->type_def==(def_type)function_it) {
1230  check_func(t);
1231  }
1232  else
1233  if(t->type->type_def==(def_type)global) { /* RM: Feb 10 1993 */
1234  eval_global_var(t);
1235  deref_ptr(t);/* RM: Jun 25 1993 */
1236  deref2_eval(t);
1237  }
1238  else {
1239  t->status=4;
1240  }
1241  }
1242 }
#define function_it
Definition: def_const.h:362
void deref2_eval(ptr_psi_term t)
Definition: lefun.c:1224
void eval_global_var(ptr_psi_term t)
Definition: lefun.c:1291
#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)
Definition: lefun.c:861
ptr_definition type
Definition: def_struct.h:165
void deref2_rec_eval ( ptr_psi_term  t)

Definition at line 1245 of file lefun.c.

References deref_ptr, and deref_rec_body().

1247 {
1248  deref_ptr(t);
1249  deref_rec_body(t);
1250 }
#define deref_ptr(P)
Definition: def_macro.h:95
void deref_rec_body(ptr_psi_term t)
Definition: lefun.c:1135
long deref_args_eval ( ptr_psi_term  t,
long  set 
)

Definition at line 1175 of file lefun.c.

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

1178 {
1179  ptr_goal save = goal_stack;
1180  ptr_goal top_loc = aim;
1181 
1182  deref_flag = FALSE;
1183  goal_stack = top_loc;
1184  deref_rec_args_exc(t->attr_list,set);
1185  if (!deref_flag) goal_stack = save;
1186  return (deref_flag);
1187 }
ptr_goal goal_stack
Definition: def_glob.h:50
static long deref_flag
Definition: lefun.c:1085
#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)
Definition: lefun.c:1203
ptr_node attr_list
Definition: def_struct.h:171
long deref_eval ( ptr_psi_term  t)

Definition at line 1087 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(), and TRUE.

1089 {
1090  ptr_goal save=goal_stack;
1091 
1092  deref_flag=FALSE;
1093  goal_stack=aim;
1094 
1095  if (t->status==0) {
1096  if(t->type->type_def==(def_type)function_it) {
1097  check_func(t); /* Push eval goals to evaluate the function. */
1098  deref_flag=TRUE; /* TRUE so that caller will return to main_prove. */
1099  }
1100  else
1101  if(t->type->type_def==(def_type)global) { /* RM: Feb 10 1993 */
1102  eval_global_var(t);
1103  deref_ptr(t);/* RM: Jun 25 1993 */
1105  }
1106  else {
1107  if (((long)t->status)!=2) {
1108  if((GENERIC)t<heap_pointer)
1109  push_ptr_value(int_ptr,(GENERIC *)&(t->status)); /* RM: Jul 15 1993 */
1110  t->status=4;
1111  deref_flag=FALSE;
1112  }
1113  }
1114  }
1115  else
1116  deref_flag=FALSE;
1117 
1118  if (!deref_flag) goal_stack=save;
1119  return (deref_flag);
1120 }
#define function_it
Definition: def_const.h:362
long deref_eval(ptr_psi_term t)
Definition: lefun.c:1087
void eval_global_var(ptr_psi_term t)
Definition: lefun.c:1291
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
ptr_goal goal_stack
Definition: def_glob.h:50
static long deref_flag
Definition: lefun.c:1085
#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)
Definition: lefun.c:861
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)

Definition at line 1159 of file lefun.c.

References deref_ptr, and deref_rec_body().

1161 {
1162  ptr_psi_term t1;
1163 
1164  if (n) {
1165  deref_rec_args(n->right);
1166  t1 = (ptr_psi_term) (n->data);
1167  deref_ptr(t1);
1168  deref_rec_body(t1);
1169  deref_rec_args(n->left);
1170  }
1171 }
void deref_rec_args(ptr_node n)
Definition: lefun.c:1159
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)
Definition: lefun.c:1135
ptr_node right
Definition: def_struct.h:184
void deref_rec_args_exc ( ptr_node  n,
long  set 
)

Definition at line 1203 of file lefun.c.

References deref_ptr, deref_rec_body(), and in_set().

1206 {
1207  ptr_psi_term t;
1208 
1209  if (n) {
1210  deref_rec_args_exc(n->right,set);
1211  if (!in_set(n->key,set)) {
1212  t = (ptr_psi_term) (n->data);
1213  deref_ptr(t);
1214  deref_rec_body(t);
1215  }
1216  deref_rec_args_exc(n->left,set);
1217  }
1218 }
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)
Definition: lefun.c:1135
void deref_rec_args_exc(ptr_node n, long set)
Definition: lefun.c:1203
long in_set(char *str, long set)
Definition: lefun.c:1192
ptr_node right
Definition: def_struct.h:184
void deref_rec_body ( ptr_psi_term  t)

Definition at line 1135 of file lefun.c.

References check_func(), deref_flag, deref_ptr, deref_rec_args(), eval_global_var(), function_it, global, heap_pointer, int_ptr, push_ptr_value(), and TRUE.

1137 {
1138  if (t->status==0) {
1139  if (t->type->type_def==(def_type)function_it) {
1140  check_func(t);
1141  deref_flag=TRUE;
1142  }
1143  else
1144  if(t->type->type_def==(def_type)global) { /* RM: Feb 10 1993 */
1145  eval_global_var(t);
1146  deref_ptr(t);/* RM: Jun 25 1993 */
1147  deref_rec_body(t);
1148  }
1149  else {
1150  /* if (t->status!=2) Tried adding this -- PVR 9.2.94 */
1151  if((GENERIC)t<heap_pointer)
1152  push_ptr_value(int_ptr,(GENERIC *)&(t->status));/* RM: Jul 15 1993 */
1153  t->status=4;
1155  }
1156  }
1157 }
#define function_it
Definition: def_const.h:362
void eval_global_var(ptr_psi_term t)
Definition: lefun.c:1291
void deref_rec_args(ptr_node n)
Definition: lefun.c:1159
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
static long deref_flag
Definition: lefun.c:1085
#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)
Definition: lefun.c:861
GENERIC heap_pointer
Definition: def_glob.h:12
void deref_rec_body(ptr_psi_term t)
Definition: lefun.c:1135
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)

Definition at line 1123 of file lefun.c.

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

1125 {
1126  ptr_goal save=goal_stack;
1127 
1128  deref_flag=FALSE;
1129  goal_stack=aim;
1130  deref_rec_body(t);
1131  if (!deref_flag) goal_stack=save;
1132  return (deref_flag);
1133 }
ptr_goal goal_stack
Definition: def_glob.h:50
static long deref_flag
Definition: lefun.c:1085
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
void deref_rec_body(ptr_psi_term t)
Definition: lefun.c:1135
void do_currying ( )

Definition at line 359 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.

360 {
361  ptr_psi_term funct,result;
362 
363  /* PVR 5.11 undo(resid_limit); */
364  /* PVR 5.11 choice_stack=cut_point; */
366  funct=(ptr_psi_term )resid_aim->aaaa_1;
367  result=(ptr_psi_term )resid_aim->bbbb_1;
368 
369  traceline("currying %P\n",funct);
370 
371  push_goal(unify_noeval,funct,result,NULL);
372  resid_aim=NULL;
373 }
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)
Definition: login.c:555
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
void traceline(char *format,...)
Definition: error.c:157
#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 ( )

Definition at line 313 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.

314 {
315  long success;
316  ptr_psi_term t,u;
317  // ptr_goal *gs;
318 
319  /* This undoes perfectly valid work! */
320  /* The old version of Wild_Life did not trail anything
321  during matching, so I think this was a nop for it. */
322  /* PVR 11.5 undo(resid_limit); */
323  /* PVR 11.5 choice_stack=cut_point; */
324 
325  /* PVR 9.2.94 */
326  /* goal_stack=resid_aim->next; */
327 
328  if (trace) {
329  tracing();
331  }
332 
333  while (resid_vars) {
334 
335  t=resid_vars->var; /* 21.9 */
336  u=resid_vars->othervar; /* 21.9 */
337  /* PVR */ deref_ptr(t);
339  traceline("residuating on %P (other = %P)\n",t,u);
340 
341  success=residuateGoalOnVar(resid_aim, t, u); /* 21.9 */
342  if (!success) { /* 21.9 */
343  traceline("failure because of disentailment\n");
344  return FALSE;
345  }
346  }
347 
348  traceline("no failure because of disentailment\n");
349  return TRUE; /* 21.9 */
350 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void tracing()
Definition: error.c:604
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,...)
Definition: error.c:157
#define deref_ptr(P)
Definition: def_macro.h:95
void print_resid_message(ptr_psi_term t, ptr_resid_list r)
Definition: print.c:1562
#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)
Definition: lefun.c:172
long do_residuation_user ( )

Definition at line 306 of file lefun.c.

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

307 {
308  goal_stack=resid_aim->next; /* reset goal stack */
309  return do_residuation();
310 }
long do_residuation()
Definition: lefun.c:313
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 ( )

Definition at line 456 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.

457 {
458  long success=TRUE;
459  ptr_psi_term funct,result,head,body;
460  ptr_pair_list rule;
461  /* RESID */ ptr_resid_block rb;
462  ptr_choice_point cutpt;
463  ptr_psi_term match_date; /* 13.6 */
464 
465  funct=(ptr_psi_term )aim->aaaa_1;
466  deref_ptr(funct);
467 
468  /* RM: Jun 18 1993 */
469  push2_ptr_value(int_ptr,(GENERIC *)&(funct->status),(GENERIC)(funct->status & SMASK));
470  funct->status=4;
471 
472  /* if (!funct->type->evaluate_args) mark_quote(funct); 25.8 */ /* 18.2 PVR */
473  result=(ptr_psi_term )aim->bbbb_1;
474  rule=(ptr_pair_list )aim->cccc_1;
475 
476  match_date=(ptr_psi_term )stack_pointer;
477  cutpt=choice_stack; /* 13.6 */
478 
479  /* For currying and residuation */
480  curried=FALSE;
481  can_curry=TRUE;
482  /* resid_aim=aim; */
484  /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
485 
486  if (rule) {
487  traceline("evaluate %P\n",funct);
488  if ((unsigned long)rule<=MAX_BUILT_INS) {
489 
490  resid_aim=aim;
491  success=c_rule[(unsigned long)rule]();
492 
493  if (curried)
494  do_currying();
495  else
496  if (resid_vars)
497  success=do_residuation(); /* 21.9 */
498  else {
499  /* resid_aim=NULL; */
500  }
501  }
502  else {
503  while (rule && (rule->aaaa_2==NULL || rule->bbbb_2==NULL)) {
504  rule=rule->next;
505  traceline("alternative rule has been retracted\n");
506  }
507  if (rule) {
508  /* push_choice_point(eval,funct,result,rule->next); */ /* 17.6 */
509 
510  resid_aim=aim;
511  /* RESID */ rb = STACK_ALLOC(resid_block);
512  /* RESID */ save_resid(rb,match_date);
513  /* RESID */ /* resid_aim = NULL; */
514 
515  clear_copy();
516 
517  /* RM: Jun 18 1993: no functions in head */
518  /* if (TRUE)
519  head=eval_copy(rule->aaaa_1,STACK);
520  else */
521 
522  head=quote_copy(rule->aaaa_2,STACK);
523  body=eval_copy(rule->bbbb_2,STACK);
524  head->status=4;
525 
526  if (rule->next) /* 17.6 */
527  push_choice_point(eval,funct,result,(GENERIC)rule->next);
528 
529  push_goal(unify,body,result,NULL);
530  /* RESID */ push_goal(eval_cut,body,(ptr_psi_term)cutpt,(GENERIC)rb); /* 13.6 */
531  /* RESID */ push_goal(match,funct,head,(GENERIC)rb);
532  /* eval_args(head->attr_list); */
533  }
534  else {
535  success=FALSE;
536  /* resid_aim=NULL; */
537  }
538  }
539  }
540  else {
541  success=FALSE;
542  /* resid_aim=NULL; */
543  }
544  resid_aim=NULL;
545  /* match_date=NULL; */ /* 13.6 */
546  return success;
547 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_psi_term aaaa_2
Definition: def_struct.h:189
long do_residuation()
Definition: lefun.c:313
void clear_copy()
Definition: copy.c:52
void push2_ptr_value(type_ptr t, GENERIC *p, GENERIC v)
Definition: login.c:531
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:591
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
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()
Definition: lefun.c:359
#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,...)
Definition: error.c:157
ptr_psi_term quote_copy(ptr_psi_term t, long heap_flag)
Definition: copy.c:200
#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)
Definition: lefun.c:1256
#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)
Definition: copy.c:205
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)

Definition at line 826 of file lefun.c.

References check_out(), and TRUE.

828 {
829  long flag=TRUE;
830 
831  if (n) {
832  flag = eval_args(n->right);
833  flag = check_out((ptr_psi_term)n->data) && flag;
834  flag = eval_args(n->left) && flag;
835  }
836 
837  return flag;
838 }
long eval_args(ptr_node n)
Definition: lefun.c:826
long check_out(ptr_psi_term t)
Definition: lefun.c:999
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)

Definition at line 1291 of file lefun.c.

References wl_stack::aaaa_3, wl_stack::bbbb_3, clear_copy(), deref_ptr, eval_copy(), global, wl_stack::next, NULL, psi_term_ptr, push_psi_ptr_value(), STACK, STACK_ALLOC, traceline(), wl_stack::type, and undo_stack.

1294 {
1295  deref_ptr(t);
1296 
1297  /* Global variable (not persistent) */
1298 
1299  traceline("dereferencing variable %P\n",t);
1300 
1301  /* Trails the heap RM: Nov 10 1993 */
1302  if(!t->type->global_value) {
1303 
1304  /* Trail the heap !! */
1305  {
1306  ptr_stack n;
1307  n=STACK_ALLOC(stack);
1308  n->type=psi_term_ptr;
1309  n->aaaa_3= (GENERIC *) &(t->type->global_value);
1310  n->bbbb_3= (GENERIC *) NULL;
1311  n->next=undo_stack;
1312  undo_stack=n;
1313  }
1314 
1315 
1316  clear_copy();
1318 
1319  }
1320 
1321  /* var_occurred=TRUE; RM: Feb 4 1994 */
1322 
1323  if(t->type->type_def==(def_type)global && t!=t->type->global_value) {
1324  /*traceline("dereferencing variable %P\n",t);*/
1325  push_psi_ptr_value(t,(GENERIC *)&(t->coref));
1326  t->coref=t->type->global_value;
1327  }
1328 }
ptr_psi_term init_value
Definition: def_struct.h:142
void clear_copy()
Definition: copy.c:52
#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)
Definition: login.c:443
def_type type_def
Definition: def_struct.h:133
#define NULL
Definition: def_const.h:203
void traceline(char *format,...)
Definition: error.c:157
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)
Definition: copy.c:205
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)

Definition at line 992 of file lefun.c.

References check_func_flag, check_out(), and TRUE.

994 {
996  return check_out(t);
997 }
long check_out(ptr_psi_term t)
Definition: lefun.c:999
#define TRUE
Definition: def_const.h:127
static long check_func_flag
Definition: lefun.c:11
ptr_psi_term heap_psi_term ( long  stat)

Definition at line 63 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.

65 {
66  ptr_psi_term result;
67 
68  result=HEAP_ALLOC(psi_term);
69  result->type=top;
70  result->status=stat;
71  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
72  result->attr_list=NULL;
73  result->coref=NULL;
74 #ifdef TS
75  result->time_stamp=global_time_stamp; /* 9.6 */
76 #endif
77  result->resid=NULL;
78  result->value_3=NULL;
79 
80  return result;
81 }
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:19
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)

Definition at line 985 of file lefun.c.

References check_func_flag, check_out(), and FALSE.

987 {
989  return check_out(t);
990 }
long check_out(ptr_psi_term t)
Definition: lefun.c:999
#define FALSE
Definition: def_const.h:128
static long check_func_flag
Definition: lefun.c:11
long i_eval_args ( ptr_node  n)

Definition at line 817 of file lefun.c.

References check_func_flag, eval_args(), and FALSE.

819 {
821  return eval_args(n);
822 }
long eval_args(ptr_node n)
Definition: lefun.c:826
#define FALSE
Definition: def_const.h:128
static long check_func_flag
Definition: lefun.c:11
long in_set ( char *  str,
long  set 
)

Definition at line 1192 of file lefun.c.

References FALSE, featcmp(), and TRUE.

1195 {
1196  if (set&1 && !featcmp(str,"1")) return TRUE;
1197  if (set&2 && !featcmp(str,"2")) return TRUE;
1198  if (set&4 && !featcmp(str,"3")) return TRUE;
1199  if (set&8 && !featcmp(str,"4")) return TRUE;
1200  return FALSE;
1201 }
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long featcmp(char *str1, char *str2)
Definition: trees.c:89
void init_global_vars ( )

Definition at line 1337 of file lefun.c.

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

1339 {
1340  ptr_definition def;
1341 
1342  /* printf("initializing global vars...\n"); */
1343 
1344  /*
1345  for(def=first_definition;def;def=def->next) {
1346  if(def->type==global && ((GENERIC)def->global_value<heap_pointer)) {
1347  clear_copy();
1348  def->global_value=eval_copy(def->init_value,STACK);
1349  }
1350  }
1351  */
1352 
1353  for(def=first_definition;def;def=def->next)
1355  def->global_value=NULL;
1356 }
#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 ( )

Definition at line 712 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.

713 {
714  long success=TRUE;
715  ptr_psi_term u,v; // ,tmp;
716  REAL r;
717  long /* less, */ lesseq;
718  ptr_resid_block rb;
719  ptr_psi_term match_date;
720 
721  u=(ptr_psi_term )aim->aaaa_1;
722  v=(ptr_psi_term )aim->bbbb_1;
723  deref_ptr(u);
724  deref_ptr(v);
726  restore_resid(rb,&match_date);
727 
728  if (u!=v) {
729  if ((success=matches(u->type,v->type,&lesseq))) {
730  if (lesseq) {
731  if (u->type!=cut || v->type!=cut) { /* Ignore value field for cut! */
732  if (v->value_3) {
733  if (u->value_3) {
734  if (overlap_type(v->type,real))
735  success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
736  else if (overlap_type(v->type,quoted_string))
737  success=(strcmp((char *)u->value_3,(char *)v->value_3)==0);
738  /* DENYS: BYTEDATA */
739  else if (overlap_type(v->type,sys_bytedata)) {
740  unsigned long ulen = *((unsigned long *) u->value_3);
741  unsigned long vlen = *((unsigned long *) v->value_3);
742  success=(ulen==vlen && bcmp((char *)u->value_3,(char *)v->value_3,ulen)==0);
743  }
744  }
745  else
746  residuate_double(u,v);
747  }
748  }
749  }
750  else if (u->value_3) {
751  /* Here we have U <| V but U and V have values which cannot match. */
752  success=TRUE;
753 
754  if (v->value_3) {
755  if (overlap_type(v->type,real))
756  success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
757  }
758  else if (overlap_type(u->type,integer)) {
759  r= *((REAL *)u->value_3);
760  success=(r==floor(r));
761  }
762 
763  if (success) residuate_double(u,v);
764  }
765  else
766  residuate_double(u,v);
767 
768  if (success) {
769  if (FUNC_ARG(u) && FUNC_ARG(v)) { /* RM: Feb 10 1993 */
770  /* residuate2(u,v); 21.9 */
771  residuate_double(u,v); /* 21.9 */
772  residuate_double(v,u); /* 21.9 */
773  }
774  else if (FUNC_ARG(v)) { /* RM: Feb 10 1993 */
775  residuate_double(v,u); /* 21.9 */
776  }
777  else {
778  v->coref=u;
779  } /* 21.9 */
781  match_attr(&(u->attr_list),v->attr_list,rb);
782  if (attr_missing) {
783  if (can_curry)
784  curried=TRUE;
785  else
786  residuate_double(u,v);
787  }
788  /* } 21.9 */
789  }
790  }
791  }
792 
794  save_resid(rb,match_date); /* updated resid_block */
795  /* This should be a useless statement: */
796  resid_aim = NULL;
797 
798  return success;
799 }
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:10
GENERIC cccc_1
Definition: def_struct.h:226
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#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)
Definition: types.c:1486
#define REAL
Definition: def_const.h:72
void residuate_double(ptr_psi_term t, ptr_psi_term u)
Definition: lefun.c:95
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)
Definition: lefun.c:1256
ptr_definition cut
Definition: def_glob.h:83
void match_attr(ptr_node *u, ptr_node v, ptr_resid_block rb)
Definition: lefun.c:692
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)
Definition: lefun.c:1270
void match_attr ( ptr_node u,
ptr_node  v,
ptr_resid_block  rb 
)

Definition at line 692 of file lefun.c.

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

695 {
696  match_attr1(u,v,rb); /* Match corresponding arguments (third) */
697  match_attr2(u,v,rb); /* Evaluate lone arguments (second) */
698  match_attr3(u,v,rb); /* Evaluate corresponding arguments (first) */
699 }
void match_attr2(ptr_node *u, ptr_node v, ptr_resid_block rb)
Definition: lefun.c:592
void match_attr1(ptr_node *u, ptr_node v, ptr_resid_block rb)
Definition: lefun.c:552
void match_attr3(ptr_node *u, ptr_node v, ptr_resid_block rb)
Definition: lefun.c:643
void match_attr1 ( ptr_node u,
ptr_node  v,
ptr_resid_block  rb 
)

Definition at line 552 of file lefun.c.

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

555 {
556  long cmp;
557  ptr_node temp;
558 
559  if (v) {
560  if (*u==NULL)
562  else {
563  cmp=featcmp((*u)->key,v->key);
564  if(cmp==0) {
565  ptr_psi_term t;
566  /* RESID */ match_attr1(&((*u)->right),v->right,rb);
567  t = (ptr_psi_term) (*u)->data;
568  /* RESID */ push_goal(match,(ptr_psi_term)(*u)->data,(ptr_psi_term)v->data,(GENERIC)rb);
569  /* deref2_eval(t); */
570  /* RESID */ match_attr1(&((*u)->left),v->left,rb);
571  }
572  else if (cmp>0) {
573  temp=v->right;
574  v->right=NULL;
575  /* RESID */ match_attr1(u,temp,rb);
576  /* RESID */ match_attr1(&((*u)->left),v,rb);
577  v->right=temp;
578  }
579  else {
580  temp=v->left;
581  v->left=NULL;
582  /* RESID */ match_attr1(&((*u)->right),v,rb);
583  /* RESID */ match_attr1(u,temp,rb);
584  v->left=temp;
585  }
586  }
587  }
588 }
static long attr_missing
Definition: lefun.c:10
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
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)
Definition: trees.c:89
void match_attr1(ptr_node *u, ptr_node v, ptr_resid_block rb)
Definition: lefun.c:552
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 
)

Definition at line 592 of file lefun.c.

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

595 {
596  long cmp;
597  ptr_node temp;
598 
599  if (v) {
600  if (*u==NULL) { /* PVR 12.03 */
601  ptr_psi_term t;
602  match_attr1(u,v->right,rb);
603  t = (ptr_psi_term) v->data;
604  deref2_rec_eval(t);
605  match_attr1(u,v->left,rb);
606  }
607  else {
608  cmp=featcmp((*u)->key,v->key);
609  if(cmp==0) {
610  /* RESID */ match_attr2(&((*u)->right),v->right,rb);
611  /* RESID */ match_attr2(&((*u)->left),v->left,rb);
612  }
613  else if (cmp>0) {
614  temp=v->right;
615  v->right=NULL;
616  /* RESID */ match_attr2(u,temp,rb);
617  /* RESID */ match_attr2(&((*u)->left),v,rb);
618  v->right=temp;
619  }
620  else {
621  temp=v->left;
622  v->left=NULL;
623  /* RESID */ match_attr2(&((*u)->right),v,rb);
624  /* RESID */ match_attr2(u,temp,rb);
625  v->left=temp;
626  }
627  }
628  }
629  else if (*u!=NULL) {
630  ptr_psi_term t /* , empty */ ;
631  match_attr1(&((*u)->right),v,rb);
632  t = (ptr_psi_term) (*u)->data;
633  /* Create a new psi-term to put the (useless) result: */
634  /* This is needed so that *all* arguments of a function call */
635  /* are evaluated, which avoids incorrect 'Yes' answers. */
636  deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
637  match_attr1(&((*u)->left),v,rb);
638  }
639 }
void match_attr2(ptr_node *u, ptr_node v, ptr_resid_block rb)
Definition: lefun.c:592
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)
Definition: trees.c:89
void match_attr1(ptr_node *u, ptr_node v, ptr_resid_block rb)
Definition: lefun.c:552
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void deref2_rec_eval(ptr_psi_term t)
Definition: lefun.c:1245
ptr_node right
Definition: def_struct.h:184
void match_attr3 ( ptr_node u,
ptr_node  v,
ptr_resid_block  rb 
)

Definition at line 643 of file lefun.c.

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

646 {
647  long cmp;
648  ptr_node temp;
649 
650  if (v) {
651  if (*u==NULL)
653  else {
654  cmp=featcmp((*u)->key,v->key);
655  if(cmp==0) {
656  ptr_psi_term t1,t2;
657  /* RESID */ match_attr3(&((*u)->right),v->right,rb);
658  t1 = (ptr_psi_term) (*u)->data;
659  t2 = (ptr_psi_term) v->data;
660  /* RESID */ /* push_goal(match,(*u)->data,v->data,rb); */
661  deref2_eval(t1); /* Assumes goal_stack is already restored. */
662  deref2_eval(t2); /* PVR 12.03 */
663  /* RESID */ match_attr3(&((*u)->left),v->left,rb);
664  }
665  else if (cmp>0) {
666  temp=v->right;
667  v->right=NULL;
668  /* RESID */ match_attr3(u,temp,rb);
669  /* RESID */ match_attr3(&((*u)->left),v,rb);
670  v->right=temp;
671  }
672  else {
673  temp=v->left;
674  v->left=NULL;
675  /* RESID */ match_attr3(&((*u)->right),v,rb);
676  /* RESID */ match_attr3(u,temp,rb);
677  v->left=temp;
678  }
679  }
680  }
681 }
void deref2_eval(ptr_psi_term t)
Definition: lefun.c:1224
static long attr_missing
Definition: lefun.c:10
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)
Definition: trees.c:89
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)
Definition: lefun.c:643
ptr_node right
Definition: def_struct.h:184
ptr_psi_term real_stack_psi_term ( long  stat,
REAL  thereal 
)

Definition at line 38 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.

41 {
42  ptr_psi_term result;
43 
44  result=STACK_ALLOC(psi_term);
45  result->type = (thereal==floor(thereal)) ? integer : real;
46  result->status=stat;
47  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
48  result->attr_list=NULL;
49  result->coref=NULL;
50 #ifdef TS
51  result->time_stamp=global_time_stamp; /* 9.6 */
52 #endif
53  result->resid=NULL;
54  result->value_3=heap_alloc(sizeof(REAL));
55  (* (REAL *)(result->value_3)) = thereal;
56 
57  return result;
58 }
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:19
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)
Definition: memory.c:1518
void release_resid ( ptr_psi_term  t)

Definition at line 414 of file lefun.c.

References release_resid_main(), and TRUE.

416 {
418 }
#define TRUE
Definition: def_const.h:127
void release_resid_main(ptr_psi_term t, long trailflag)
Definition: lefun.c:384
void release_resid_main ( ptr_psi_term  t,
long  trailflag 
)

Definition at line 384 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(), resid_ptr, and traceline().

387 {
388  ptr_goal g;
389  ptr_residuation r;
390 
391  if ((r=t->resid)) {
392  if (trailflag) push_ptr_value(resid_ptr,(GENERIC *)&(t->resid));
393  t->resid=NULL;
394 
395  while (r) {
396  g=r->goal;
397  if (g->pending) {
398 
400  g->pending=FALSE;
401 
403 
404  g->next=goal_stack;
405  goal_stack=g;
406 
407  traceline("releasing %P\n",g->aaaa_1);
408  }
409  r=r->next;
410  }
411  }
412 }
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)
Definition: login.c:360
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,...)
Definition: error.c:157
#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)

Definition at line 420 of file lefun.c.

References FALSE, and release_resid_main().

422 {
424 }
#define FALSE
Definition: def_const.h:128
void release_resid_main(ptr_psi_term t, long trailflag)
Definition: lefun.c:384
void residuate ( ptr_psi_term  t)

Definition at line 113 of file lefun.c.

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

115 {
116  ptr_resid_list curr;
117 
118  curr=STACK_ALLOC(resid_list);
119  curr->var=t;
120  curr->othervar=NULL; /* 21.9 */
121  curr->next=resid_vars;
122  resid_vars=curr;
123 }
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 
)

Definition at line 130 of file lefun.c.

References residuate().

132 {
133  residuate(u);
134  if (v && u!=v) residuate(v);
135 }
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void residuate3 ( ptr_psi_term  u,
ptr_psi_term  v,
ptr_psi_term  w 
)

Definition at line 142 of file lefun.c.

References residuate().

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

Definition at line 95 of file lefun.c.

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

97 {
98  ptr_resid_list curr;
99 
100  curr=STACK_ALLOC(resid_list);
101  curr->var=t;
102  curr->othervar=u;
103  curr->next=resid_vars;
104  resid_vars=curr;
105 }
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 
)

Definition at line 172 of file lefun.c.

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

175 {
176  long result;
177  long resflag,resflag2;
178  GENERIC rescode,rescode2;
179  GENERIC resvalue;
180  GENERIC resvalue2;
181  /* Set to FALSE if the goal is already residuated on the var: */
182  long not_found = TRUE;
183  /* Points to a pointer to a residuation structure. Used so we can */
184  /* add the goal to the end of the residuation list, so that it can */
185  /* can be undone later if backtracking happens. See the call to */
186  /* push_ptr_value. */
187  ptr_residuation *r;
188 
189  /* 5.8 PVR */
190  if ((GENERIC)var>=heap_pointer) {
191  Errorline("attempt to residuate on psi-term %P in the heap.\n",var);
192 
193  return FALSE;
194  }
195 
196  r= &(var->resid);
197 
198  while (not_found && *r) {
199  if ((*r)->goal == g) { /* This goal is already attached */
200  /* Keep track of best sort so far */
201  /* Glb_code(..) tries to keep 'sortflag' TRUE if possible. */
202  result=glb_code((*r)->sortflag,(*r)->bestsort,
203  TRUE,(GENERIC)var->type,
204  &resflag,&rescode);
205  result=glb_value(result,resflag,rescode,(GENERIC)(*r)->value_2,var->value_3,
206  &resvalue); /* 6.10 */
207  if (!result)
208  return FALSE; /* 21.9 */
209  else if (othervar) {
210  result=glb_code(resflag,rescode,TRUE,(GENERIC)othervar->type,
211  &resflag2,&rescode2);
212  result=glb_value(result,resflag2,rescode2,resvalue,othervar->value_3,
213  &resvalue2); /* 6.10 */
214  if (!result) {
215  return FALSE;
216  }
217  else {
218  /* The value field only has to be trailed once, since its value */
219  /* does not change, once given. */
220  if ((*r)->value_2==NULL && resvalue2!=NULL) { /* 6.10 */
221  push_ptr_value(int_ptr,(GENERIC *)&((*r)->value_2));
222  }
223  if ((*r)->bestsort!=rescode2) {
224  push_ptr_value(((*r)->sortflag?def_ptr:code_ptr),
225  &((*r)->bestsort));
226  (*r)->bestsort=rescode2; /* 21.9 */
227  }
228  if ((*r)->sortflag!=resflag2) {
229  push_ptr_value(int_ptr,(GENERIC *)&((*r)->sortflag));
230  (*r)->sortflag=resflag2; /* 21.9 */
231  }
232  }
233  }
234  else {
235  if ((*r)->value_2==NULL && resvalue!=NULL) { /* 6.10 */
236  push_ptr_value(int_ptr,(GENERIC *)&((*r)->value_2));
237  }
238  if ((*r)->bestsort!=rescode) {
239  push_ptr_value(((*r)->sortflag?def_ptr:code_ptr),
240  &((*r)->bestsort));
241  (*r)->bestsort=rescode; /* 21.9 */
242  }
243  if ((*r)->sortflag!=resflag) {
244  push_ptr_value(int_ptr,(GENERIC *)&((*r)->sortflag));
245  (*r)->sortflag=resflag; /* 21.9 */
246  }
247  }
248  not_found = FALSE;
249  }
250  else
251  r= &((*r)->next); /* look at the next one */
252  }
253 
254  if (not_found) {
255  /* We must attach this goal & the variable's sort onto this variable */
256 
259  if (othervar) {
260  result=glb_code(TRUE,(GENERIC)var->type,TRUE,(GENERIC)othervar->type,&resflag,&rescode);
261  result=glb_value(result,resflag,rescode,var->value_3,othervar->value_3,
262  &resvalue); /* 6.10 */
263  if (!result) {
264  return FALSE;
265  }
266  else {
267  (*r)->sortflag=resflag;
268  (*r)->bestsort=rescode; /* 21.9 */
269  (*r)->value_2=resvalue; /* 6.10 */
270  }
271  }
272  else {
273  (*r)->sortflag=TRUE;
274  (*r)->bestsort=(GENERIC)var->type; /* 21.9 */
275  (*r)->value_2=var->value_3; /* 6.10 */
276  }
277  (*r)->goal=g;
278  (*r)->next=NULL;
279  }
280 
281  if (!(g->pending)) {
282  /* this goal is not pending, so make sure it will be put on the goal
283  * stack later
284  */
287  }
288 
289  return TRUE; /* 21.9 */
290 }
ptr_residuation resid
Definition: def_struct.h:173
long glb_value(long result, long f, GENERIC c, GENERIC value1, GENERIC value2, GENERIC *value)
Definition: types.c:1206
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
#define def_ptr
Definition: def_const.h:173
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Definition: error.c:414
#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)
Definition: types.c:1263
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 
)

Definition at line 1270 of file lefun.c.

References can_curry, curried, FALSE, resid_aim, resid_vars, and TRUE.

1273 {
1274  if (rb) {
1275  can_curry = (rb->cc_cr&2)?TRUE:FALSE; /* 11.9 */
1276  curried = (rb->cc_cr&1)?TRUE:FALSE; /* 11.9 */
1277  resid_aim = rb->ra;
1278  resid_vars = rb->rv;
1279  /* curried = rb->cr; 11.9 */
1280  /* can_curry = rb->cc; 11.9 */
1281  *match_date = rb->md;
1282  }
1283 }
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 
)

Definition at line 1256 of file lefun.c.

References can_curry, curried, resid_aim, and resid_vars.

1259 {
1260  if (rb) {
1261  rb->cc_cr = (can_curry<<1) + curried; /* 11.9 */
1262  rb->ra = resid_aim;
1263  rb->rv = resid_vars;
1264  /* rb->cr = curried; 11.9 */
1265  /* rb->cc = can_curry; 11.9 */
1266  rb->md = match_date;
1267  }
1268 }
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)

Definition at line 15 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.

17 {
18  ptr_psi_term result;
19 
20  result=STACK_ALLOC(psi_term);
21  result->type=top;
22  result->status=stat;
23  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
24  result->attr_list=NULL;
25  result->coref=NULL;
26 #ifdef TS
27  result->time_stamp=global_time_stamp; /* 9.6 */
28 #endif
29  result->resid=NULL;
30  result->value_3=NULL;
31 
32  return result;
33 }
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:19
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 10 of file lefun.c.

long check_func_flag
static

Definition at line 11 of file lefun.c.

long deref_flag
static

Definition at line 1085 of file lefun.c.