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

Go to the source code of this file.

Functions

long all_public_symbols ()
 
ptr_psi_term stack_nil ()
 
ptr_psi_term stack_cons (ptr_psi_term head, ptr_psi_term tail)
 
ptr_psi_term stack_pair (ptr_psi_term left, ptr_psi_term right)
 
ptr_psi_term stack_int (long n)
 
ptr_psi_term stack_string (char *s)
 
ptr_psi_term stack_bytes (char *s, int n)
 
long psi_to_string (ptr_psi_term t, char **fn)
 
ptr_psi_term make_feature_list (ptr_node tree, ptr_psi_term tail, ptr_module module, int val)
 
long check_real (ptr_psi_term t, REAL *v, long *n)
 
long get_real_value (ptr_psi_term t, REAL *v, long *n)
 
static long get_bool_value (ptr_psi_term t, REAL *v, long *n)
 
void unify_bool_result (ptr_psi_term t, long v)
 
long unify_real_result (ptr_psi_term t, REAL v)
 
static long c_gt ()
 
static long c_equal ()
 
static long c_eval_disjunction ()
 
static long c_lt ()
 
static long c_gtoe ()
 
static long c_ltoe ()
 
static long c_boolpred ()
 
static long get_bool (ptr_definition typ)
 
static void unify_bool (ptr_psi_term arg)
 
static long c_logical_main (long sel)
 
static long c_and ()
 
static long c_or ()
 
static long c_not ()
 
static long c_xor ()
 
static long c_apply ()
 
static long c_project ()
 
static long c_diff ()
 
static long c_fail ()
 
static long c_succeed ()
 
static long c_repeat ()
 
static long c_var ()
 
static long c_nonvar ()
 
static long c_is_function ()
 
static long c_is_predicate ()
 
static long c_is_sort ()
 
long only_arg1 (ptr_psi_term t, ptr_psi_term *arg1)
 
static long c_dynamic ()
 
static long c_static ()
 
static long c_delay_check ()
 
static long c_non_strict ()
 
static long c_op ()
 
long file_exists (char *s)
 
static long c_exists ()
 
static long c_load ()
 
static long c_get_choice ()
 
static long c_set_choice ()
 
static long c_exists_choice ()
 
static long c_print_variables ()
 
static void set_parse_queryflag (ptr_node thelist, long sort)
 
static long c_parse ()
 
static long c_read (long)
 
static long c_read_psi ()
 
static long c_read_token ()
 
long c_halt ()
 
void exit_life (long nl_flag)
 
long c_abort ()
 
long abort_life (int nlflag)
 
static long c_not_implemented ()
 
static long c_declaration ()
 
static long c_setq ()
 
static long c_assert_first ()
 
static long c_assert_last ()
 
long pred_clause (ptr_psi_term t, long r, ptr_psi_term g)
 
static long c_clause ()
 
static long c_retract ()
 
static long c_global ()
 
void global_error_check (ptr_node n, int *error, int *eval_2)
 
void global_tree (ptr_node n)
 
void global_one (ptr_psi_term t)
 
static long c_persistent ()
 
void persistent_error_check (ptr_node n, int *error)
 
void persistent_tree (ptr_node n)
 
void persistent_one (ptr_psi_term t)
 
static long c_open_in ()
 
static long c_open_out ()
 
static long c_set_input ()
 
static long c_set_output ()
 
static long c_close ()
 
static long c_get ()
 
static long c_put_main (long)
 
static long c_put ()
 
static long c_put_err ()
 
static long generic_write ()
 
static long c_write_err ()
 
static long c_writeq_err ()
 
static long c_write ()
 
static long c_writeq ()
 
static long c_write_canonical ()
 
static long c_pwrite ()
 
static long c_pwriteq ()
 
static long c_page_width ()
 
static long c_print_depth ()
 
static long c_rootsort ()
 
static long c_disj ()
 
static long c_cond ()
 
static long c_exist_feature ()
 
static long c_features ()
 
static long c_feature_values ()
 
long hidden_type (ptr_definition t)
 
ptr_psi_term collect_symbols (long sel)
 
static long c_ops ()
 
static ptr_node copy_attr_list (ptr_node n)
 
static long c_strip ()
 
static long c_same_address ()
 
static long c_diff_address ()
 
static long c_eval ()
 
static long c_eval_inplace ()
 
static long c_quote ()
 
static long c_split_double ()
 
static long c_string_address ()
 
static long c_chdir ()
 
static long c_call ()
 
static long c_bk_assign ()
 
static long c_assign ()
 
static long c_global_assign ()
 
static long c_unify_func ()
 
static long c_unify_pred ()
 
static long c_copy_pointer ()
 
static long c_copy_term ()
 
static long c_undo ()
 
static long c_freeze_inner (long freeze_flag)
 
static long c_freeze ()
 
static long c_implies ()
 
static long c_char ()
 
static long c_ascii ()
 
static long c_string2psi ()
 
static long c_psi2string ()
 
static long c_int2string ()
 
static long c_such_that ()
 
ptr_node one_attr ()
 
ptr_psi_term new_psi_term (long numargs, ptr_definition typ, ptr_psi_term **a1, ptr_psi_term **a2)
 
long has_rules (ptr_pair_list r)
 
long is_built_in (ptr_pair_list r)
 
void list_special (ptr_psi_term t)
 
static long c_listing ()
 
static long c_print_codes ()
 
static long c_pred ()
 
static long c_funct ()
 
void new_built_in (ptr_module m, char *s, def_type t, long(*r)())
 
static void op_declare (long p, operator t, char *s)
 
long declare_operator (ptr_psi_term t)
 
char * str_conc (char *s1, char *s2)
 
char * sub_str (char *s, long p, long n)
 
long append_files (char *s1, char *s2)
 
long c_concatenate ()
 
static long c_module_name ()
 
static long c_combined_name ()
 
long c_string_length ()
 
long c_sub_string ()
 
long c_append_file ()
 
long c_random ()
 
long c_initrandom ()
 
long c_deref_length ()
 
long c_args ()
 
void init_built_in_types ()
 

Variables

static long built_in_index =0
 

Function Documentation

long abort_life ( int  nlflag)

Definition at line 2124 of file built_ins.c.

References aborthooksym, abortsym, wl_pair_list::bbbb_2, DEFRULES, FALSE, function_it, init_system(), main_loop_ok, NOTQUIET, NULL, prove, push_goal(), wl_definition::rule, stack_psi_term(), stdin_cleareof(), TRUE, wl_psi_term::type, wl_definition::type_def, undo(), and var_occurred.

2126 {
2128  !aborthooksym->rule->bbbb_2 ||
2130  /* Do a true abort if aborthook is not a function or is equal to 'abort'.*/
2131  main_loop_ok = FALSE;
2132  undo(NULL); /* 8.10 */
2133  if(NOTQUIET) fprintf(stderr,"\n*** Abort"); /* RM: Feb 17 1993 */
2134  if(NOTQUIET && nlflag) fprintf(stderr,"\n");/* RM: Feb 17 1993 */
2135  } else {
2136  /* Do a 'user-defined abort': initialize the system, then */
2137  /* prove the user-defined abort routine (which is set by */
2138  /* means of 'setq(aborthook,user_defined_abort)'. */
2139  ptr_psi_term aborthook;
2140 
2141  undo(NULL);
2142  init_system();
2144  stdin_cleareof();
2145  if(NOTQUIET) fprintf(stderr,"\n*** Abort"); /* RM: Feb 17 1993 */
2146  if(NOTQUIET && nlflag) fprintf(stderr,"\n");/* RM: Feb 17 1993 */
2147  aborthook=stack_psi_term(0);
2148  aborthook->type=aborthooksym;
2150  }
2151  fprintf(stderr,"\n*** END Abort");
2152  return TRUE;
2153 }
#define prove
Definition: def_const.h:273
ptr_definition abortsym
Definition: def_glob.h:64
#define function_it
Definition: def_const.h:362
void undo(ptr_stack limit)
Definition: login.c:646
long main_loop_ok
Definition: def_glob.h:48
#define NOTQUIET
Definition: def_macro.h:10
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void init_system()
Definition: lib.c:77
def_type type_def
Definition: def_struct.h:133
#define DEFRULES
Definition: def_const.h:138
ptr_definition aborthooksym
Definition: def_glob.h:65
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
long var_occurred
Definition: def_glob.h:189
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_psi_term bbbb_2
Definition: def_struct.h:190
ptr_definition type
Definition: def_struct.h:165
void stdin_cleareof()
Definition: token.c:42
unsigned long * GENERIC
Definition: def_struct.h:17
long all_public_symbols ( )

Definition at line 1349 of file modules.c.

1350 {
1351  ptr_psi_term arg1,arg2,funct,result;
1352  ptr_psi_term list;
1353  ptr_psi_term car;
1354  ptr_module module=NULL;
1355  ptr_definition d;
1356 
1357  funct=aim->aaaa_1;
1358  deref_ptr(funct);
1359  result=aim->bbbb_1;
1360  get_two_args(funct->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
1361 
1362  if(arg1) {
1363  deref_ptr(arg1);
1364  (void)get_module(arg1,&module);
1365  }
1366  else
1367  module=NULL;
1368 
1369  list=stack_nil();
1370 
1371  for(d=first_definition;d;d=d->next)
1372  if(d->keyword->public && (!module || d->keyword->module==module)) {
1373  car=stack_psi_term(4);
1374  car->type=d;
1375  list=stack_cons(car,list);
1376  }
1377 
1378  push_goal(unify,result,list,NULL);
1379 
1380  return TRUE;
1381 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
Definition: built_ins.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
ptr_definition next
Definition: def_struct.h:148
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition first_definition
Definition: def_glob.h:3
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_psi_term stack_nil()
Definition: built_ins.c:29
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
ptr_module module
Definition: def_struct.h:90
int public
Definition: def_struct.h:94
ptr_definition type
Definition: def_struct.h:165
int get_module(ptr_psi_term psi, ptr_module *module)
Definition: modules.c:1207
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
long append_files ( char *  s1,
char *  s2 
)

Definition at line 5211 of file built_ins.c.

References Errorline(), FALSE, and TRUE.

5213 {
5214  FILE *f1;
5215  FILE *f2;
5216  long result=FALSE;
5217 
5218  f1=fopen(s1,"a");
5219  if(f1) {
5220  f2=fopen(s2,"r");
5221  if(f2) {
5222  while(!feof(f2))
5223  (void)fputc(fgetc(f2),f1);
5224  (void)fclose(f2);
5225  (void)fclose(f1);
5226  result=TRUE;
5227  }
5228  else
5229  Errorline("couldn't open \"%s\"\n",f2);
5230  /* printf("*** Error: couldn't open \"%s\"\n",f2); PVR 14.9.93 */
5231  }
5232  else
5233  Errorline("couldn't open \"%s\"\n",f1);
5234  /* printf("*** Error: couldn't open \"%s\"\n",f1); PVR 14.9.93 */
5235 
5236  return result;
5237 }
void Errorline(char *format,...)
Definition: error.c:414
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long c_abort ( )

Definition at line 2117 of file built_ins.c.

References abort_life(), and TRUE.

2118 {
2119  return (abort_life(TRUE));
2120 }
long abort_life(int nlflag)
Definition: built_ins.c:2124
#define TRUE
Definition: def_const.h:127
static long c_and ( )
static

Definition at line 963 of file built_ins.c.

References c_logical_main(), and TRUE.

964 {
965  return c_logical_main(TRUE);
966 }
#define TRUE
Definition: def_const.h:127
static long c_logical_main(long sel)
Definition: built_ins.c:890
long c_append_file ( )

Definition at line 5552 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_node::data, deref, deref_args, deref_ptr, Errorline(), FALSE, FEATCMP, find(), one, overlap_type(), quoted_string, set_1_2, TRUE, two, wl_psi_term::type, and wl_psi_term::value_3.

5553 {
5554  ptr_psi_term g;
5555  ptr_node n1,n2;
5556  long success=TRUE;
5557  ptr_psi_term arg1;
5558  char * c_arg1;
5559  ptr_psi_term arg2;
5560  char * c_arg2;
5561 
5562  g=aim->aaaa_1;
5563  deref_ptr(g);
5564 
5565  /* Evaluate all arguments first: */
5566  n1=find(FEATCMP,one,g->attr_list);
5567  if (n1) {
5568  arg1= (ptr_psi_term )n1->data;
5569  deref(arg1);
5570  }
5571  n2=find(FEATCMP,two,g->attr_list);
5572  if (n2) {
5573  arg2= (ptr_psi_term )n2->data;
5574  deref(arg2);
5575  }
5576  deref_args(g,set_1_2);
5577 
5578  if (success) {
5579  if (n1) {
5580  if (overlap_type(arg1->type,quoted_string))
5581  if (arg1->value_3)
5582  c_arg1= (char *)arg1->value_3;
5583  else {
5584  success=FALSE;
5585  Errorline("bad argument in %P.\n",g);
5586  }
5587  else
5588  success=FALSE;
5589  }
5590  else {
5591  success=FALSE;
5592  Errorline("bad argument in %P.\n",g);
5593  };
5594  };
5595 
5596  if (success) {
5597  if (n2) {
5598  if (overlap_type(arg2->type,quoted_string))
5599  if (arg2->value_3)
5600  c_arg2= (char *)arg2->value_3;
5601  else {
5602  success=FALSE;
5603  Errorline("bad argument in %P.\n",g);
5604  }
5605  else
5606  success=FALSE;
5607  }
5608  else {
5609  success=FALSE;
5610  Errorline("bad argument in %P.\n",g);
5611  };
5612  };
5613 
5614  if (success)
5615  success=append_files(c_arg1,c_arg2);
5616 
5617  return success;
5618 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
char * two
Definition: def_glob.h:251
GENERIC data
Definition: def_struct.h:185
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
long append_files(char *s1, char *s2)
Definition: built_ins.c:5211
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
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
char * one
Definition: def_glob.h:250
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
static long c_apply ( )
static

Definition at line 1112 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, clear_copy(), curry(), wl_node::data, delete_attr(), deref, deref_ptr, distinct_copy(), distinct_tree(), Errorline(), eval, FALSE, FEATCMP, find(), function_it, functor, wl_definition::keyword, merge_unify(), push_goal(), residuate(), wl_definition::rule, wl_keyword::symbol, top, TRUE, wl_psi_term::type, and wl_definition::type_def.

1113 {
1114  long success=TRUE;
1115  ptr_psi_term funct,other;
1116  ptr_node n,fattr;
1117 
1118  funct=aim->aaaa_1;
1119  deref_ptr(funct);
1121  if (n) {
1122  other=(ptr_psi_term )n->data;
1123  deref(other);
1124  if (other->type==top)
1125  residuate(other);
1126  else
1127  if(other->type && other->type->type_def!=(def_type)function_it) {
1128  success=FALSE;
1129  Errorline("argument is not a function in %P.\n",funct);
1130  }
1131  else {
1132  /* What we really want here is to merge all attributes in */
1133  /* funct->attr_list, except '*functor*', into other->attr_list. */
1134  clear_copy();
1135  other=distinct_copy(other);
1136  fattr=distinct_tree(funct->attr_list); /* Make distinct copy: PVR */
1137  push_goal(eval,other,aim->bbbb_1,(GENERIC)other->type->rule);
1138  merge_unify(&(other->attr_list),fattr);
1139  /* We don't want to remove anything from funct->attr_list here. */
1141  }
1142  }
1143  else
1144  curry();
1145 
1146  return success;
1147 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define function_it
Definition: def_const.h:362
#define FEATCMP
Definition: def_const.h:257
void clear_copy()
Definition: copy.c:52
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void merge_unify(ptr_node *u, ptr_node v)
Definition: login.c:1070
void delete_attr(char *s, ptr_node *n)
Definition: trees.c:466
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
ptr_definition top
Definition: def_glob.h:106
void curry()
Definition: lefun.c:157
ptr_node distinct_tree(ptr_node t)
Definition: copy.c:334
char * symbol
Definition: def_struct.h:91
#define eval
Definition: def_const.h:278
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition functor
Definition: def_glob.h:91
ptr_psi_term distinct_copy(ptr_psi_term t)
Definition: copy.c:358
#define TRUE
Definition: def_const.h:127
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
long c_args ( )

Definition at line 5777 of file built_ins.c.

References aim, arg_c, arg_v, wl_goal::bbbb_1, heap_copy_string(), NULL, push_goal(), quoted_string, stack_cons(), stack_nil(), stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

5778 {
5779  ptr_psi_term result,list,str;
5780  long success=TRUE;
5781  int i;
5782 
5783  result=aim->bbbb_1;
5784 
5785  list=stack_nil();
5786  for(i=arg_c-1;i>=0;i--) {
5787  str=stack_psi_term(0);
5788  str->type=quoted_string;
5790  list=stack_cons((ptr_psi_term)str,(ptr_psi_term)list);
5791  }
5792  push_goal(unify,result,list,NULL);
5793 
5794  return success;
5795 }
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
Definition: built_ins.c:47
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
char * heap_copy_string(char *s)
Definition: trees.c:147
#define TRUE
Definition: def_const.h:127
int arg_c
Definition: def_glob.h:5
ptr_definition quoted_string
Definition: def_glob.h:101
char * arg_v[10]
Definition: def_glob.h:6
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term stack_nil()
Definition: built_ins.c:29
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
static long c_ascii ( )
static

Definition at line 4497 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), matches(), quoted_string, REAL, residuate(), set_1, TRUE, wl_psi_term::type, unify_real_result(), and wl_psi_term::value_3.

4498 {
4499  long success=TRUE;
4500  ptr_psi_term arg1,arg2,funct,result;
4501  long smaller;
4502  // long num1;
4503  // REAL val1;
4504 
4505  funct=aim->aaaa_1;
4506  deref_ptr(funct);
4507  result=aim->bbbb_1;
4508  deref(result);
4509 
4510  /* success=get_real_value(result,&val1,&num1); */
4511  /* if (success) { */
4512  get_two_args(funct->attr_list,&arg1,&arg2);
4513  if (arg1) {
4514  deref(arg1);
4515  deref_args(funct,set_1);
4516  success=matches(arg1->type,quoted_string,&smaller);
4517  if (success) {
4518  if (arg1->value_3) {
4519  (void) unify_real_result(result,(REAL)(*((unsigned char *)arg1->value_3)));
4520  }
4521  else
4522  residuate(arg1);
4523  }
4524  else {/* RM: Feb 18 1994 */
4525  success=FALSE;
4526  Errorline("String argument expected in '%P'\n",funct);
4527  }
4528  /*
4529  else {
4530  success=TRUE;
4531  unify_real_result(result,(REAL)(*((unsigned char *)arg1->type->keyword->symbol)));
4532  }
4533  */
4534  }
4535  else
4536  curry();
4537  /* } */
4538 
4539  return success;
4540 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define REAL
Definition: def_const.h:72
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
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
#define deref_args(P, S)
Definition: def_macro.h:145
long unify_real_result(ptr_psi_term t, REAL v)
Definition: built_ins.c:371
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
static long c_assert_first ( )
static

Definition at line 2242 of file built_ins.c.

References wl_goal::aaaa_1, aim, assert_clause(), assert_first, assert_ok, wl_psi_term::attr_list, bk_mark_quote(), deref_ptr, encode_types(), Errorline(), FALSE, get_one_arg(), and TRUE.

2243 {
2244  long success=FALSE;
2245  ptr_psi_term arg1,g;
2246 
2247  g=aim->aaaa_1;
2248  bk_mark_quote(g); /* RM: Apr 7 1993 */
2249  get_one_arg(g->attr_list,&arg1);
2251  if (arg1) {
2252  deref_ptr(arg1);
2253  assert_clause(arg1);
2254  encode_types();
2255  success=assert_ok;
2256  }
2257  else {
2258  success=FALSE;
2259  Errorline("bad clause in %P.\n",g);
2260  }
2261 
2262  return success;
2263 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long assert_first
Definition: def_glob.h:58
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
long assert_ok
Definition: def_glob.h:59
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
void bk_mark_quote(ptr_psi_term t)
Definition: copy.c:630
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
void encode_types()
Definition: types.c:1015
ptr_node attr_list
Definition: def_struct.h:171
void assert_clause(ptr_psi_term t)
Definition: login.c:267
static long c_assert_last ( )
static

Definition at line 2270 of file built_ins.c.

References wl_goal::aaaa_1, aim, assert_clause(), assert_first, assert_ok, wl_psi_term::attr_list, bk_mark_quote(), deref_ptr, encode_types(), Errorline(), FALSE, and get_one_arg().

2271 {
2272  long success=FALSE;
2273  ptr_psi_term arg1,g;
2274 
2275  g=aim->aaaa_1;
2276  bk_mark_quote(g); /* RM: Apr 7 1993 */
2277  get_one_arg(g->attr_list,&arg1);
2279  if (arg1) {
2280  deref_ptr(arg1);
2281  assert_clause(arg1);
2282  encode_types();
2283  success=assert_ok;
2284  }
2285  else {
2286  success=FALSE;
2287  Errorline("bad clause in %P.\n",g);
2288  }
2289 
2290  return success;
2291 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long assert_first
Definition: def_glob.h:58
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
long assert_ok
Definition: def_glob.h:59
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
void bk_mark_quote(ptr_psi_term t)
Definition: copy.c:630
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
void encode_types()
Definition: types.c:1015
ptr_node attr_list
Definition: def_struct.h:171
void assert_clause(ptr_psi_term t)
Definition: login.c:267
static long c_assign ( )
static

Definition at line 4078 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, clear_copy(), deref_args, deref_ptr, deref_rec, Errorline(), exact_copy(), FALSE, get_two_args(), HEAP, heap_pointer, set_1_2, and TRUE.

4079 {
4080  long success=FALSE;
4081  ptr_psi_term arg1,arg2,g; // perm ,smallest;
4082 
4083  g=aim->aaaa_1;
4084  deref_ptr(g);
4085  get_two_args(g->attr_list,&arg1,&arg2);
4086  if (arg1 && arg2) {
4087  success=TRUE;
4088  deref_ptr(arg1);
4089  deref_rec(arg2); /* 17.9 */
4090  /* deref(arg2); 17.9 */
4091  deref_args(g,set_1_2);
4092  if ((GENERIC)arg1<heap_pointer || arg1!=arg2) {
4093  clear_copy();
4094  *arg1 = *exact_copy(arg2,HEAP);
4095  }
4096  }
4097  else
4098  Errorline("argument missing in %P.\n",g);
4099 
4100  return success;
4101 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define HEAP
Definition: def_const.h:147
void clear_copy()
Definition: copy.c:52
ptr_psi_term exact_copy(ptr_psi_term t, long heap_flag)
Definition: copy.c:195
#define deref_rec(P)
Definition: def_macro.h:144
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
GENERIC heap_pointer
Definition: def_glob.h:12
#define deref_args(P, S)
Definition: def_macro.h:145
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_bk_assign ( )
static

Definition at line 4020 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, c_abort(), wl_psi_term::coref, deref, deref_args, deref_ptr, deref_rec, Errorline(), FALSE, get_two_args(), heap_pointer, push_psi_ptr_value(), release_resid(), release_resid_notrail(), set_1_2, trail_condition(), and TRUE.

4021 {
4022  long success=FALSE;
4023  ptr_psi_term arg1,arg2,g;
4024 
4025  g=aim->aaaa_1;
4026  deref_ptr(g);
4027  get_two_args(g->attr_list,&arg1,&arg2);
4028  if (arg1 && arg2) {
4029  success=TRUE;
4030  deref(arg1);
4031  deref_rec(arg2); /* 17.9 */
4032  /* deref(arg2); 17.9 */
4033  deref_args(g,set_1_2);
4034  if (arg1 != arg2) {
4035 
4036  /* RM: Mar 10 1993 */
4037  if((GENERIC)arg1>=heap_pointer) {
4038  Errorline("cannot use '<-' on persistent value in %P\n",g);
4039  return c_abort();
4040  }
4041 
4042 
4043 #ifdef TS
4044  if (!trail_condition(arg1)) {
4045  /* If no trail, then can safely overwrite the psi-term */
4046  release_resid_notrail(arg1);
4047  *arg1 = *arg2;
4048  push_psi_ptr_value(arg2,(GENERIC *)&(arg2->coref)); /* 14.12 */
4049  arg2->coref=arg1; /* 14.12 */
4050  }
4051  else {
4052  push_psi_ptr_value(arg1,(GENERIC *)&(arg1->coref));
4053  arg1->coref=arg2;
4054  release_resid(arg1);
4055  }
4056 #else
4057  push_psi_ptr_value(arg1,(GENERIC *)&(arg1->coref));
4058  arg1->coref=arg2;
4059  release_resid(arg1);
4060 #endif
4061  }
4062  }
4063  else
4064  Errorline("argument missing in %P.\n",g);
4065 
4066  return success;
4067 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long trail_condition(psi_term *Q)
Definition: login.c:2490
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
Definition: login.c:443
#define deref_rec(P)
Definition: def_macro.h:144
long c_abort()
Definition: built_ins.c:2117
void release_resid(ptr_psi_term t)
Definition: lefun.c:414
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
void release_resid_notrail(ptr_psi_term t)
Definition: lefun.c:420
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
ptr_psi_term coref
Definition: def_struct.h:172
GENERIC heap_pointer
Definition: def_glob.h:12
#define deref_args(P, S)
Definition: def_macro.h:145
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_boolpred ( )
static

Definition at line 815 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, c_abort(), DEFRULES, deref, deref_args, deref_ptr, Errorline(), FALSE, get_one_arg(), lf_false, lf_true, matches(), NULL, predicate, prove, push_goal(), residuate(), set_1, sub_type(), TRUE, wl_psi_term::type, and wl_definition::type_def.

816 {
817  long success=TRUE,succ,lesseq;
818  ptr_psi_term t,arg1;
819 
820  t=aim->aaaa_1;
821  deref_ptr(t);
822  get_one_arg(t->attr_list,&arg1);
823  if (arg1) {
824  deref(arg1);
825  deref_args(t,set_1);
826  if (sub_type(boolean,arg1->type)) {
827  residuate(arg1);
828  }
829  else {
830  succ=matches(arg1->type,lf_true,&lesseq);
831  if (succ) {
832  if (lesseq) {
833  /* Function returns lf_true: success. */
834  }
835  else
836  residuate(arg1);
837  }
838  else {
839  succ=matches(arg1->type,lf_false,&lesseq);
840  if (succ) {
841  if (lesseq) {
842  /* Function returns lf_false: failure. */
843  success=FALSE;
844  }
845  else
846  residuate(arg1);
847  }
848  else {
849  /* Both lf_true and false are disentailed. */
850  if (arg1->type->type_def==(def_type)predicate) {
852  }
853  else {
854  Errorline("function result '%P' should be a boolean or a predicate.\n",
855  arg1);
856  return (c_abort());
857  }
858  }
859  }
860  }
861  }
862  else {
863  Errorline("missing argument to '*boolpred*'.\n");
864  return (c_abort());
865  }
866 
867  return success;
868 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define predicate
Definition: def_const.h:361
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
def_type type_def
Definition: def_struct.h:133
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#define DEFRULES
Definition: def_const.h:138
long c_abort()
Definition: built_ins.c:2117
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
#define NULL
Definition: def_const.h:203
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
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
static long c_call ( )
static

Definition at line 3971 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, choice_stack, curry(), DEFRULES, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), lf_false, lf_true, NULL, prove, push_choice_point(), push_goal(), resid_aim, residuate(), set_1, stack_psi_term(), top, TRUE, wl_psi_term::type, and unify.

3972 {
3973  long success=TRUE;
3974  ptr_psi_term arg1,arg2,funct,result,other;
3975  ptr_choice_point cutpt;
3976 
3977  funct=aim->aaaa_1;
3978  deref_ptr(funct);
3979  result=aim->bbbb_1;
3980  get_two_args(funct->attr_list,&arg1,&arg2);
3981  if (arg1) {
3982  deref_ptr(arg1);
3983  deref_args(funct,set_1);
3984  if(arg1->type==top)
3985  residuate(arg1);
3986  else
3987  if(FALSE /*arg1->type->type_def!=predicate*/) {
3988  success=FALSE;
3989  Errorline("argument of %P should be a predicate.\n",funct);
3990  }
3991  else {
3992  resid_aim=NULL;
3993  cutpt=choice_stack;
3994 
3995  /* Result is FALSE */
3996  other=stack_psi_term(0);
3997  other->type=lf_false;
3998 
3999  push_choice_point(unify,result,other,NULL);
4000 
4001  /* Result is TRUE */
4002  other=stack_psi_term(0);
4003  other->type=lf_true;
4004 
4005  push_goal(unify,result,other,NULL);
4007  }
4008  }
4009  else
4010  curry();
4011 
4012  return success;
4013 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
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
#define DEFRULES
Definition: def_const.h:138
#define set_1
Definition: def_const.h:194
ptr_definition top
Definition: def_glob.h:106
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define FALSE
Definition: def_const.h:128
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
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
ptr_choice_point choice_stack
Definition: def_glob.h:51
static long c_char ( )
static

Definition at line 4443 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), heap_alloc(), integer, NULL, overlap_type(), push_goal(), quoted_string, REAL, residuate(), set_1, stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

4446 {
4447  long success=TRUE;
4448  ptr_psi_term arg1,arg2,funct,result;
4449  // long smaller;
4450  // long num1;
4451  // REAL val1;
4452  char *str;
4453 
4454  funct=aim->aaaa_1;
4455  deref_ptr(funct);
4456  result=aim->bbbb_1;
4457  deref(result);
4458 
4459  get_two_args(funct->attr_list,&arg1,&arg2);
4460  if (arg1) {
4461  deref(arg1);
4462  deref_args(funct,set_1);
4463  if (overlap_type(arg1->type,integer)) {
4464  if (arg1->value_3) {
4465  ptr_psi_term t;
4466 
4467  t=stack_psi_term(4);
4468  t->type=quoted_string;
4469  str=(char *)heap_alloc(2);
4470  str[0] = (unsigned char) floor(*(REAL *) arg1->value_3);
4471  str[1] = 0;
4472  t->value_3=(GENERIC)str;
4473 
4474  push_goal(unify,t,result,NULL);
4475  }
4476  else
4477  residuate(arg1);
4478  }
4479  else {
4480  Errorline("argument of %P must be an integer.\n",funct);
4481  success=FALSE;
4482  }
4483  }
4484  else
4485  curry();
4486 
4487  return success;
4488 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
#define REAL
Definition: def_const.h:72
void Errorline(char *format,...)
Definition: error.c:414
#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
#define deref(P)
Definition: def_macro.h:142
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
GENERIC heap_alloc(long s)
Definition: memory.c:1518
static long c_chdir ( )
static

Definition at line 3886 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), expand_file_name(), FALSE, get_two_args(), matches(), quoted_string, wl_psi_term::type, and wl_psi_term::value_3.

3887 {
3888  long success=FALSE;
3889  ptr_psi_term arg1,arg2,funct; // result, t;
3890  // double val;
3891  // int num;
3892  long smaller;
3893 
3894 
3895  funct = aim->aaaa_1;
3896  deref_ptr(funct);
3897 
3898  get_two_args(funct->attr_list, &arg1, &arg2);
3899  if(arg1) {
3900  deref_ptr(arg1);
3901  if(matches(arg1->type,quoted_string,&smaller) && arg1->value_3)
3902  success=!chdir(expand_file_name((char *)arg1->value_3));
3903  else
3904  Errorline("bad argument in %P\n",funct);
3905  }
3906  else
3907  Errorline("argument missing in %P\n",funct);
3908 
3909  return success;
3910 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#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_definition type
Definition: def_struct.h:165
char * expand_file_name(char *s)
Definition: token.c:449
ptr_node attr_list
Definition: def_struct.h:171
static long c_clause ( )
static

Definition at line 2366 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, FALSE, get_two_args(), and pred_clause().

2367 {
2368  long success=FALSE;
2369  ptr_psi_term arg1,arg2,g;
2370 
2371  g=aim->aaaa_1;
2372  get_two_args(g->attr_list,&arg1,&arg2);
2373  success=pred_clause(arg1,0,g);
2374  return success;
2375 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long pred_clause(ptr_psi_term t, long r, ptr_psi_term g)
Definition: built_ins.c:2300
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
ptr_node attr_list
Definition: def_struct.h:171
static long c_close ( )
static

Definition at line 2743 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_node::data, deref, deref_args, deref_ptr, equal_types, Errorline(), FALSE, FEATCMP, find(), get_two_args(), input_stream, inputfilesym, NULL, open_input_file(), open_output_file(), output_stream, set_1, stream, STREAM, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

2744 {
2745  long success=FALSE;
2746  long inclose,outclose;
2747  ptr_psi_term arg1,arg2,g; // ,s;
2748 
2749  g=aim->aaaa_1;
2750  deref_ptr(g);
2751  get_two_args(g->attr_list,&arg1,&arg2);
2752  if (arg1) {
2753  deref(arg1);
2754  deref_args(g,set_1);
2755  /*
2756  if (sub_type(arg1->type,sys_stream))
2757  return sys_close(arg1);
2758  */
2759  outclose=equal_types(arg1->type,stream) && arg1->value_3;
2760  inclose=FALSE;
2761  if (equal_types(arg1->type,inputfilesym)) {
2763  if (n) {
2764  arg1=(ptr_psi_term)n->data;
2765  inclose=(arg1->value_3!=NULL);
2766  }
2767  }
2768 
2769  if (inclose || outclose) {
2770  success=TRUE;
2771  (void)fclose((FILE *)arg1->value_3);
2772 
2773  if (inclose && (FILE *)arg1->value_3==input_stream)
2774  (void)open_input_file("stdin");
2775  else if (outclose && (FILE *)arg1->value_3==output_stream)
2776  (void)open_output_file("stdout");
2777 
2778  arg1->value_3=NULL;
2779  }
2780  else
2781  Errorline("bad stream in %P.\n",g);
2782  }
2783  else
2784  Errorline("no stream in %P.\n",g);
2785 
2786  return success;
2787 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long open_output_file(char *file)
#define FEATCMP
Definition: def_const.h:257
ptr_definition stream
Definition: def_glob.h:103
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define STREAM
Definition: def_const.h:225
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
FILE * input_stream
Definition: def_glob.h:38
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define equal_types(A, B)
Definition: def_macro.h:106
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
FILE * output_stream
Definition: def_glob.h:41
ptr_definition type
Definition: def_struct.h:165
ptr_definition inputfilesym
Definition: def_glob.h:120
ptr_node attr_list
Definition: def_struct.h:171
long open_input_file(char *file)
Definition: token.c:504
static long c_combined_name ( )
static

Definition at line 5357 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, wl_keyword::combined_name, curry(), deref_ptr, get_two_args(), heap_copy_string(), wl_definition::keyword, NULL, push_goal(), quoted_string, stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

5358 {
5359  long success=TRUE;
5360  ptr_psi_term arg1,arg2,funct,result;
5361 
5362 
5363  funct=aim->aaaa_1;
5364  result=aim->bbbb_1;
5365  deref_ptr(funct);
5366  deref_ptr(result);
5367 
5368  get_two_args(funct->attr_list,&arg1,&arg2);
5369 
5370  if (arg1) {
5371  deref_ptr(arg1);
5372  arg2=stack_psi_term(0);
5373  arg2->type=quoted_string;
5375  push_goal(unify,arg2,result,NULL);
5376  }
5377  else
5378  curry();
5379 
5380  return success;
5381 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
char * combined_name
Definition: def_struct.h:92
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
ptr_keyword keyword
Definition: def_struct.h:124
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
char * heap_copy_string(char *s)
Definition: trees.c:147
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
long c_concatenate ( )

Definition at line 5245 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), wl_node::data, deref, deref_args, deref_ptr, FALSE, FEATCMP, find(), one, overlap_type(), quoted_string, residuate(), set_1_2, TRUE, two, wl_psi_term::type, and wl_psi_term::value_3.

5246 {
5247  ptr_psi_term result,funct,temp_result;
5248  ptr_node n1, n2;
5249  long success=TRUE;
5250  long all_args=TRUE;
5251  char * c_result;
5252  ptr_psi_term arg1;
5253  char * c_arg1;
5254  ptr_psi_term arg2;
5255  char * c_arg2;
5256 
5257  funct=aim->aaaa_1;
5258  deref_ptr(funct);
5259  result=aim->bbbb_1;
5260 
5261  /* Evaluate all arguments first: */
5262  n1=find(FEATCMP,one,funct->attr_list);
5263  if (n1) {
5264  arg1= (ptr_psi_term )n1->data;
5265  deref(arg1);
5266  }
5267  n2=find(FEATCMP,two,funct->attr_list);
5268  if (n2) {
5269  arg2= (ptr_psi_term )n2->data;
5270  deref(arg2);
5271  }
5272  deref_args(funct,set_1_2);
5273 
5274  if (success) {
5275  if (n1) {
5276  if (overlap_type(arg1->type,quoted_string)) /* 10.8 */
5277  if (arg1->value_3)
5278  c_arg1= (char *)arg1->value_3;
5279  else {
5280  residuate(arg1);
5281  all_args=FALSE;
5282  }
5283  else
5284  success=FALSE;
5285  }
5286  else {
5287  all_args=FALSE;
5288  curry();
5289  };
5290  };
5291 
5292  if (success) {
5293  if (n2) {
5294  if (overlap_type(arg2->type,quoted_string)) /* 10.8 */
5295  if (arg2->value_3)
5296  c_arg2= (char *)arg2->value_3;
5297  else {
5298  residuate(arg2);
5299  all_args=FALSE;
5300  }
5301  else
5302  success=FALSE;
5303  }
5304  else {
5305  all_args=FALSE;
5306  curry();
5307  }
5308  }
5309 
5310  if(success && all_args) {
5311  c_result=str_conc( c_arg1, c_arg2 );
5312  temp_result=stack_psi_term(0);
5313  temp_result->type=quoted_string;
5314  temp_result->value_3= (GENERIC)c_result;
5315  push_goal(unify,temp_result,result,NULL);
5316  }
5317 
5318  return success;
5319 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
char * two
Definition: def_glob.h:251
GENERIC data
Definition: def_struct.h:185
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
char * one
Definition: def_glob.h:250
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
char * str_conc(char *s1, char *s2)
Definition: built_ins.c:5171
ptr_node attr_list
Definition: def_struct.h:171
static long c_cond ( )
static

Definition at line 3172 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, calloncesym, curry(), wl_node::data, deref, deref_args, deref_ptr, Errorline(), FEATCMP, find(), get_bool_value(), get_one_arg_addr(), goal_stack, i_check_out(), wl_node::key, wl_node::left, lf_true, NULL, one, predicate, psi_term_ptr, push_goal(), push_ptr_value(), REAL, resid_aim, residuate(), wl_node::right, set_1_2_3, STACK_ALLOC, stack_psi_term(), three, TRUE, two, wl_psi_term::type, wl_definition::type_def, and unify.

3173 {
3174  long success=TRUE;
3175  ptr_psi_term arg1,arg2,result,g;
3176  ptr_psi_term *arg1addr;
3177  REAL val1;
3178  long num1;
3179  ptr_node n;
3180 
3181  g=aim->aaaa_1;
3182  deref_ptr(g);
3183  result=aim->bbbb_1;
3184  deref(result);
3185 
3186  get_one_arg_addr(g->attr_list,&arg1addr);
3187  if (arg1addr) {
3188  arg1= *arg1addr;
3189  deref_ptr(arg1);
3190  if (arg1->type->type_def==(def_type)predicate) {
3191  ptr_psi_term call_once;
3192  ptr_node ca;
3193 
3194  /* Transform cond(pred,...) into cond(call_once(pred),...) */
3195  goal_stack=aim;
3196  call_once=stack_psi_term(0);
3197  call_once->type=calloncesym;
3198  call_once->attr_list=(ca=STACK_ALLOC(node));
3199  ca->key=one;
3200  ca->left=ca->right=NULL;
3201  ca->data=(GENERIC)arg1;
3202  push_ptr_value(psi_term_ptr,(GENERIC *)arg1addr);
3203  *arg1addr=call_once;
3204  return success;
3205  }
3206  deref(arg1);
3207  deref_args(g,set_1_2_3);
3208  success=get_bool_value(arg1,&val1,&num1);
3209  if (success) {
3210  if (num1) {
3211  resid_aim=NULL;
3212  n=find(FEATCMP,(val1?two:three),g->attr_list);
3213  if (n) {
3214  arg2=(ptr_psi_term)n->data;
3215  /* mark_eval(arg2); XXX 24.8 */
3216  push_goal(unify,result,arg2,NULL);
3217  (void)i_check_out(arg2);
3218  }
3219  else {
3220  ptr_psi_term trueterm;
3221  trueterm=stack_psi_term(4);
3222  trueterm->type=lf_true;
3223  push_goal(unify,result,trueterm,NULL);
3224  }
3225  }
3226  else
3227  residuate(arg1);
3228  }
3229  else /* RM: Apr 15 1993 */
3230  Errorline("argument to cond is not boolean in %P\n",g);
3231  }
3232  else
3233  curry();
3234 
3235  return success;
3236 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define predicate
Definition: def_const.h:361
void get_one_arg_addr(ptr_node t, ptr_psi_term **a)
Definition: login.c:115
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
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
char * two
Definition: def_glob.h:251
def_type type_def
Definition: def_struct.h:133
GENERIC data
Definition: def_struct.h:185
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
char * three
Definition: def_glob.h:252
ptr_goal resid_aim
Definition: def_glob.h:220
#define REAL
Definition: def_const.h:72
ptr_node left
Definition: def_struct.h:183
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
char * key
Definition: def_struct.h:182
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define deref(P)
Definition: def_macro.h:142
#define set_1_2_3
Definition: def_const.h:197
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition calloncesym
Definition: def_glob.h:76
ptr_goal aim
Definition: def_glob.h:49
char * one
Definition: def_glob.h:250
#define STACK_ALLOC(A)
Definition: def_macro.h:16
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:284
ptr_node attr_list
Definition: def_struct.h:171
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
ptr_node right
Definition: def_struct.h:184
#define psi_term_ptr
Definition: def_const.h:170
static long c_copy_pointer ( )
static

Definition at line 4207 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, copy_attr_list(), curry(), deref, deref_args, deref_ptr, get_one_arg(), NULL, push_goal(), set_1, stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

4208 {
4209  long success=TRUE;
4210  ptr_psi_term funct,arg1,result,other;
4211 
4212  funct=aim->aaaa_1;
4213  deref_ptr(funct);
4214  get_one_arg(funct->attr_list,&arg1);
4215  if (arg1) {
4216  deref(arg1);
4217  deref_args(funct,set_1);
4218  other=stack_psi_term(4);
4219  other->type=arg1->type;
4220  other->value_3=arg1->value_3;
4221  other->attr_list=copy_attr_list(arg1->attr_list); /* PVR 23.2.94 */
4222  result=aim->bbbb_1;
4223  push_goal(unify,other,result,NULL);
4224  }
4225  else
4226  curry();
4227 
4228  return success;
4229 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
static ptr_node copy_attr_list(ptr_node n)
Definition: built_ins.c:3550
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
static long c_copy_term ( )
static

Definition at line 4237 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, clear_copy(), curry(), deref, deref_args, deref_ptr, exact_copy(), get_one_arg(), NULL, push_goal(), set_1, STACK, TRUE, and unify.

4238 {
4239  long success=TRUE;
4240  ptr_psi_term funct,arg1,copy_arg1,result;
4241 
4242  funct=aim->aaaa_1;
4243  deref_ptr(funct);
4244  get_one_arg(funct->attr_list,&arg1);
4245  if (arg1) {
4246  deref(arg1);
4247  deref_args(funct,set_1);
4248  result=aim->bbbb_1;
4249  clear_copy();
4250  copy_arg1=exact_copy(arg1,STACK);
4251  push_goal(unify,copy_arg1,result,NULL);
4252  }
4253  else
4254  curry();
4255 
4256  return success;
4257 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void clear_copy()
Definition: copy.c:52
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
ptr_psi_term exact_copy(ptr_psi_term t, long heap_flag)
Definition: copy.c:195
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
#define STACK
Definition: def_const.h:148
static long c_declaration ( )
static

Definition at line 2172 of file built_ins.c.

References wl_goal::aaaa_1, aim, deref_ptr, Errorline(), and FALSE.

2173 {
2174  ptr_psi_term t;
2175 
2176  t=aim->aaaa_1;
2177  deref_ptr(t);
2178  Errorline("%P is a declaration, not a query.\n",t);
2179  return FALSE;
2180 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
static long c_delay_check ( )
static

Definition at line 1580 of file built_ins.c.

References wl_goal::aaaa_1, aim, assert_delay_check(), wl_psi_term::attr_list, deref_ptr, inherit_always_check(), and TRUE.

1581 {
1582  ptr_psi_term t=aim->aaaa_1;
1583 
1584  deref_ptr(t);
1585  /* mark_quote(t); 14.9 */
1588  return TRUE;
1589 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void assert_delay_check(ptr_node n)
Definition: types.c:303
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
void inherit_always_check()
Definition: types.c:994
ptr_node attr_list
Definition: def_struct.h:171
long c_deref_length ( )

Definition at line 5743 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, wl_psi_term::coref, curry(), wl_node::data, deref_ptr, FEATCMP, find(), one, REAL, TRUE, and unify_real_result().

5744 {
5745  ptr_psi_term result,funct;
5746  long success=TRUE;
5747  int count;
5748  ptr_psi_term arg1; // ,arg2;
5749  ptr_node n1;
5750 
5751  funct=aim->aaaa_1;
5752  deref_ptr(funct);
5753  result=aim->bbbb_1;
5754 
5755  n1=find(FEATCMP,one,funct->attr_list);
5756  if (n1) {
5757  count=0;
5758  arg1= (ptr_psi_term )n1->data;
5759  while(arg1->coref) {
5760  count++;
5761  arg1=arg1->coref;
5762  }
5763  success=unify_real_result(result,(REAL)count);
5764  }
5765  else
5766  curry();
5767 
5768  return success;
5769 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
void curry()
Definition: lefun.c:157
#define REAL
Definition: def_const.h:72
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
ptr_psi_term coref
Definition: def_struct.h:172
char * one
Definition: def_glob.h:250
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
long unify_real_result(ptr_psi_term t, REAL v)
Definition: built_ins.c:371
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
static long c_diff ( )
static

Definition at line 1257 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, FALSE, get_bool_value(), get_real_value(), get_two_args(), nonnum_warning(), REAL, residuate(), residuate2(), set_1_2, TRUE, unify_bool_result(), and unify_real_result().

1258 {
1259  long success=TRUE;
1260  ptr_psi_term arg1,arg2,arg3,t;
1261  long num1,num2,num3;
1262  REAL val1,val2,val3;
1263 
1264  t=aim->aaaa_1;
1265  deref_ptr(t);
1266  get_two_args(t->attr_list,&arg1,&arg2);
1267  arg3=aim->bbbb_1;
1268 
1269  if(arg1) {
1270  deref(arg1);
1271  success=get_real_value(arg1,&val1,&num1);
1272  if(success && arg2) {
1273  deref(arg2);
1274  deref_args(t,set_1_2);
1275  success=get_real_value(arg2,&val2,&num2);
1276  }
1277  }
1278 
1279  if(success)
1280  if(arg1 && arg2) {
1281  deref(arg3);
1282  success=get_bool_value(arg3,&val3,&num3);
1283  if(success)
1284  switch(num1+2*num2+4*num3) {
1285  case 0:
1286  if(arg1==arg2)
1287  unify_bool_result(arg3,FALSE);
1288  else
1289  residuate2(arg1,arg2);
1290  break;
1291  case 1:
1292  residuate2(arg2,arg3);
1293  break;
1294  case 2:
1295  residuate2(arg1,arg3);
1296  break;
1297  case 3:
1298  unify_bool_result(arg3,(val1!=val2));
1299  break;
1300  case 4:
1301  if(arg1==arg2 && val3)
1302  success=FALSE;
1303  else
1304  residuate2(arg1,arg2);
1305  break;
1306  case 5:
1307  if(val3)
1308  residuate(arg2);
1309  else
1310  success=unify_real_result(arg2,val1);
1311  break;
1312  case 6:
1313  if(val3)
1314  residuate(arg1);
1315  else
1316  success=unify_real_result(arg1,val2);
1317  break;
1318  case 7:
1319  success=(val3==(REAL)(val1!=val2));
1320  break;
1321  }
1322  }
1323  else
1324  curry();
1325 
1326  nonnum_warning(t,arg1,arg2);
1327  return success;
1328 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
Definition: lefun.c:157
#define REAL
Definition: def_const.h:72
#define set_1_2
Definition: def_const.h:196
void residuate2(ptr_psi_term u, ptr_psi_term v)
Definition: lefun.c:130
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
long unify_real_result(ptr_psi_term t, REAL v)
Definition: built_ins.c:371
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:284
ptr_node attr_list
Definition: def_struct.h:171
static long c_diff_address ( )
static

Definition at line 3640 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, FALSE, get_bool_value(), get_two_args(), NULL, push_goal(), REAL, resid_aim, set_1_2, TRUE, unify, and unify_bool_result().

3641 {
3642  long success=TRUE;
3643  ptr_psi_term arg1,arg2,funct,result;
3644  REAL val3;
3645  long num3;
3646 
3647  funct=aim->aaaa_1;
3648  deref_ptr(funct);
3649  result=aim->bbbb_1;
3650  get_two_args(funct->attr_list,&arg1,&arg2);
3651 
3652  if (arg1 && arg2) {
3653  success=get_bool_value(result,&val3,&num3);
3654  resid_aim=NULL;
3655  deref(arg1);
3656  deref(arg2);
3657  deref_args(funct,set_1_2);
3658 
3659  if (num3) {
3660  if (val3)
3661  push_goal(unify,arg1,arg2,NULL);
3662  else
3663  success=(arg1==arg2);
3664  }
3665  else
3666  if (arg1==arg2)
3667  unify_bool_result(result,FALSE);
3668  else
3669  unify_bool_result(result,TRUE);
3670  }
3671  else
3672  curry();
3673 
3674  return success;
3675 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define REAL
Definition: def_const.h:72
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:284
ptr_node attr_list
Definition: def_struct.h:171
static long c_disj ( )
static

Definition at line 3143 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, DEFRULES, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), NULL, prove, push_choice_point(), push_goal(), resid_aim, set_1_2, traceline(), and TRUE.

3144 {
3145  long success=TRUE;
3146  ptr_psi_term arg1,arg2,g;
3147 
3148  g=aim->aaaa_1;
3149  resid_aim=NULL;
3150  deref_ptr(g);
3151  get_two_args(g->attr_list,&arg1,&arg2);
3152  deref_args(g,set_1_2);
3153  traceline("pushing predicate disjunction choice point for %P\n",g);
3155  if (arg1) push_goal(prove,arg1,(ptr_psi_term)DEFRULES,(GENERIC)NULL);
3156  if (!arg1 && !arg2) {
3157  success=FALSE;
3158  Errorline("neither first nor second arguments exist in %P.\n",g);
3159  }
3160 
3161  return success;
3162 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
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
#define DEFRULES
Definition: def_const.h:138
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
void traceline(char *format,...)
Definition: error.c:157
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_dynamic ( )
static

Definition at line 1548 of file built_ins.c.

References wl_goal::aaaa_1, aim, assert_protected(), wl_psi_term::attr_list, deref_ptr, FALSE, and TRUE.

1549 {
1550  ptr_psi_term t=aim->aaaa_1;
1551  deref_ptr(t);
1552  /* mark_quote(t); 14.9 */
1554  return TRUE;
1555 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void assert_protected(ptr_node n, long prot)
Definition: types.c:235
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
ptr_node attr_list
Definition: def_struct.h:171
static long c_equal ( )
static

Definition at line 488 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, FALSE, get_bool_value(), get_real_value(), get_two_args(), nonnum_warning(), REAL, residuate(), residuate2(), set_1_2, TRUE, unify_bool_result(), and unify_real_result().

489 {
490  long success=TRUE;
491  ptr_psi_term arg1,arg2,arg3,t;
492  long num1,num2,num3;
493  REAL val1,val2,val3;
494 
495  t=aim->aaaa_1;
496  deref_ptr(t);
497  get_two_args(t->attr_list,&arg1,&arg2);
498  arg3=aim->bbbb_1;
499 
500  if(arg1) {
501  deref(arg1);
502  success=get_real_value(arg1,&val1,&num1);
503  if(success && arg2) {
504  deref(arg2);
505  deref_args(t,set_1_2);
506  success=get_real_value(arg2,&val2,&num2);
507  }
508  }
509 
510  if(success)
511  if(arg1 && arg2) {
512  deref(arg3);
513  success=get_bool_value(arg3,&val3,&num3);
514  if(success)
515  switch(num1+2*num2+4*num3) {
516  case 0:
517  if(arg1==arg2)
518  unify_bool_result(arg3,TRUE);
519  else
520  residuate2(arg1,arg2);
521  break;
522  case 1:
523  residuate2(arg2,arg3);
524  break;
525  case 2:
526  residuate2(arg1,arg3);
527  break;
528  case 3:
529  unify_bool_result(arg3,(val1==val2));
530  break;
531  case 4:
532  if(arg1==arg2 && !val3)
533  success=FALSE;
534  else
535  residuate2(arg1,arg2);
536  break;
537  case 5:
538  if(!val3)
539  residuate(arg2);
540  else
541  success=unify_real_result(arg2,val1);
542  break;
543  case 6:
544  if(!val3)
545  residuate(arg1);
546  else
547  success=unify_real_result(arg1,val2);
548  break;
549  case 7:
550  success=(val3==(REAL)(val1==val2));
551  break;
552  }
553  }
554  else
555  curry();
556 
557  nonnum_warning(t,arg1,arg2);
558  return success;
559 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
Definition: lefun.c:157
#define REAL
Definition: def_const.h:72
#define set_1_2
Definition: def_const.h:196
void residuate2(ptr_psi_term u, ptr_psi_term v)
Definition: lefun.c:130
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
long unify_real_result(ptr_psi_term t, REAL v)
Definition: built_ins.c:371
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:284
ptr_node attr_list
Definition: def_struct.h:171
static long c_eval ( )
static

Definition at line 3683 of file built_ins.c.

References wl_goal::aaaa_1, aim, assert, wl_psi_term::attr_list, wl_goal::bbbb_1, clear_copy(), curry(), deref, deref_args, deref_ptr, eval_copy(), get_two_args(), i_check_out(), NULL, push_goal(), resid_aim, set_1, STACK, TRUE, wl_psi_term::type, and unify.

3684 {
3685  long success=TRUE;
3686  ptr_psi_term arg1, copy_arg1, arg2, funct, result;
3687 
3688  funct = aim->aaaa_1;
3689  deref_ptr(funct);
3690  result = aim->bbbb_1;
3691  deref(result);
3692  get_two_args(funct->attr_list, &arg1, &arg2);
3693  if (arg1) {
3694  deref(arg1);
3695  deref_args(funct,set_1);
3696  assert((unsigned long)(arg1->type)!=4);
3697  clear_copy();
3698  copy_arg1 = eval_copy(arg1,STACK);
3699  resid_aim = NULL;
3700  push_goal(unify,copy_arg1,result,NULL);
3701  (void)i_check_out(copy_arg1);
3702  } else
3703  curry();
3704 
3705  return success;
3706 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void clear_copy()
Definition: copy.c:52
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
Definition: copy.c:205
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
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
#define STACK
Definition: def_const.h:148
#define assert(N)
Definition: memory.c:104
static long c_eval_disjunction ( )
static

Definition at line 569 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, c_abort(), deref_ptr, disj_nil, Errorline(), eval, get_two_args(), i_check_out(), NULL, push_choice_point(), push_goal(), resid_aim, wl_definition::rule, TRUE, wl_psi_term::type, and unify.

571 {
572  ptr_psi_term arg1,arg2,funct,result;
573 
574 
575  funct=aim->aaaa_1;
576  deref_ptr(funct);
577  result=aim->bbbb_1;
578  get_two_args(funct->attr_list,&arg1,&arg2);
579 
580  /* deref_args(funct,set_1_2); Don't know about this */
581 
582  if (arg1 && arg2) {
583  deref_ptr(arg1);
584  deref_ptr(arg2);
585 
586  resid_aim=NULL; /* Function evaluation is over */
587 
588  if(arg2->type!=disj_nil) /* RM: Feb 1 1993 */
589  /* Create the alternative */
590  push_choice_point(eval,arg2,result,(GENERIC)funct->type->rule);
591 
592  /* Unify the result with the first argument */
593  push_goal(unify,result,arg1,NULL);
594  (void)i_check_out(arg1);
595  }
596  else {
597  Errorline("malformed disjunction '%P'\n",funct);
598  return (c_abort());
599  }
600 
601  return TRUE;
602 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
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
long c_abort()
Definition: built_ins.c:2117
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define eval
Definition: def_const.h:278
void Errorline(char *format,...)
Definition: error.c:414
ptr_definition disj_nil
Definition: def_glob.h:85
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_pair_list rule
Definition: def_struct.h:126
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
static long c_eval_inplace ( )
static

Definition at line 3714 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_two_args(), i_check_out(), mark_eval(), NULL, push_goal(), resid_aim, set_1, TRUE, and unify.

3715 {
3716  long success=TRUE;
3717  ptr_psi_term arg1,/* copy_arg1, */ arg2, funct, result;
3718 
3719  funct = aim->aaaa_1;
3720  deref_ptr(funct);
3721  result = aim->bbbb_1;
3722  deref(result);
3723  get_two_args(funct->attr_list, &arg1, &arg2);
3724  if (arg1) {
3725  deref(arg1);
3726  deref_args(funct,set_1);
3727  resid_aim = NULL;
3728  mark_eval(arg1);
3729  push_goal(unify,arg1,result,NULL);
3730  (void)i_check_out(arg1);
3731  } else
3732  curry();
3733 
3734  return success;
3735 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
void mark_eval(ptr_psi_term t)
Definition: copy.c:452
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
static long c_exist_feature ( )
static

Definition at line 3248 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, wl_keyword::combined_name, curry(), wl_node::data, deref, deref_args, deref_ptr, FEATCMP, find(), get_two_args(), heap_copy_string(), integer, wl_definition::keyword, lf_false, lf_true, NULL, wl_keyword::private_feature, push_goal(), quoted_string, REAL, set_1_2, stack_psi_term(), sub_type(), wl_keyword::symbol, three, TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

3249 {
3250  long success=TRUE,v;
3251  ptr_psi_term arg1,arg2,arg3,funct,result,ans;
3252  ptr_node n;
3253  char * label;
3254  /* char *thebuffer="integer"; 18.5 */
3255  char thebuffer[20]; /* Maximum number of digits in an integer */
3256  // char *np1;
3257 
3258  funct=aim->aaaa_1;
3259  deref_ptr(funct);
3260  result=aim->bbbb_1;
3261  get_two_args(funct->attr_list,&arg1,&arg2);
3262 
3263  n=find(FEATCMP,three,funct->attr_list); /* RM: Feb 10 1993 */
3264  if(n)
3265  arg3=(ptr_psi_term)n->data;
3266  else
3267  arg3=NULL;
3268 
3269  if (arg1 && arg2) {
3270  deref(arg1);
3271  deref(arg2);
3272 
3273  if(arg3) /* RM: Feb 10 1993 */
3274  deref(arg3);
3275 
3276  deref_args(funct,set_1_2);
3277  label=NULL;
3278 
3279  if (arg1->value_3 && sub_type(arg1->type,quoted_string))
3280  label=(char *)arg1->value_3;
3281  else if (arg1->value_3 && sub_type(arg1->type,integer)) {
3282  v= *(REAL *)arg1->value_3;
3283  (void)snprintf(thebuffer,20,"%ld",(long)v);
3284  label=heap_copy_string(thebuffer); /* A little voracious */
3285  } else if (arg1->type->keyword->private_feature) {
3286  label=arg1->type->keyword->combined_name;
3287  } else
3288  label=arg1->type->keyword->symbol;
3289 
3290  n=find(FEATCMP,(char *)label,arg2->attr_list);
3291  ans=stack_psi_term(4);
3292  ans->type=(n!=NULL)?lf_true:lf_false;
3293 
3294  if(arg3 && n) /* RM: Feb 10 1993 */
3296 
3297  push_goal(unify,result,ans,NULL);
3298  }
3299  else
3300  curry();
3301 
3302  return success;
3303 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define FEATCMP
Definition: def_const.h:257
char * combined_name
Definition: def_struct.h:92
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
char * three
Definition: def_glob.h:252
char * symbol
Definition: def_struct.h:91
#define REAL
Definition: def_const.h:72
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
char * heap_copy_string(char *s)
Definition: trees.c:147
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition integer
Definition: def_glob.h:93
ptr_definition lf_true
Definition: def_glob.h:107
#define deref(P)
Definition: def_macro.h:142
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
int private_feature
Definition: def_struct.h:95
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_exists ( )
static

Definition at line 1642 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_node::data, deref, deref_args, deref_ptr, Errorline(), FALSE, FEATCMP, file_exists(), find(), one, psi_to_string(), set_1, and TRUE.

1643 {
1644  ptr_psi_term g;
1645  ptr_node n;
1646  long success=TRUE;
1647  ptr_psi_term arg1;
1648  char *c_arg1;
1649 
1650  g=aim->aaaa_1;
1651  deref_ptr(g);
1652 
1653  if (success) {
1654  n=find(FEATCMP,one,g->attr_list);
1655  if (n) {
1656  arg1= (ptr_psi_term )n->data;
1657  deref(arg1);
1658  deref_args(g,set_1);
1659  if (!psi_to_string(arg1,&c_arg1)) {
1660  success=FALSE;
1661  Errorline("bad argument in %P.\n",g);
1662  }
1663  }
1664  else {
1665  success=FALSE;
1666  Errorline("bad argument in %P.\n",g);
1667  }
1668  }
1669 
1670  if (success)
1671  success=file_exists(c_arg1);
1672 
1673  return success;
1674 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
char * one
Definition: def_glob.h:250
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
long file_exists(char *s)
Definition: built_ins.c:1622
ptr_node attr_list
Definition: def_struct.h:171
long psi_to_string(ptr_psi_term t, char **fn)
Definition: built_ins.c:133
static long c_exists_choice ( )
static

Definition at line 1812 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, choice_stack, curry(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_real_value(), get_two_args(), lf_false, lf_true, wl_choice_point::next, NULL, push_goal(), REAL, set_1_2, set_empty, stack_psi_term(), wl_choice_point::time_stamp, TRUE, wl_psi_term::type, and unify.

1813 {
1814  REAL gts_r;
1815  long ans,gts1,gts2,num,success=TRUE;
1816  ptr_psi_term funct,result,arg1,arg2,ans_term;
1817  ptr_choice_point cp;
1818 
1819  funct=aim->aaaa_1;
1820  deref_ptr(funct);
1821  result=aim->bbbb_1;
1822  deref_args(funct,set_empty);
1823  get_two_args(funct->attr_list,&arg1,&arg2);
1824  if (arg1 && arg2) {
1825  deref(arg1);
1826  deref(arg2);
1827  deref_args(funct,set_1_2);
1828  success = get_real_value(arg1,&gts_r,&num);
1829  if (success && num) {
1830  gts1 = (unsigned long) gts_r;
1831  success = get_real_value(arg2,&gts_r,&num);
1832  if (success && num) {
1833  gts2 = (unsigned long) gts_r;
1834  cp = choice_stack;
1835  if (cp) {
1836  while (cp && cp->time_stamp>gts2) cp=cp->next;
1837  ans=(cp && cp->time_stamp>gts1);
1838  }
1839  else
1840  ans=FALSE;
1841  ans_term=stack_psi_term(4);
1842  ans_term->type=ans?lf_true:lf_false;
1843  push_goal(unify,result,ans_term,NULL);
1844  }
1845  else {
1846  Errorline("bad second argument to %P.\n",funct);
1847  success=FALSE;
1848  }
1849  }
1850  else {
1851  Errorline("bad first argument %P.\n",funct);
1852  success=FALSE;
1853  }
1854  }
1855  else
1856  curry();
1857 
1858  return success;
1859 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
#define set_empty
Definition: def_const.h:193
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
unsigned long time_stamp
Definition: def_struct.h:232
ptr_choice_point next
Definition: def_struct.h:235
#define REAL
Definition: def_const.h:72
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
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
ptr_choice_point choice_stack
Definition: def_glob.h:51
static long c_fail ( )
static

Definition at line 1336 of file built_ins.c.

References FALSE.

1337 {
1338  return FALSE;
1339 }
#define FALSE
Definition: def_const.h:128
static long c_feature_values ( )
static

Definition at line 3368 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, current_module, curry(), deref, deref_args, deref_ptr, get_module(), get_two_args(), make_feature_list(), NULL, push_goal(), resid_aim, set_1, stack_nil(), TRUE, and unify.

3369 {
3370  long success=TRUE;
3371  ptr_psi_term arg1,arg2,funct,result;
3372  /* ptr_psi_term the_list; RM: Dec 9 1992
3373  Modified the routine to use 'cons'
3374  instead of the old list representation.
3375  */
3376  /* RM: Mar 11 1993 Added MODULE argument */
3377  ptr_module module=NULL;
3378  ptr_module save_current;
3379 
3380 
3381  funct=aim->aaaa_1;
3382  deref_ptr(funct);
3383  result=aim->bbbb_1;
3384  get_two_args(funct->attr_list,&arg1,&arg2);
3385 
3386 
3387  if(arg2) {
3388  deref(arg2);
3389  success=get_module(arg2,&module);
3390  }
3391  else
3392  module=current_module;
3393 
3394 
3395  if(arg1 && success) {
3396  deref(arg1);
3397  deref_args(funct,set_1);
3398  resid_aim=NULL;
3399 
3400  save_current=current_module;
3401  if(module)
3402  current_module=module;
3403 
3404  push_goal(unify,
3405  result,
3406  make_feature_list(arg1->attr_list,stack_nil(),module,1),
3407  NULL);
3408 
3409  current_module=save_current;
3410  }
3411  else
3412  curry();
3413 
3414  return success;
3415 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
ptr_module current_module
Definition: def_glob.h:161
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
int get_module(ptr_psi_term psi, ptr_module *module)
Definition: modules.c:1207
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_nil()
Definition: built_ins.c:29
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
ptr_psi_term make_feature_list(ptr_node tree, ptr_psi_term tail, ptr_module module, int val)
Definition: built_ins.c:156
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
static long c_features ( )
static

Definition at line 3312 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, current_module, curry(), deref, deref_args, deref_ptr, get_module(), get_two_args(), make_feature_list(), NULL, push_goal(), resid_aim, set_1, stack_nil(), TRUE, and unify.

3313 {
3314  long success=TRUE;
3315  ptr_psi_term arg1,arg2,funct,result;
3316  /* ptr_psi_term the_list; RM: Dec 9 1992
3317  Modified the routine to use 'cons'
3318  instead of the old list representation.
3319  */
3320  /* RM: Mar 11 1993 Added MODULE argument */
3321  ptr_module module=NULL;
3322  ptr_module save_current;
3323 
3324 
3325 
3326 
3327  funct=aim->aaaa_1;
3328  deref_ptr(funct);
3329  result=aim->bbbb_1;
3330  get_two_args(funct->attr_list,&arg1,&arg2);
3331 
3332 
3333  if(arg2) {
3334  deref(arg2);
3335  success=get_module(arg2,&module);
3336  }
3337  else
3338  module=current_module;
3339 
3340 
3341  if(arg1 && success) {
3342  deref(arg1);
3343  deref_args(funct,set_1);
3344  resid_aim=NULL;
3345 
3346  save_current=current_module;
3347  if(module)
3348  current_module=module;
3349 
3350  push_goal(unify,
3351  result,
3352  make_feature_list(arg1->attr_list,stack_nil(),module,0),
3353  NULL);
3354 
3355  current_module=save_current;
3356  }
3357  else
3358  curry();
3359 
3360  return success;
3361 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
ptr_module current_module
Definition: def_glob.h:161
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
int get_module(ptr_psi_term psi, ptr_module *module)
Definition: modules.c:1207
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_nil()
Definition: built_ins.c:29
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
ptr_psi_term make_feature_list(ptr_node tree, ptr_psi_term tail, ptr_module module, int val)
Definition: built_ins.c:156
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
static long c_freeze ( )
static

Definition at line 4423 of file built_ins.c.

References c_freeze_inner(), and TRUE.

4424 {
4425  return c_freeze_inner(TRUE);
4426 }
static long c_freeze_inner(long freeze_flag)
Definition: built_ins.c:4317
#define TRUE
Definition: def_const.h:127
static long c_freeze_inner ( long  freeze_flag)
static

Definition at line 4317 of file built_ins.c.

References wl_goal::aaaa_1, wl_pair_list::aaaa_2, aim, wl_psi_term::attr_list, wl_pair_list::bbbb_2, can_curry, wl_goal::cccc_1, choice_stack, clear_copy(), curried, DEFRULES, deref_args, deref_ptr, Errorline(), eval_copy(), FALSE, freeze_cut, get_one_arg(), implies_cut, match, MAX_BUILT_INS, wl_pair_list::next, NULL, predicate, prove, push_choice_point(), push_goal(), quote_copy(), resid_aim, resid_vars, wl_definition::rule, save_resid(), set_1, STACK, STACK_ALLOC, stack_pointer, wl_psi_term::status, traceline(), TRUE, wl_psi_term::type, and wl_definition::type_def.

4319 {
4320  long success=TRUE;
4321  ptr_psi_term arg1,g;
4322  ptr_psi_term head, body;
4323  ptr_pair_list rule;
4324  /* RESID */ ptr_resid_block rb;
4325  ptr_choice_point cutpt;
4326  ptr_psi_term match_date;
4327 
4328  g=aim->aaaa_1;
4329  deref_ptr(g);
4330  get_one_arg(g->attr_list,&arg1);
4331 
4332  if (arg1) {
4333  deref_ptr(arg1);
4334  /* if (!arg1->type->evaluate_args) mark_quote(arg1); 8.9 */ /* 18.2 PVR */
4335  deref_args(g,set_1);
4336  deref_ptr(arg1);
4337 
4338  if (arg1->type->type_def!=(def_type)predicate) {
4339  success=FALSE;
4340  Errorline("the argument %P of freeze must be a predicate.\n",arg1);
4341  /* main_loop_ok=FALSE; 8.9 */
4342  return success;
4343  }
4344  resid_aim=aim;
4345  match_date=(ptr_psi_term)stack_pointer;
4346  cutpt=choice_stack; /* 13.6 */
4347  /* Third argument of freeze's aim is used to keep track of which */
4348  /* clause is being tried in the frozen goal. */
4349  rule=(ptr_pair_list)aim->cccc_1; /* 8.9 */ /* Isn't aim->cccc always NULL? */
4350  resid_vars=NULL;
4351  curried=FALSE;
4352  can_curry=TRUE; /* 8.9 */
4353 
4354  if (!rule) rule=arg1->type->rule; /* 8.9 */
4355  /* if ((unsigned long)rule==DEFRULES) rule=arg1->type->rule; 8.9 */
4356 
4357  if (rule) {
4358  traceline("evaluate frozen predicate %P\n",g);
4359  /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
4360 
4361  if ((unsigned long)rule<=MAX_BUILT_INS) {
4362  success=FALSE; /* 8.9 */
4363  Errorline("the argument %P of freeze must be user-defined.\n",arg1); /* 8.9 */
4364  return success; /* 8.9 */
4365  /* Removed obsolete stuff here 11.9 */
4366  }
4367  else {
4368  while (rule && (rule->aaaa_2==NULL || rule->bbbb_2==NULL)) {
4369  rule=rule->next;
4370  traceline("alternative clause has been retracted\n");
4371  }
4372  if (rule) {
4373  /* RESID */ rb = STACK_ALLOC(resid_block);
4374  /* RESID */ save_resid(rb,match_date);
4375  /* RESID */ /* resid_aim = NULL; */
4376 
4377  clear_copy();
4378  if (TRUE /*arg1->type->evaluate_args 8.9 */)
4379  head=eval_copy(rule->aaaa_2,STACK);
4380  else
4381  head=quote_copy(rule->aaaa_2,STACK);
4382  body=eval_copy(rule->bbbb_2,STACK);
4383  head->status=4;
4384 
4385  if (rule->next)
4386  /* push_choice_point(prove,g,rule->next,NULL); 8.9 */
4388 
4389  push_goal(prove,body,(ptr_psi_term)DEFRULES,NULL);
4390  if (freeze_flag) /* 12.10 */
4391  push_goal(freeze_cut,body,(ptr_psi_term)cutpt,(GENERIC)rb); /* 13.6 */
4392  else
4393  push_goal(implies_cut,body,(ptr_psi_term)cutpt,(GENERIC)rb);
4394  /* RESID */ push_goal(match,arg1,head,(GENERIC)rb);
4395  /* eval_args(head->attr_list); */
4396  }
4397  else {
4398  success=FALSE;
4399  /* resid_aim=NULL; */
4400  }
4401  }
4402  }
4403  else {
4404  success=FALSE;
4405  /* resid_aim=NULL; */
4406  }
4407  resid_aim=NULL;
4408  resid_vars=NULL; /* 22.9 */
4409  }
4410  else {
4411  success=FALSE;
4412  Errorline("goal missing in %P.\n",g);
4413  }
4414 
4415  /* match_date=NULL; */ /* 13.6 */
4416  return success;
4417 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_psi_term aaaa_2
Definition: def_struct.h:189
#define predicate
Definition: def_const.h:361
void clear_copy()
Definition: copy.c:52
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
#define implies_cut
Definition: def_const.h:281
def_type type_def
Definition: def_struct.h:133
#define DEFRULES
Definition: def_const.h:138
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
#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
void traceline(char *format,...)
Definition: error.c:157
ptr_psi_term quote_copy(ptr_psi_term t, long heap_flag)
Definition: copy.c:200
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define freeze_cut
Definition: def_const.h:280
#define TRUE
Definition: def_const.h:127
#define match
Definition: def_const.h:283
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
struct wl_pair_list * ptr_pair_list
Definition: def_struct.h:36
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
void save_resid(ptr_resid_block rb, ptr_psi_term match_date)
Definition: lefun.c:1256
long can_curry
Definition: def_glob.h:224
long curried
Definition: def_glob.h:223
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
#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_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define STACK
Definition: def_const.h:148
static long c_funct ( )
static

Definition at line 5014 of file built_ins.c.

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

5015 {
5016  long success=TRUE;
5017  ptr_psi_term arg1,arg2,funct;
5018 
5019 
5020  funct=aim->aaaa_1;
5021  deref_ptr(funct);
5022 
5023  get_two_args(funct->attr_list,&arg1,&arg2);
5024 
5025  if (arg1 && arg2) {
5026  deref_args(funct,set_1_2);
5027  }
5028  else
5029  curry();
5030 
5031  return success;
5032 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void curry()
Definition: lefun.c:157
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_node attr_list
Definition: def_struct.h:171
static long c_get ( )
static

Definition at line 2798 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref, deref_args, deref_ptr, eof, eof_flag, Errorline(), FALSE, get_two_args(), heap_alloc(), i_check_out(), integer, NULL, prompt, push_goal(), read_char(), REAL, set_1, stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

2799 {
2800  long success=TRUE;
2801  ptr_psi_term arg1,arg2,g,t;
2802  long c;
2803 
2804  g=aim->aaaa_1;
2805  deref_ptr(g);
2806  get_two_args(g->attr_list,&arg1,&arg2);
2807  if (arg1) {
2808  deref(arg1);
2809  deref_args(g,set_1);
2810 
2811  if (eof_flag) {
2812  success=FALSE;
2813  }
2814  else {
2815  prompt="";
2816  c=read_char();
2817  t=stack_psi_term(0);
2818  if (c==EOF) {
2819  t->type=eof;
2820  eof_flag=TRUE;
2821  }
2822  else {
2823  t->type=integer;
2824  t->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
2825  * (REAL *)t->value_3 = (REAL) c;
2826  }
2827  }
2828 
2829  if (success) {
2830  push_goal(unify,t,arg1,NULL);
2831  (void)i_check_out(t);
2832  }
2833  }
2834  else {
2835  Errorline("argument missing in %P.\n",g);
2836  success=FALSE;
2837  }
2838 
2839  return success;
2840 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
long eof_flag
Definition: def_glob.h:196
#define set_1
Definition: def_const.h:194
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition eof
Definition: def_glob.h:86
#define TRUE
Definition: def_const.h:127
ptr_definition integer
Definition: def_glob.h:93
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
char * prompt
Definition: def_glob.h:42
long read_char()
Definition: token.c:587
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
GENERIC heap_alloc(long s)
Definition: memory.c:1518
static long c_get_choice ( )
static

Definition at line 1720 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_goal::bbbb_1, choice_stack, deref_args, deref_ptr, global_time_stamp, NULL, push_goal(), REAL, real_stack_psi_term(), set_empty, wl_choice_point::time_stamp, TRUE, and unify.

1721 {
1722  long gts,success=TRUE;
1723  ptr_psi_term funct,result;
1724 
1725  funct=aim->aaaa_1;
1726  deref_ptr(funct);
1727  result=aim->bbbb_1;
1728  deref_args(funct,set_empty);
1729  if (choice_stack)
1730  gts=choice_stack->time_stamp;
1731  else
1732  gts=global_time_stamp-1;
1733  /* gts=INIT_TIME_STAMP; PVR 11.2.94 */
1734  push_goal(unify,result,real_stack_psi_term(4,(REAL)gts),NULL);
1735 
1736  return success;
1737 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
Definition: lefun.c:38
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_empty
Definition: def_const.h:193
#define NULL
Definition: def_const.h:203
unsigned long time_stamp
Definition: def_struct.h:232
#define REAL
Definition: def_const.h:72
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
unsigned long global_time_stamp
Definition: login.c:19
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_choice_point choice_stack
Definition: def_glob.h:51
static long c_global ( )
static

Definition at line 2404 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, global_error_check(), and global_tree().

2405 {
2406  int error=FALSE;
2407  int eval_2=FALSE;
2408  ptr_psi_term g;
2409 
2410  g=aim->aaaa_1;
2411  deref_ptr(g);
2412  if (g->attr_list) {
2413  /* Do error check of all arguments first: */
2414  global_error_check(g->attr_list, &error, &eval_2);
2415  if (eval_2) return !error;
2416  /* If no errors, then make the arguments global: */
2417  if (!error)
2418  global_tree(g->attr_list);
2419  } else {
2420  Errorline("argument(s) missing in %P\n",g);
2421  }
2422 
2423  return !error;
2424 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void global_error_check(ptr_node n, int *error, int *eval_2)
Definition: built_ins.c:2428
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
void global_tree(ptr_node n)
Definition: built_ins.c:2466
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
ptr_node attr_list
Definition: def_struct.h:171
static long c_global_assign ( )
static

Definition at line 4112 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, clear_copy(), wl_psi_term::coref, deref_args, deref_ptr, deref_rec, Errorline(), FALSE, get_two_args(), heap_pointer, inc_heap_copy(), push_psi_ptr_value(), set_1_2, and TRUE.

4113 {
4114  long success=FALSE;
4115  ptr_psi_term arg1,arg2,g; // ,perm,smallest;
4116  ptr_psi_term new;
4117 
4118  g=aim->aaaa_1;
4119  deref_ptr(g);
4120  get_two_args(g->attr_list,&arg1,&arg2);
4121  if (arg1 && arg2) {
4122  success=TRUE;
4123  deref_rec(arg1);
4124  deref_rec(arg2);
4125  deref_args(g,set_1_2);
4126  if (arg1!=arg2) {
4127 
4128  clear_copy();
4129  new=inc_heap_copy(arg2);
4130 
4131  if((GENERIC)arg1<heap_pointer) {
4132  push_psi_ptr_value(arg1,(GENERIC *)&(arg1->coref));
4133  arg1->coref= new;
4134  }
4135  else {
4136  *arg1= *new; /* Overwrite in-place */
4137  new->coref=arg1;
4138  }
4139  }
4140  }
4141  else
4142  Errorline("argument missing in %P.\n",g);
4143 
4144  return success;
4145 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void clear_copy()
Definition: copy.c:52
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
Definition: login.c:443
#define deref_rec(P)
Definition: def_macro.h:144
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
ptr_psi_term coref
Definition: def_struct.h:172
GENERIC heap_pointer
Definition: def_glob.h:12
ptr_psi_term inc_heap_copy(ptr_psi_term t)
Definition: copy.c:211
#define deref_args(P, S)
Definition: def_macro.h:145
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_gt ( )
static

Definition at line 422 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_bool_value(), get_real_value(), get_two_args(), nonnum_warning(), REAL, residuate(), residuate2(), set_1_2, TRUE, and unify_bool_result().

423 {
424  long success=TRUE;
425  ptr_psi_term arg1,arg2,arg3,t;
426  long num1,num2,num3;
427  REAL val1,val2,val3;
428 
429  t=aim->aaaa_1;
430  deref_ptr(t);
431  get_two_args(t->attr_list,&arg1,&arg2);
432  arg3=aim->bbbb_1;
433 
434  if (arg1) {
435  deref(arg1);
436  success=get_real_value(arg1,&val1,&num1);
437  if(success && arg2) {
438  deref(arg2);
439  deref_args(t,set_1_2);
440  success=get_real_value(arg2,&val2,&num2);
441  }
442  }
443 
444  if(success)
445  if(arg1 && arg2) {
446  deref(arg3);
447  success=get_bool_value(arg3,&val3,&num3);
448  if(success)
449  switch(num1+num2*2+num3*4) {
450  case 0:
451  residuate2(arg1,arg2);
452  break;
453  case 1:
454  residuate(arg2);
455  break;
456  case 2:
457  residuate(arg1);
458  break;
459  case 3:
460  unify_bool_result(arg3,(val1>val2));
461  break;
462  case 4:
463  residuate2(arg1,arg2);
464  break;
465  case 5:
466  residuate(arg2);
467  break;
468  case 6:
469  residuate(arg1);
470  break;
471  case 7:
472  success=(val3==(REAL)(val1>val2));
473  break;
474  }
475  }
476  else
477  curry();
478 
479  nonnum_warning(t,arg1,arg2);
480  return success;
481 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
Definition: lefun.c:157
#define REAL
Definition: def_const.h:72
#define set_1_2
Definition: def_const.h:196
void residuate2(ptr_psi_term u, ptr_psi_term v)
Definition: lefun.c:130
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:284
ptr_node attr_list
Definition: def_struct.h:171
static long c_gtoe ( )
static

Definition at line 680 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_bool_value(), get_real_value(), get_two_args(), nonnum_warning(), REAL, residuate(), residuate2(), set_1_2, TRUE, and unify_bool_result().

681 {
682  long success=TRUE;
683  ptr_psi_term arg1,arg2,arg3,t;
684  long num1,num2,num3;
685  REAL val1,val2,val3;
686 
687  t=aim->aaaa_1;
688  deref_ptr(t);
689  get_two_args(t->attr_list,&arg1,&arg2);
690  arg3=aim->bbbb_1;
691 
692  if(arg1) {
693  deref(arg1);
694  success=get_real_value(arg1,&val1,&num1);
695  if(success && arg2) {
696  deref(arg2);
697  deref_args(t,set_1_2);
698  success=get_real_value(arg2,&val2,&num2);
699  }
700  }
701 
702  if(success)
703  if(arg1 && arg2) {
704  deref(arg3);
705  success=get_bool_value(arg3,&val3,&num3);
706  if(success)
707  switch(num1+num2*2+num3*4) {
708  case 0:
709  residuate2(arg1,arg2);
710  break;
711  case 1:
712  residuate(arg2);
713  break;
714  case 2:
715  residuate(arg1);
716  break;
717  case 3:
718  unify_bool_result(arg3,(val1>=val2));
719  break;
720  case 4:
721  residuate2(arg1,arg2);
722  break;
723  case 5:
724  residuate(arg2);
725  break;
726  case 6:
727  residuate(arg1);
728  break;
729  case 7:
730  success=(val3==(REAL)(val1>=val2));
731  break;
732  }
733  }
734  else
735  curry();
736 
737  nonnum_warning(t,arg1,arg2);
738  return success;
739 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
Definition: lefun.c:157
#define REAL
Definition: def_const.h:72
#define set_1_2
Definition: def_const.h:196
void residuate2(ptr_psi_term u, ptr_psi_term v)
Definition: lefun.c:130
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:284
ptr_node attr_list
Definition: def_struct.h:171
long c_halt ( )

Definition at line 2084 of file built_ins.c.

References exit_life(), and TRUE.

2085 {
2086  exit_life(TRUE);
2087 }
void exit_life(long nl_flag)
Definition: built_ins.c:2090
#define TRUE
Definition: def_const.h:127
static long c_implies ( )
static

Definition at line 4432 of file built_ins.c.

References c_freeze_inner(), and FALSE.

4433 {
4434  return c_freeze_inner(FALSE);
4435 }
static long c_freeze_inner(long freeze_flag)
Definition: built_ins.c:4317
#define FALSE
Definition: def_const.h:128
long c_initrandom ( )

Definition at line 5690 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_node::data, deref, deref_args, deref_ptr, FALSE, FEATCMP, find(), integer, one, overlap_type(), residuate(), set_1, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

5691 {
5692  ptr_psi_term t;
5693  ptr_node n1;
5694  long success=TRUE;
5695  long all_args=TRUE;
5696  // long c_result;
5697  ptr_psi_term arg1;
5698  long c_arg1;
5699 
5700  t=aim->aaaa_1;
5701  deref_ptr(t);
5702 
5703  /* Evaluate all arguments first: */
5704  n1=find(FEATCMP,one,t->attr_list);
5705  if (n1) {
5706  arg1= (ptr_psi_term )n1->data;
5707  deref(arg1);
5708  }
5709  deref_args(t,set_1);
5710 
5711  if (success) {
5712  if (n1) {
5713  if (overlap_type(arg1->type,integer))
5714  if (arg1->value_3)
5715  c_arg1= (long)(* (double *)(arg1->value_3));
5716  else {
5717  residuate(arg1);
5718  all_args=FALSE;
5719  }
5720  else
5721  success=FALSE;
5722  }
5723  else {
5724  all_args=FALSE;
5725  }
5726  }
5727 
5728 #ifdef SOLARIS
5729  if (success && all_args) randomseed=c_arg1;
5730 #else
5731  if (success && all_args) srandom(c_arg1);
5732 #endif
5733 
5734  return success;
5735 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
Definition: lefun.c:113
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
#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
#define deref(P)
Definition: def_macro.h:142
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
char * one
Definition: def_glob.h:250
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
static long c_int2string ( )
static

Definition at line 4656 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_one_arg(), heap_copy_string(), integer, NULL, overlap_type(), push_goal(), quoted_string, REAL, residuate(), set_1, stack_psi_term(), STRLEN, TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

4657 {
4658  char val[STRLEN]; /* Big enough for a _long_ number */
4659  long success=TRUE,i;
4660  ptr_psi_term arg1, /* arg3, */ funct,result,t;
4661  REAL the_int,next,neg;
4662 
4663  funct=aim->aaaa_1;
4664  deref_ptr(funct);
4665  result=aim->bbbb_1;
4666  deref(result);
4667 
4668  get_one_arg(funct->attr_list,&arg1);
4669  if (arg1) {
4670  deref(arg1);
4671  deref_args(funct,set_1);
4672  if (overlap_type(arg1->type,integer)) {
4673  if (arg1->value_3) {
4674  the_int = *(REAL *)arg1->value_3;
4675 
4676  if (the_int!=floor(the_int)) return FALSE;
4677 
4678  neg = (the_int<0.0);
4679  if (neg) the_int = -the_int;
4680  i=STRLEN;
4681  i--;
4682  val[i]=0;
4683  do {
4684  i--;
4685  if (i<=0) {
4686  Errorline("internal buffer too small for int2str(%P).\n",arg1);
4687  return FALSE;
4688  }
4689  next = floor(the_int/10);
4690  val[i]= '0' + (unsigned long) (the_int-next*10);
4691  the_int = next;
4692  } while (the_int);
4693 
4694  if (neg) { i--; val[i]='-'; }
4695  t=stack_psi_term(0);
4696  t->type=quoted_string;
4697  t->value_3=(GENERIC)heap_copy_string(&val[i]);
4698  push_goal(unify,t,result,NULL);
4699  }
4700  else
4701  residuate(arg1);
4702  }
4703  else
4704  success=FALSE;
4705  }
4706  else
4707  curry();
4708 
4709  return success;
4710 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
#define REAL
Definition: def_const.h:72
void Errorline(char *format,...)
Definition: error.c:414
char * heap_copy_string(char *s)
Definition: trees.c:147
#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
#define deref(P)
Definition: def_macro.h:142
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
#define STRLEN
Definition: def_const.h:86
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_is_function ( )
static

Definition at line 1436 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, function_it, get_one_arg(), lf_false, lf_true, NULL, push_goal(), resid_aim, set_1, stack_psi_term(), TRUE, wl_psi_term::type, wl_definition::type_def, and unify.

1437 {
1438  long success=TRUE;
1439  ptr_psi_term arg1,result,g,other;
1440 
1441  g=aim->aaaa_1;
1442  deref_ptr(g);
1443  result=aim->bbbb_1;
1444  deref(result);
1445  get_one_arg(g->attr_list,&arg1);
1446  if (arg1) {
1447  deref(arg1);
1448  deref_args(g,set_1);
1449  other=stack_psi_term(4); /* 19.11 */
1451  resid_aim=NULL;
1452  push_goal(unify,result,other,NULL);
1453  }
1454  else {
1455  curry();
1456  /* Errorline("argument missing in %P.\n",t); */
1457  /* return c_abort(); */
1458  }
1459 
1460  return success;
1461 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define function_it
Definition: def_const.h:362
struct wl_definition * def_type
Definition: def_struct.h:32
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
def_type type_def
Definition: def_struct.h:133
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
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
static long c_is_predicate ( )
static

Definition at line 1467 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_one_arg(), lf_false, lf_true, NULL, predicate, push_goal(), resid_aim, set_1, stack_psi_term(), TRUE, wl_psi_term::type, wl_definition::type_def, and unify.

1468 {
1469  long success=TRUE;
1470  ptr_psi_term arg1,result,g,other;
1471 
1472  g=aim->aaaa_1;
1473  deref_ptr(g);
1474  result=aim->bbbb_1;
1475  deref(result);
1476  get_one_arg(g->attr_list,&arg1);
1477  if (arg1) {
1478  deref(arg1);
1479  deref_args(g,set_1);
1480  other=stack_psi_term(4); /* 19.11 */
1481  other->type=(arg1->type->type_def==(def_type)predicate)?lf_true:lf_false;
1482  resid_aim=NULL;
1483  push_goal(unify,result,other,NULL);
1484  }
1485  else {
1486  curry();
1487  /* Errorline("argument missing in %P.\n",t); */
1488  /* return c_abort(); */
1489  }
1490 
1491  return success;
1492 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define predicate
Definition: def_const.h:361
struct wl_definition * def_type
Definition: def_struct.h:32
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
def_type type_def
Definition: def_struct.h:133
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
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
static long c_is_sort ( )
static

Definition at line 1498 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_one_arg(), lf_false, lf_true, NULL, push_goal(), resid_aim, set_1, stack_psi_term(), TRUE, wl_psi_term::type, wl_definition::type_def, type_it, and unify.

1499 {
1500  long success=TRUE;
1501  ptr_psi_term arg1,result,g,other;
1502 
1503  g=aim->aaaa_1;
1504  deref_ptr(g);
1505  result=aim->bbbb_1;
1506  deref(result);
1507  get_one_arg(g->attr_list,&arg1);
1508  if (arg1) {
1509  deref(arg1);
1510  deref_args(g,set_1);
1511  other=stack_psi_term(4); /* 19.11 */
1512  other->type=(arg1->type->type_def==(def_type)type_it)?lf_true:lf_false;
1513  resid_aim=NULL;
1514  push_goal(unify,result,other,NULL);
1515  }
1516  else {
1517  curry();
1518  /* Errorline("argument missing in %P.\n",t); */
1519  /* return c_abort(); */
1520  }
1521 
1522  return success;
1523 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
struct wl_definition * def_type
Definition: def_struct.h:32
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
def_type type_def
Definition: def_struct.h:133
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define type_it
Definition: def_const.h:363
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
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
static long c_listing ( )
static

Definition at line 4859 of file built_ins.c.

References wl_goal::aaaa_1, wl_pair_list::aaaa_2, aim, wl_psi_term::attr_list, wl_pair_list::bbbb_2, wl_node::data, deref_ptr, display_psi_stream(), Errorline(), FALSE, funcsym, function_it, get_two_args(), global, wl_definition::global_value, has_rules(), is_built_in(), wl_definition::keyword, list_special(), listing_pred_write(), new_psi_term(), wl_pair_list::next, NULL, one_attr(), output_stream, outputline(), predicate, predsym, quoted_string, wl_definition::rule, such_that, wl_keyword::symbol, TRUE, wl_psi_term::type, wl_definition::type_def, type_it, typesym, and wl_psi_term::value_3.

4860 {
4861  long success=TRUE;
4862  ptr_psi_term arg1,arg2,g;
4863  def_type fp;
4864  ptr_pair_list r;
4865  ptr_node n;
4866  ptr_psi_term t, t2, *a1, *a2, *a3;
4867  char *s1,*s2;
4868 
4869  g=aim->aaaa_1;
4870  deref_ptr(g);
4871  get_two_args(g->attr_list,&arg1,&arg2);
4872  if (arg1) {
4873  deref_ptr(arg1);
4874  list_special(arg1);
4875  fp=arg1->type->type_def;
4876  r=arg1->type->rule;
4877  if (is_built_in(r) || !has_rules(r)) {
4878 
4879  if (is_built_in(r)) {
4880  s1="built-in ";
4881  s2="";
4882  }
4883  else {
4884  s1="user-defined ";
4885  s2=" with an empty definition";
4886  }
4887  switch ((long)fp) {
4888  case (long)function_it:
4889  fprintf(output_stream,"%% '%s' is a %sfunction%s.\n",
4890  arg1->type->keyword->symbol,s1,s2);
4891  break;
4892  case (long)predicate:
4893  fprintf(output_stream,"%% '%s' is a %spredicate%s.\n",
4894  arg1->type->keyword->symbol,s1,s2);
4895  break;
4896  case (long)type_it:
4897  if (arg1->value_3) {
4898  fprintf(output_stream,"%% ");
4899  if (arg1->type!=quoted_string) fprintf(output_stream,"'");
4900  display_psi_stream(arg1);
4901  if (arg1->type!=quoted_string) fprintf(output_stream,"'");
4902  fprintf(output_stream," is a value of sort '%s'.\n",
4903  arg1->type->keyword->symbol);
4904  }
4905  break;
4906 
4907  case (long)global: /* RM: Feb 9 1993 */
4908  fprintf(output_stream,"%% ");
4909  outputline("'%s' is a %sglobal variable worth %P.\n",
4910  arg1->type->keyword->symbol,
4911  s1,
4912  arg1->type->global_value);
4913  break;
4914 
4915 #ifdef CLIFE
4916  case (long)block: /* AA: Mar 10 1993 */
4917  fprintf(output_stream,"%% '%s' is a %block.\n",
4918  arg1->type->keyword->symbol,"","");
4919 #endif
4920 
4921  default:
4922  fprintf(output_stream,"%% '%s' is undefined.\n", arg1->type->keyword->symbol);
4923  }
4924  }
4925  else {
4926  if (fp==(def_type)type_it || fp==(def_type)function_it || fp==(def_type)predicate) {
4927  n = one_attr();
4928  if (fp==(def_type)function_it)
4929  t = new_psi_term(2, funcsym, &a1, &a2);
4930  else if (fp==(def_type)predicate)
4931  t = new_psi_term(2, predsym, &a1, &a2);
4932  else { /* fp==type */
4933  t = new_psi_term(1, typesym, &a3, &a2); /* a2 is a dummy */
4934  t2 = new_psi_term(2, such_that, &a1, &a2);
4935  }
4936  n->data = (GENERIC) t;
4937  while (r) {
4938  *a1 = r->aaaa_2; /* Func, pred, or type */
4939  *a2 = r->bbbb_2;
4940  if (r->aaaa_2) {
4941  /* Handle an attribute constraint with no predicate: */
4942  if (fp==(def_type)type_it) { if (r->bbbb_2==NULL) *a3 = r->aaaa_2; else *a3 = t2; }
4943  listing_pred_write(n, (fp==(def_type)function_it)||(fp==(def_type)type_it));
4944  fprintf(output_stream,".\n");
4945  }
4946  r = r->next;
4947  }
4948  /* fprintf(output_stream,"\n"); */
4949  /* fflush(output_stream); */
4950  }
4951  else {
4952  success=FALSE;
4953  Errorline("argument of %P must be a predicate, function, or sort.\n",g);
4954  }
4955  }
4956  }
4957  else {
4958  success=FALSE;
4959  Errorline("argument missing in %P.\n",g);
4960  }
4961 
4962  return success;
4963 }
ptr_definition such_that
Definition: def_glob.h:105
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_psi_term aaaa_2
Definition: def_struct.h:189
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void listing_pred_write(ptr_node n, long fflag)
Definition: print.c:1341
void list_special(ptr_psi_term t)
Definition: built_ins.c:4820
#define global
Definition: def_const.h:364
ptr_pair_list next
Definition: def_struct.h:191
void display_psi_stream(ptr_psi_term t)
Definition: print.c:1449
ptr_psi_term new_psi_term(long numargs, ptr_definition typ, ptr_psi_term **a1, ptr_psi_term **a2)
Definition: built_ins.c:4764
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
#define type_it
Definition: def_const.h:363
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
long has_rules(ptr_pair_list r)
Definition: built_ins.c:4799
ptr_pair_list rule
Definition: def_struct.h:126
ptr_psi_term global_value
Definition: def_struct.h:141
#define FALSE
Definition: def_const.h:128
long is_built_in(ptr_pair_list r)
Definition: built_ins.c:4811
ptr_definition quoted_string
Definition: def_glob.h:101
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term bbbb_2
Definition: def_struct.h:190
ptr_goal aim
Definition: def_glob.h:49
void outputline(char *format,...)
Definition: error.c:79
ptr_node one_attr()
Definition: built_ins.c:4749
FILE * output_stream
Definition: def_glob.h:41
ptr_definition predsym
Definition: def_glob.h:99
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
ptr_definition funcsym
Definition: def_glob.h:90
ptr_definition typesym
Definition: def_glob.h:110
static long c_load ( )
static

Definition at line 1682 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref, deref_args, deref_ptr, Errorline(), FALSE, file_date, get_two_args(), input_state, load, open_input_file(), psi_to_string(), push_goal(), and set_1.

1683 {
1684  long success=FALSE;
1685  ptr_psi_term arg1,arg2,t;
1686  char *fn;
1687  t=aim->aaaa_1;
1688  deref_ptr(t);
1689  get_two_args(t->attr_list,&arg1,&arg2);
1690  if(arg1) {
1691  deref(arg1);
1692  deref_args(t,set_1);
1693  if (psi_to_string(arg1,&fn)) {
1694  success=open_input_file(fn);
1695  if (success) {
1696  file_date+=2;
1698  file_date+=2;
1699  }
1700  }
1701  else {
1702  Errorline("bad file name in %P.\n",t);
1703  success=FALSE;
1704  }
1705  }
1706  else {
1707  Errorline("no file name in %P.\n",t);
1708  success=FALSE;
1709  }
1710 
1711  return success;
1712 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
long file_date
Definition: def_glob.h:60
#define set_1
Definition: def_const.h:194
ptr_psi_term input_state
Definition: def_glob.h:199
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define load
Definition: def_const.h:288
#define deref_args(P, S)
Definition: def_macro.h:145
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
long open_input_file(char *file)
Definition: token.c:504
long psi_to_string(ptr_psi_term t, char **fn)
Definition: built_ins.c:133
static long c_logical_main ( long  sel)
static

Definition at line 890 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_bool(), get_two_args(), matches(), NULL, push_goal(), residuate(), set_1_2, TRUE, wl_psi_term::type, UNDEF, unify, unify_bool(), and unify_bool_result().

892 {
893  long success=TRUE;
894  ptr_psi_term funct,arg1,arg2,arg3;
895  long sm1, sm2, sm3;
896  long a1comp, a2comp, a3comp;
897  long a1, a2, a3;
898 
899  funct=aim->aaaa_1;
900  deref_ptr(funct);
901  get_two_args(funct->attr_list,&arg1,&arg2);
902  if (arg1 && arg2) {
903  deref(arg1);
904  deref(arg2);
905  deref_args(funct,set_1_2);
906  arg3=aim->bbbb_1;
907  deref(arg3);
908 
909  a1comp = matches(arg1->type,boolean,&sm1);
910  a2comp = matches(arg2->type,boolean,&sm2);
911  a3comp = matches(arg3->type,boolean,&sm3);
912  if (a1comp && a2comp && a3comp) {
913  a1 = get_bool(arg1->type);
914  a2 = get_bool(arg2->type);
915  a3 = get_bool(arg3->type);
916  if (a1== !sel || a2== !sel) {
917  unify_bool_result(arg3,!sel);
918  } else if (a1==sel) {
919  /* tmp=stack_psi_term(4); */
920  /* tmp->type=boolean; */
921  /* push_goal(unify,tmp,arg3,NULL); */
922  push_goal(unify,arg2,arg3,(GENERIC)NULL);
923  } else if (a2==sel) {
924  /* tmp=stack_psi_term(4); */
925  /* tmp->type=boolean; */
926  /* push_goal(unify,tmp,arg3,NULL); */
927  push_goal(unify,arg1,arg3,(GENERIC)NULL);
928  } else if (a3==sel) {
929  unify_bool_result(arg1,sel);
930  unify_bool_result(arg2,sel);
931  } else if (arg1==arg2) {
932  /* tmp=stack_psi_term(4); */
933  /* tmp->type=boolean; */
934  /* push_goal(unify,tmp,arg3,NULL); */
935  push_goal(unify,arg1,arg3,(GENERIC)NULL);
936  } else {
937  if (a1==UNDEF) residuate(arg1);
938  if (a2==UNDEF) residuate(arg2);
939  if (a3==UNDEF) residuate(arg3);
940  }
941  if (!sm1) unify_bool(arg1);
942  if (!sm2) unify_bool(arg2);
943  if (!sm3) unify_bool(arg3);
944  }
945  else {
946  success=FALSE;
947  Errorline("Non-boolean argument or result in '%P'.\n",funct);
948  }
949  }
950  else
951  curry();
952 
953  return success;
954 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
static void unify_bool(ptr_psi_term arg)
Definition: built_ins.c:878
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define UNDEF
Definition: def_const.h:132
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
static long get_bool(ptr_definition typ)
Definition: built_ins.c:870
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_lt ( )
static

Definition at line 613 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_bool_value(), get_real_value(), get_two_args(), nonnum_warning(), REAL, residuate(), residuate2(), set_1_2, TRUE, and unify_bool_result().

614 {
615  long success=TRUE;
616  ptr_psi_term arg1,arg2,arg3,t;
617  long num1,num2,num3;
618  REAL val1,val2,val3;
619 
620  t=aim->aaaa_1;
621  deref_ptr(t);
622  get_two_args(t->attr_list,&arg1,&arg2);
623  arg3=aim->bbbb_1;
624 
625  if(arg1) {
626  deref(arg1);
627  success=get_real_value(arg1,&val1,&num1);
628  if(success && arg2) {
629  deref(arg2);
630  deref_args(t,set_1_2);
631  success=get_real_value(arg2,&val2,&num2);
632  }
633  }
634 
635  if(success)
636  if(arg1 && arg2) {
637  deref(arg3);
638  success=get_bool_value(arg3,&val3,&num3);
639  if(success)
640  switch(num1+num2*2+num3*4) {
641  case 0:
642  residuate2(arg1,arg2);
643  break;
644  case 1:
645  residuate(arg2);
646  break;
647  case 2:
648  residuate(arg1);
649  break;
650  case 3:
651  unify_bool_result(arg3,(val1<val2));
652  break;
653  case 4:
654  residuate2(arg1,arg2);
655  break;
656  case 5:
657  residuate(arg2);
658  break;
659  case 6:
660  residuate(arg1);
661  break;
662  case 7:
663  success=(val3==(REAL)(val1<val2));
664  break;
665  }
666  }
667  else
668  curry();
669 
670  nonnum_warning(t,arg1,arg2);
671  return success;
672 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
Definition: lefun.c:157
#define REAL
Definition: def_const.h:72
#define set_1_2
Definition: def_const.h:196
void residuate2(ptr_psi_term u, ptr_psi_term v)
Definition: lefun.c:130
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:284
ptr_node attr_list
Definition: def_struct.h:171
static long c_ltoe ( )
static

Definition at line 746 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_bool_value(), get_real_value(), get_two_args(), nonnum_warning(), REAL, residuate(), residuate2(), set_1_2, TRUE, and unify_bool_result().

747 {
748  long success=TRUE;
749  ptr_psi_term arg1,arg2,arg3,t;
750  long num1,num2,num3;
751  REAL val1,val2,val3;
752 
753  t=aim->aaaa_1;
754  deref_ptr(t);
755  get_two_args(t->attr_list,&arg1,&arg2);
756  arg3=aim->bbbb_1;
757 
758  if(arg1) {
759  deref(arg1);
760  success=get_real_value(arg1,&val1,&num1);
761  if(success && arg2) {
762  deref(arg2);
763  deref_args(t,set_1_2);
764  success=get_real_value(arg2,&val2,&num2);
765  }
766  }
767 
768  if(success)
769  if(arg1 && arg2) {
770  deref(arg3);
771  success=get_bool_value(arg3,&val3,&num3);
772  if(success)
773  switch(num1+num2*2+num3*4) {
774  case 0:
775  residuate2(arg1,arg2);
776  break;
777  case 1:
778  residuate(arg2);
779  break;
780  case 2:
781  residuate(arg1);
782  break;
783  case 3:
784  unify_bool_result(arg3,(val1<=val2));
785  break;
786  case 4:
787  residuate2(arg1,arg2);
788  break;
789  case 5:
790  residuate(arg2);
791  break;
792  case 6:
793  residuate(arg1);
794  break;
795  case 7:
796  success=(val3==(REAL)(val1<=val2));
797  break;
798  }
799  }
800  else
801  curry();
802 
803  nonnum_warning(t,arg1,arg2);
804  return success;
805 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
Definition: lefun.c:157
#define REAL
Definition: def_const.h:72
#define set_1_2
Definition: def_const.h:196
void residuate2(ptr_psi_term u, ptr_psi_term v)
Definition: lefun.c:130
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:284
ptr_node attr_list
Definition: def_struct.h:171
static long c_module_name ( )
static

Definition at line 5326 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref_ptr, get_two_args(), heap_copy_string(), wl_definition::keyword, wl_keyword::module, wl_module::module_name, NULL, push_goal(), quoted_string, stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

5327 {
5328  long success=TRUE;
5329  ptr_psi_term arg1,arg2,funct,result;
5330 
5331 
5332  funct=aim->aaaa_1;
5333  result=aim->bbbb_1;
5334  deref_ptr(funct);
5335  deref_ptr(result);
5336 
5337  get_two_args(funct->attr_list,&arg1,&arg2);
5338 
5339  if (arg1) {
5340  deref_ptr(arg1);
5341  arg2=stack_psi_term(0);
5342  arg2->type=quoted_string;
5344  push_goal(unify,arg2,result,NULL);
5345  }
5346  else
5347  curry();
5348 
5349  return success;
5350 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
ptr_keyword keyword
Definition: def_struct.h:124
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
char * heap_copy_string(char *s)
Definition: trees.c:147
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
char * module_name
Definition: def_struct.h:75
#define unify
Definition: def_const.h:274
ptr_module module
Definition: def_struct.h:90
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_non_strict ( )
static

Definition at line 1597 of file built_ins.c.

References wl_goal::aaaa_1, aim, assert_args_not_eval(), wl_psi_term::attr_list, deref_ptr, and TRUE.

1598 {
1599  ptr_psi_term t=aim->aaaa_1;
1600 
1601  deref_ptr(t);
1602  /* mark_quote(t); 14.9 */
1604  return TRUE;
1605 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
ptr_node attr_list
Definition: def_struct.h:171
void assert_args_not_eval(ptr_node n)
Definition: types.c:273
static long c_nonvar ( )
static

Definition at line 1405 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_one_arg(), lf_false, lf_true, NULL, push_goal(), resid_aim, set_1, stack_psi_term(), top, TRUE, wl_psi_term::type, and unify.

1406 {
1407  long success=TRUE;
1408  ptr_psi_term arg1,result,g,other;
1409 
1410  g=aim->aaaa_1;
1411  deref_ptr(g);
1412  result=aim->bbbb_1;
1413  deref(result);
1414  get_one_arg(g->attr_list,&arg1);
1415  if (arg1) {
1416  deref(arg1);
1417  deref_args(g,set_1);
1418  other=stack_psi_term(4); /* 19.11 */
1419  other->type=((arg1->type==top)&&(arg1->attr_list==NULL))?lf_false:lf_true;
1420  resid_aim=NULL;
1421  push_goal(unify,result,other,NULL);
1422  }
1423  else {
1424  curry();
1425  /* Errorline("argument missing in %P.\n",t); */
1426  /* return c_abort(); */
1427  }
1428 
1429  return success;
1430 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
ptr_definition top
Definition: def_glob.h:106
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
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
static long c_not ( )
static

Definition at line 980 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_bool(), get_one_arg(), matches(), residuate(), set_1, TRUE, wl_psi_term::type, UNDEF, unify_bool(), and unify_bool_result().

981 {
982  long success=TRUE;
983  ptr_psi_term funct,arg1,arg2;
984  long sm1, sm2;
985  long a1comp, a2comp;
986  long a1, a2;
987 
988  funct=aim->aaaa_1;
989  deref_ptr(funct);
990  get_one_arg(funct->attr_list,&arg1);
991  if (arg1) {
992  deref(arg1);
993  deref_args(funct,set_1);
994  arg2=aim->bbbb_1;
995  deref(arg2);
996 
997  a1comp = matches(arg1->type,boolean,&sm1);
998  a2comp = matches(arg2->type,boolean,&sm2);
999  if (a1comp && a2comp) {
1000  a1 = get_bool(arg1->type);
1001  a2 = get_bool(arg2->type);
1002  if (a1==TRUE || a1==FALSE) {
1003  unify_bool_result(arg2,!a1);
1004  } else if (a2==TRUE || a2==FALSE) {
1005  unify_bool_result(arg1,!a2);
1006  } else if (arg1==arg2) {
1007  success=FALSE;
1008  } else {
1009  if (a1==UNDEF) residuate(arg1);
1010  if (a2==UNDEF) residuate(arg2);
1011  }
1012  if (!sm1) unify_bool(arg1);
1013  if (!sm2) unify_bool(arg2);
1014  }
1015  else {
1016  success=FALSE;
1017  Errorline("Non-boolean argument or result in '%P'.\n",funct);
1018  }
1019  }
1020  else
1021  curry();
1022 
1023  return success;
1024 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
static void unify_bool(ptr_psi_term arg)
Definition: built_ins.c:878
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
void Errorline(char *format,...)
Definition: error.c:414
#define UNDEF
Definition: def_const.h:132
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
static long get_bool(ptr_definition typ)
Definition: built_ins.c:870
#define deref_args(P, S)
Definition: def_macro.h:145
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
static long c_not_implemented ( )
static

Definition at line 2157 of file built_ins.c.

References wl_goal::aaaa_1, aim, deref_ptr, Errorline(), and FALSE.

2158 {
2159  ptr_psi_term t;
2160 
2161  t=aim->aaaa_1;
2162  deref_ptr(t);
2163  Errorline("built-in %P is not implemented yet.\n",t);
2164  return FALSE;
2165 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
static long c_op ( )
static

Definition at line 1612 of file built_ins.c.

References wl_goal::aaaa_1, aim, and declare_operator().

1613 {
1614  // long declare_operator();
1615  ptr_psi_term t=aim->aaaa_1;
1616 
1617  return declare_operator(t);
1618 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_goal aim
Definition: def_glob.h:49
long declare_operator(ptr_psi_term t)
Definition: built_ins.c:5114
static long c_open_in ( )
static

Definition at line 2590 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_psi_term::coref, deref, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), input_state, is_top, open_input_file(), psi_to_string(), push_psi_ptr_value(), set_1_2, and TRUE.

2591 {
2592  long success=FALSE;
2593  ptr_psi_term arg1,arg2,g;
2594  char *fn;
2595 
2596  g=aim->aaaa_1;
2597  deref_ptr(g);
2598  get_two_args(g->attr_list,&arg1,&arg2);
2599  if(arg1) {
2600  deref(arg1);
2601  if (psi_to_string(arg1,&fn))
2602  if (arg2) {
2603  deref(arg2);
2604  deref_args(g,set_1_2);
2605  if (is_top(arg2)) {
2606  if (open_input_file(fn)) {
2607  /* push_ptr_value(psi_term_ptr,&(arg2->coref)); 9.6 */
2608  push_psi_ptr_value(arg2,(GENERIC *)&(arg2->coref));
2609  arg2->coref=input_state;
2610  success=TRUE;
2611  }
2612  else
2613  success=FALSE;
2614  }
2615  else
2616  Errorline("bad input stream in %P.\n",g);
2617  }
2618  else
2619  Errorline("no stream in %P.\n",g);
2620  else
2621  Errorline("bad file name in %P.\n",g);
2622  }
2623  else
2624  Errorline("no file name in %P.\n",g);
2625 
2626  return success;
2627 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define is_top(T)
Definition: def_macro.h:108
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
Definition: login.c:443
ptr_psi_term input_state
Definition: def_glob.h:199
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
ptr_psi_term coref
Definition: def_struct.h:172
#define deref_args(P, S)
Definition: def_macro.h:145
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
long open_input_file(char *file)
Definition: token.c:504
long psi_to_string(ptr_psi_term t, char **fn)
Definition: built_ins.c:133
static long c_open_out ( )
static

Definition at line 2634 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_psi_term::coref, deref, deref_ptr, Errorline(), FALSE, get_two_args(), open_output_file(), output_stream, overlap_type(), psi_to_string(), push_psi_ptr_value(), stack_psi_term(), stream, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

2635 {
2636  long success=FALSE;
2637  ptr_psi_term arg1,arg2,arg3,g;
2638  char *fn;
2639 
2640  g=aim->aaaa_1;
2641  deref_ptr(g);
2642  get_two_args(g->attr_list,&arg1,&arg2);
2643  if(arg1) {
2644  deref(arg1);
2645  if (psi_to_string(arg1,&fn))
2646  if (arg2) {
2647  deref(arg2);
2648  deref(g);
2649  if (overlap_type(arg2->type,stream)) /* 10.8 */
2650  if (open_output_file(fn)) {
2651  arg3=stack_psi_term(4);
2652  arg3->type=stream;
2653  arg3->value_3=(GENERIC)output_stream;
2654  /* push_ptr_value(psi_term_ptr,&(arg2->coref)); 9.6 */
2655  push_psi_ptr_value(arg2,(GENERIC *)&(arg2->coref));
2656  arg2->coref=arg3;
2657  success=TRUE;
2658  }
2659  else
2660  success=FALSE;
2661  else
2662  Errorline("bad stream in %P.\n",g);
2663  }
2664  else
2665  Errorline("no stream in %P.\n",g);
2666  else
2667  Errorline("bad file name in %P.\n",g);
2668  }
2669  else
2670  Errorline("no file name in %P.\n",g);
2671 
2672  return success;
2673 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long open_output_file(char *file)
ptr_definition stream
Definition: def_glob.h:103
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
Definition: login.c:443
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
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
FILE * output_stream
Definition: def_glob.h:41
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 psi_to_string(ptr_psi_term t, char **fn)
Definition: built_ins.c:133
static long c_ops ( )
static

Definition at line 3531 of file built_ins.c.

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

3532 {
3533  long success=TRUE;
3534  ptr_psi_term result, g, t;
3535 
3536  g=aim->aaaa_1;
3537  deref_args(g,set_empty);
3538  result=aim->bbbb_1;
3539  t=collect_symbols(op_sel); /* RM: Feb 3 1993 */
3540  push_goal(unify,result,t,NULL);
3541 
3542  return success;
3543 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_empty
Definition: def_const.h:193
#define NULL
Definition: def_const.h:203
#define op_sel
Definition: def_const.h:8
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term collect_symbols(long sel)
Definition: built_ins.c:3446
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long c_or ( )
static

Definition at line 968 of file built_ins.c.

References c_logical_main(), and FALSE.

969 {
970  return c_logical_main(FALSE);
971 }
static long c_logical_main(long sel)
Definition: built_ins.c:890
#define FALSE
Definition: def_const.h:128
static long c_page_width ( )
static

Definition at line 3028 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref, deref_args, deref_ptr, equal_types, Errorline(), FALSE, get_two_args(), integer, NULL, page_width, push_goal(), REAL, real_stack_psi_term(), set_1, sub_type(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

3029 {
3030  long success=FALSE;
3031  ptr_psi_term arg1,arg2,g;
3032  long pw;
3033 
3034  g=aim->aaaa_1;
3035  deref_ptr(g);
3036  get_two_args(g->attr_list,&arg1,&arg2);
3037  if(arg1) {
3038  deref(arg1);
3039  deref_args(g,set_1);
3040  if (equal_types(arg1->type,integer) && arg1->value_3) {
3041  pw = *(REAL *)arg1->value_3;
3042  if (pw>0)
3043  page_width=pw;
3044  else
3045  Errorline("argument in %P must be positive.\n",g);
3046  success=TRUE;
3047  }
3048  else if (sub_type(integer,arg1->type)) {
3050  success=TRUE;
3051  }
3052  else
3053  Errorline("bad argument in %P.\n",g);
3054  }
3055  else
3056  Errorline("argument missing in %P.\n",g);
3057 
3058  return success;
3059 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
Definition: lefun.c:38
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
#define NULL
Definition: def_const.h:203
long page_width
Definition: def_glob.h:43
#define REAL
Definition: def_const.h:72
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
void Errorline(char *format,...)
Definition: error.c:414
#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
#define deref(P)
Definition: def_macro.h:142
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define equal_types(A, B)
Definition: def_macro.h:106
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
static long c_parse ( )
static

Definition at line 1905 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, bi_module, curry(), wl_node::data, deref, deref_args, deref_ptr, FACT, FALSE, FEATCMP, find(), get_one_arg(), init_parse_state(), lf_false, lf_true, mark_quote(), matches(), NULL, parse(), push_goal(), QUERY, quoted_string, residuate(), restore_parse_state(), save_parse_state(), set_1, stack_copy_psi_term(), stack_psi_term(), stringinput, stringparse, three, TRUE, two, wl_psi_term::type, unify, update_symbol(), wl_psi_term::value_3, and var_occurred.

1906 {
1907  long success=TRUE;
1908  ptr_psi_term arg1,arg2,arg3,funct,result;
1909  long smaller,sort,old_var_occurred;
1910  ptr_node n;
1911  parse_block pb;
1912 
1913  funct=aim->aaaa_1;
1914  deref_ptr(funct);
1915  result=aim->bbbb_1;
1916  get_one_arg(funct->attr_list,&arg1);
1917  if (arg1) {
1918  deref(arg1);
1919  deref_args(funct,set_1);
1920  success=matches(arg1->type,quoted_string,&smaller);
1921  if (success) {
1922  if (arg1->value_3) {
1923  ptr_psi_term t;
1924 
1925  /* Parse the string in its own state */
1926  save_parse_state(&pb);
1927  init_parse_state();
1928  stringparse=TRUE;
1929  stringinput=(char*)arg1->value_3;
1930 
1931  old_var_occurred=var_occurred;
1933  t=stack_copy_psi_term(parse(&sort));
1934 
1935  /* Optional second argument returns 'query', 'declaration', or 'error'. */
1936  n=find(FEATCMP,two,funct->attr_list);
1937  if (n) {
1938  ptr_psi_term queryflag;
1939  arg2=(ptr_psi_term)n->data;
1940  queryflag=stack_psi_term(4);
1941  queryflag->type=
1943  ((sort==QUERY)?"query":((sort==FACT)?"declaration":"error"))
1944  );
1945  push_goal(unify,queryflag,arg2,NULL);
1946  }
1947 
1948  /* Optional third argument returns true or false if the psi-term
1949  contains a variable or not. */
1950  n=find(FEATCMP,three,funct->attr_list);
1951  if (n) {
1952  ptr_psi_term varflag;
1953  arg3=(ptr_psi_term)n->data;
1954  varflag=stack_psi_term(4);
1955  varflag->type=var_occurred?lf_true:lf_false;
1956  push_goal(unify,varflag,arg3,NULL);
1957  }
1958 
1959  var_occurred = var_occurred || old_var_occurred;
1961  restore_parse_state(&pb);
1962 
1963  /* parse_ok flag says whether there was a syntax error. */
1964  if (TRUE /*parse_ok*/) {
1965  mark_quote(t);
1966  push_goal(unify,t,result,NULL);
1967  }
1968  else
1969  success=FALSE;
1970  }
1971  else
1972  residuate(arg1);
1973  }
1974  else
1975  success=FALSE;
1976  }
1977  else
1978  curry();
1979 
1980  return success;
1981 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
psi_term parse(long *q)
Definition: parser.c:877
void save_parse_state(ptr_parse_block pb)
Definition: token.c:350
char * two
Definition: def_glob.h:251
void restore_parse_state(ptr_parse_block pb)
Definition: token.c:365
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#define FACT
Definition: def_const.h:151
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
char * three
Definition: def_glob.h:252
#define QUERY
Definition: def_const.h:152
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
long var_occurred
Definition: def_glob.h:189
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
GENERIC value_3
Definition: def_struct.h:170
void init_parse_state()
Definition: token.c:381
ptr_goal aim
Definition: def_glob.h:49
void mark_quote(ptr_psi_term t)
Definition: copy.c:601
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
long stringparse
Definition: def_glob.h:202
ptr_module bi_module
Definition: def_glob.h:155
char * stringinput
Definition: def_glob.h:203
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
static long c_persistent ( )
static

Definition at line 2517 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, persistent_error_check(), and persistent_tree().

2518 {
2519  int error=FALSE;
2520  ptr_psi_term g;
2521 
2522  g=aim->aaaa_1;
2523  deref_ptr(g);
2524  if (g->attr_list) {
2525  /* Do error check of all arguments first: */
2526  persistent_error_check(g->attr_list, &error);
2527  /* If no errors, then make the arguments persistent: */
2528  if (!error)
2530  } else {
2531  Errorline("argument(s) missing in %P\n",g);
2532  }
2533 
2534  return !error;
2535 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void persistent_error_check(ptr_node n, int *error)
Definition: built_ins.c:2538
void persistent_tree(ptr_node n)
Definition: built_ins.c:2561
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
ptr_node attr_list
Definition: def_struct.h:171
static long c_pred ( )
static

Definition at line 4990 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), set_1_2, and TRUE.

4991 {
4992  long success=TRUE;
4993  ptr_psi_term arg1,arg2,g;
4994 
4995  g=aim->aaaa_1;
4996  deref_ptr(g);
4997  get_two_args(g->attr_list,&arg1,&arg2);
4998  if (arg1 && arg2) {
4999  deref_args(g,set_1_2);
5000  }
5001  else {
5002  success=FALSE;
5003  Errorline("argument(s) missing in %P.\n",g);
5004  }
5005 
5006  return success;
5007 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_node attr_list
Definition: def_struct.h:171
static long c_print_codes ( )
static

Definition at line 4970 of file built_ins.c.

References wl_goal::aaaa_1, aim, deref_args, outputline(), print_codes(), set_empty, TRUE, and type_count.

4971 {
4972  ptr_psi_term t;
4973 
4974  t=aim->aaaa_1;
4975  deref_args(t,set_empty);
4976  outputline("There are %d sorts.\n",type_count);
4977  print_codes();
4978  return TRUE;
4979 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long type_count
Definition: def_glob.h:46
#define set_empty
Definition: def_const.h:193
void print_codes()
Definition: types.c:1178
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
void outputline(char *format,...)
Definition: error.c:79
#define deref_args(P, S)
Definition: def_macro.h:145
static long c_print_depth ( )
static

Definition at line 3066 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref, deref_args, deref_ptr, equal_types, Errorline(), FALSE, get_two_args(), integer, NULL, PRINT_DEPTH, print_depth, push_goal(), REAL, real_stack_psi_term(), set_1, sub_type(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

3067 {
3068  long success=FALSE;
3069  ptr_psi_term arg1,arg2,g;
3070  long dl;
3071 
3072  g=aim->aaaa_1;
3073  deref_ptr(g);
3074  get_two_args(g->attr_list,&arg1,&arg2);
3075  if (arg1) {
3076  deref(arg1);
3077  deref_args(g,set_1);
3078  if (equal_types(arg1->type,integer) && arg1->value_3) {
3079  dl = *(REAL *)arg1->value_3;
3080  if (dl>=0)
3081  print_depth=dl;
3082  else
3083  Errorline("argument in %P must be positive or zero.\n",g);
3084  success=TRUE;
3085  }
3086  else if (sub_type(integer,arg1->type)) {
3088  success=TRUE;
3089  }
3090  else
3091  Errorline("bad argument in %P.\n",g);
3092  }
3093  else {
3094  /* No arguments: reset print depth to default value */
3096  success=TRUE;
3097  }
3098 
3099  return success;
3100 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
Definition: lefun.c:38
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
void Errorline(char *format,...)
Definition: error.c:414
#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
#define deref(P)
Definition: def_macro.h:142
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
long print_depth
Definition: def_glob.h:178
#define equal_types(A, B)
Definition: def_macro.h:106
#define unify
Definition: def_const.h:274
#define PRINT_DEPTH
Definition: def_const.h:92
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
static long c_print_variables ( )
static

Definition at line 1867 of file built_ins.c.

References print_variables(), and TRUE.

1868 {
1869  long success=TRUE;
1870 
1871  (void)print_variables(TRUE); /* 21.1 */
1872 
1873  return success;
1874 }
#define TRUE
Definition: def_const.h:127
long print_variables(long printflag)
Definition: print.c:1272
static long c_project ( )
static

Definition at line 1157 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_definition::always_check, wl_psi_term::attr_list, wl_goal::bbbb_1, bk_stack_insert(), clear_copy(), wl_keyword::combined_name, wl_psi_term::coref, curry(), wl_node::data, deref, deref_args, deref_ptr, Errorline(), FALSE, FEATCMP, fetch_def_lazy(), find(), wl_psi_term::flags, function_it, get_two_args(), heap_copy_string(), heap_insert(), heap_pointer, inc_heap_copy(), integer, wl_definition::keyword, NULL, wl_keyword::private_feature, push_goal(), push_psi_ptr_value(), quoted_string, QUOTED_TRUE, REAL, release_resid(), wl_psi_term::resid, residuate(), set_1_2, sub_type(), wl_keyword::symbol, top, TRUE, wl_psi_term::type, wl_definition::type_def, unify, and wl_psi_term::value_3.

1159 {
1160  long success=TRUE;
1161  ptr_psi_term arg1,arg2,funct,result;
1162  ptr_node n;
1163  char *label;
1164  double v;
1165 
1166  /* char *thebuffer="integer"; 18.5 */
1167  char thebuffer[20]; /* Maximum number of digits in an integer */
1168 
1169  funct=aim->aaaa_1;
1170  deref_ptr(funct);
1171  result=aim->bbbb_1;
1172  get_two_args(funct->attr_list,&arg1,&arg2);
1173  if (arg2 && arg1) {
1174  deref(arg1);
1175  deref(arg2);
1176  deref_args(funct,set_1_2);
1177 
1178  label=NULL;
1179 
1180  /* RM: Jul 20 1993: Don't residuate on 'string' etc... */
1181  if(arg2->type!=top) {
1182  if(arg2->value_3 && sub_type(arg2->type,quoted_string)) /* 10.8 */
1183  label=(char *)arg2->value_3;
1184  else
1185  if(arg2->value_3 && sub_type(arg2->type,integer)) { /* 10.8 */
1186  v= *(REAL *)arg2->value_3;
1187  if(v==floor(v)) {
1188  (void)snprintf(thebuffer,20,"%ld",(long)v);
1189  label=heap_copy_string(thebuffer); /* A little voracious */
1190  }
1191  else { /* RM: Jul 28 1993 */
1192  Errorline("non-integer numeric feature in %P\n",funct);
1193  return FALSE;
1194  }
1195  }
1196  else {
1197  if(arg2->type->keyword->private_feature) /* RM: Mar 12 1993 */
1198  label=arg2->type->keyword->combined_name;
1199  else
1200  label=arg2->type->keyword->symbol;
1201  }
1202  }
1203 
1204  if (label) {
1205  n=find(FEATCMP,(char *)label,arg1->attr_list);
1206 
1207  if (n)
1209  else if (arg1->type->type_def==(def_type)function_it && !(arg1->flags&QUOTED_TRUE)) {
1210  Errorline("attempt to add a feature to curried function %P\n",
1211  arg1);
1212  return FALSE;
1213  }
1214  else {
1215  deref_ptr(result);
1216  if((GENERIC)arg1>=heap_pointer) { /* RM: Feb 9 1993 */
1217  if((GENERIC)result<heap_pointer)
1218  push_psi_ptr_value(result,(GENERIC *)&(result->coref));
1219  clear_copy();
1220  result->coref=inc_heap_copy(result);
1221  (void)heap_insert(FEATCMP,label,&(arg1->attr_list),(GENERIC)result->coref);
1222  }
1223  else {
1224 
1225 #ifdef ARITY /* RM: Mar 29 1993 */
1226  arity_add(arg1,label);
1227 #endif
1228 
1229  /* RM: Mar 25 1993 */
1230  if(arg1->type->always_check || arg1->attr_list)
1231  (void)bk_stack_insert(FEATCMP,label,&(arg1->attr_list),(GENERIC)result);
1232  else {
1233  (void)bk_stack_insert(FEATCMP,label,&(arg1->attr_list),(GENERIC)result);
1234  fetch_def_lazy(arg1, arg1->type,arg1->type,NULL,NULL,0,0); // djd added zeros
1235  }
1236 
1237  if (arg1->resid)
1238  release_resid(arg1);
1239  }
1240  }
1241  }
1242  else
1243  residuate(arg2);
1244  }
1245  else
1246  curry();
1247 
1248  return success;
1249 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_residuation resid
Definition: def_struct.h:173
#define function_it
Definition: def_const.h:362
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define FEATCMP
Definition: def_const.h:257
void clear_copy()
Definition: copy.c:52
void residuate(ptr_psi_term t)
Definition: lefun.c:113
char * combined_name
Definition: def_struct.h:92
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
ptr_node bk_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:309
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
Definition: login.c:443
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
ptr_definition top
Definition: def_glob.h:106
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
#define REAL
Definition: def_const.h:72
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:276
char always_check
Definition: def_struct.h:134
void release_resid(ptr_psi_term t)
Definition: lefun.c:414
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
void fetch_def_lazy(ptr_psi_term u, ptr_definition old1, ptr_definition old2, ptr_node old1attr, ptr_node old2attr, long old1stat, long old2stat)
Definition: login.c:1188
void Errorline(char *format,...)
Definition: error.c:414
char * heap_copy_string(char *s)
Definition: trees.c:147
#define set_1_2
Definition: def_const.h:196
#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
#define deref(P)
Definition: def_macro.h:142
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
GENERIC heap_pointer
Definition: def_glob.h:12
ptr_psi_term inc_heap_copy(ptr_psi_term t)
Definition: copy.c:211
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
int private_feature
Definition: def_struct.h:95
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
#define QUOTED_TRUE
Definition: def_const.h:123
ptr_node attr_list
Definition: def_struct.h:171
static long c_psi2string ( )
static

Definition at line 4613 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_one_arg(), heap_copy_string(), wl_definition::keyword, NULL, push_goal(), quoted_string, real, set_1, stack_psi_term(), sub_type(), wl_keyword::symbol, TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

4614 {
4615  long success=TRUE;
4616  ptr_psi_term arg1, /* arg3, */ funct,result,t;
4617  char buf[100]; /* RM: Mar 10 1993 */
4618 
4619  funct=aim->aaaa_1;
4620  deref_ptr(funct);
4621  result=aim->bbbb_1;
4622  deref(result);
4623 
4624  get_one_arg(funct->attr_list,&arg1);
4625  if (arg1) {
4626  deref(arg1);
4627  deref_args(funct,set_1);
4628  t=stack_psi_term(0);
4629  t->type=quoted_string;
4630 
4631  /* RM: Mar 10 1993 */
4632  if(arg1->value_3 && sub_type(arg1->type,real)) {
4633  (void)snprintf(buf,100,"%g", *((double *)(arg1->value_3)));
4634  t->value_3=(GENERIC)heap_copy_string(buf);
4635  }
4636  else
4637  if(arg1->value_3 && sub_type(arg1->type,quoted_string)) {
4638  t->value_3=(GENERIC)heap_copy_string((char *)arg1->value_3);
4639  }
4640  else
4642 
4643  push_goal(unify,t,result,NULL);
4644  }
4645  else
4646  curry();
4647 
4648  return success;
4649 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
ptr_keyword keyword
Definition: def_struct.h:124
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
char * heap_copy_string(char *s)
Definition: trees.c:147
ptr_definition real
Definition: def_glob.h:102
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_put ( )
static

Definition at line 2853 of file built_ins.c.

References c_put_main(), and FALSE.

2854 {
2855  return c_put_main(FALSE);
2856 }
static long c_put_main(long)
Definition: built_ins.c:2863
#define FALSE
Definition: def_const.h:128
static long c_put_err ( )
static

Definition at line 2858 of file built_ins.c.

References c_put_main(), and TRUE.

2859 {
2860  return c_put_main(TRUE);
2861 }
static long c_put_main(long)
Definition: built_ins.c:2863
#define TRUE
Definition: def_const.h:127
static long c_put_main ( long  to_stderr)
static

Definition at line 2863 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref, deref_args, deref_ptr, equal_types, Errorline(), FALSE, get_two_args(), integer, output_stream, psi_to_string(), REAL, real, set_1, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

2865 {
2866  long i,success=FALSE;
2867  ptr_psi_term arg1,arg2,g;
2868  char tstr[2], *str=tstr;
2869 
2870  g=aim->aaaa_1;
2871  deref_ptr(g);
2872  get_two_args(g->attr_list,&arg1,&arg2);
2873  if (arg1) {
2874  deref(arg1);
2875  deref_args(g,set_1);
2876  if ((equal_types(arg1->type,integer) || equal_types(arg1->type,real))
2877  && arg1->value_3) {
2878  i = (unsigned long) floor(*(REAL *) arg1->value_3);
2879  if (i==(unsigned long)(unsigned char)i) {
2880  str[0] = i; str[1] = 0;
2881  success=TRUE;
2882  }
2883  else {
2884  Errorline("out-of-range character value in %P.\n",g);
2885  }
2886  }
2887  else if (psi_to_string(arg1,&str)) {
2888  success=TRUE;
2889  }
2890  if (success)
2891  fprintf((to_stderr?stderr:output_stream),"%s",str);
2892  }
2893  else
2894  Errorline("argument missing in %P.\n",g);
2895 
2896  return success;
2897 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define set_1
Definition: def_const.h:194
#define REAL
Definition: def_const.h:72
void Errorline(char *format,...)
Definition: error.c:414
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
#define deref(P)
Definition: def_macro.h:142
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define equal_types(A, B)
Definition: def_macro.h:106
#define deref_args(P, S)
Definition: def_macro.h:145
FILE * output_stream
Definition: def_glob.h:41
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
long psi_to_string(ptr_psi_term t, char **fn)
Definition: built_ins.c:133
static long c_pwrite ( )
static

Definition at line 2997 of file built_ins.c.

References const_quote, FALSE, generic_write(), indent, TRUE, write_canon, write_corefs, write_resids, and write_stderr.

2998 {
2999  indent=TRUE;
3005  return generic_write();
3006 }
static long generic_write()
Definition: built_ins.c:2904
long write_corefs
Definition: def_glob.h:182
long write_resids
Definition: def_glob.h:183
long indent
Definition: def_glob.h:179
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long const_quote
Definition: def_glob.h:180
long write_stderr
Definition: def_glob.h:181
long write_canon
Definition: def_glob.h:184
static long c_pwriteq ( )
static

Definition at line 3012 of file built_ins.c.

References const_quote, FALSE, generic_write(), indent, TRUE, write_canon, write_corefs, write_resids, and write_stderr.

3013 {
3014  indent=TRUE;
3015  const_quote=TRUE;
3020  return generic_write();
3021 }
static long generic_write()
Definition: built_ins.c:2904
long write_corefs
Definition: def_glob.h:182
long write_resids
Definition: def_glob.h:183
long indent
Definition: def_glob.h:179
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long const_quote
Definition: def_glob.h:180
long write_stderr
Definition: def_glob.h:181
long write_canon
Definition: def_glob.h:184
static long c_quote ( )
static

Definition at line 3745 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_ptr, get_two_args(), NULL, push_goal(), TRUE, and unify.

3746 {
3747  long success=TRUE;
3748  ptr_psi_term arg1,arg2,funct,result;
3749 
3750  funct = aim->aaaa_1;
3751  deref_ptr(funct);
3752  result = aim->bbbb_1;
3753  deref(result);
3754  get_two_args(funct->attr_list, &arg1, &arg2);
3755  if (arg1) {
3756  push_goal(unify,arg1,result,NULL);
3757  } else
3758  curry();
3759 
3760  return success;
3761 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
long c_random ( )

Definition at line 5626 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), wl_node::data, deref, deref_args, deref_ptr, FALSE, FEATCMP, find(), integer, NULL, one, overlap_type(), push_goal(), REAL, real_stack_psi_term(), residuate(), set_1, TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

5627 {
5628  ptr_psi_term result,funct;
5629  ptr_node n1;
5630  long success=TRUE;
5631  long all_args=TRUE;
5632  long c_result;
5633  ptr_psi_term arg1;
5634  long c_arg1;
5635 
5636  funct=aim->aaaa_1;
5637  deref_ptr(funct);
5638  result=aim->bbbb_1;
5639 
5640  /* Evaluate all arguments first: */
5641  n1=find(FEATCMP,one,funct->attr_list);
5642  if (n1) {
5643  arg1= (ptr_psi_term )n1->data;
5644  deref(arg1);
5645  }
5646  deref_args(funct,set_1);
5647 
5648  if (success) {
5649  if (n1) {
5650  if (overlap_type(arg1->type,integer))
5651  if (arg1->value_3)
5652  c_arg1= (long)(* (double *)(arg1->value_3));
5653  else {
5654  residuate(arg1);
5655  all_args=FALSE;
5656  }
5657  else
5658  success=FALSE;
5659  }
5660  else {
5661  all_args=FALSE;
5662  curry();
5663  }
5664  }
5665 
5666  if (success && all_args) {
5667  if (c_arg1) {
5668 #ifdef SOLARIS
5669  c_result=(rand_r(&randomseed)<<15) + rand_r(&randomseed);
5670 #else
5671  c_result=random();
5672 #endif
5673  c_result=c_result-(c_result/c_arg1)*c_arg1;
5674  }
5675  else
5676  c_result=0;
5677 
5678  push_goal(unify,real_stack_psi_term(0,(REAL)c_result),result,NULL);
5679  }
5680 
5681  return success;
5682 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
Definition: lefun.c:113
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
Definition: lefun.c:38
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
#define REAL
Definition: def_const.h:72
#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
#define deref(P)
Definition: def_macro.h:142
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
char * one
Definition: def_glob.h:250
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
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
static long c_read ( long  psi_flag)
static

Definition at line 1999 of file built_ins.c.

References wl_goal::aaaa_1, abort_life(), aim, wl_psi_term::attr_list, bi_module, wl_node::data, deref_args, deref_ptr, eof, eof_flag, Errorline(), FACT, FALSE, FEATCMP, find(), get_one_arg(), heap_alloc(), integer, line_count, mark_quote(), NULL, parse(), prompt, push_goal(), QUERY, read_token_b(), REAL, set_1, stack_copy_psi_term(), stack_psi_term(), three, TRUE, two, wl_psi_term::type, unify, update_symbol(), wl_psi_term::value_3, and var_tree.

2001 {
2002  long success=TRUE;
2003  long sort;
2004  ptr_psi_term arg1,arg2,arg3,g,t;
2005  ptr_node old_var_tree;
2006  ptr_node n;
2007  int line=line_count+1;
2008 
2009  g=aim->aaaa_1;
2010  deref_ptr(g);
2011  get_one_arg(g->attr_list,&arg1);
2012  if (arg1) {
2013  deref_args(g,set_1);
2014  if (eof_flag) {
2015  Errorline("attempt to read past end of file (%E).\n");
2016  return (abort_life(TRUE));
2017  }
2018  else {
2019  prompt="";
2020  old_var_tree=var_tree;
2021  var_tree=NULL;
2022  if (psi_flag) {
2023 
2024  t=stack_copy_psi_term(parse(&sort));
2025 
2026 
2027  /* Optional second argument returns 'query', 'declaration', or
2028  'error'. */
2029  n=find(FEATCMP,two,g->attr_list); /* RM: Jun 8 1993 */
2030  if (n) {
2031  ptr_psi_term queryflag;
2032  arg2=(ptr_psi_term)n->data;
2033  queryflag=stack_psi_term(4);
2034  queryflag->type=
2036  ((sort==QUERY)?"query":((sort==FACT)?"declaration":"error"))
2037  );
2038  push_goal(unify,queryflag,arg2,NULL);
2039  }
2040 
2041 
2042  /* Optional third argument returns the starting line number */
2043  /* RM: Oct 11 1993 */
2044  n=find(FEATCMP,three,g->attr_list);
2045  if (n) {
2046  arg3=(ptr_psi_term)n->data;
2047  g=stack_psi_term(4);
2048  g->type=integer;
2049  g->value_3=heap_alloc(sizeof(REAL));
2050  *(REAL *)g->value_3=line;
2051  push_goal(unify,g,arg3,NULL);
2052  }
2053 
2054  }
2055  else {
2056  t=stack_psi_term(0);
2057  read_token_b(t);
2058  /* RM: Jan 5 1993 removed spurious argument: &quot (??) */
2059 
2060  }
2061  if (t->type==eof) eof_flag=TRUE;
2062  var_tree=old_var_tree;
2063  }
2064 
2065  if (success) {
2066  mark_quote(t);
2067  push_goal(unify,t,arg1,NULL);
2068  /* i_check_out(t); */
2069  }
2070  }
2071  else {
2072  Errorline("argument missing in %P.\n",g);
2073  success=FALSE;
2074  }
2075 
2076  return success;
2077 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
psi_term parse(long *q)
Definition: parser.c:877
long eof_flag
Definition: def_glob.h:196
char * two
Definition: def_glob.h:251
#define FACT
Definition: def_const.h:151
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
char * three
Definition: def_glob.h:252
#define QUERY
Definition: def_const.h:152
#define REAL
Definition: def_const.h:72
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
long abort_life(int nlflag)
Definition: built_ins.c:2124
long line_count
Definition: def_glob.h:39
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition eof
Definition: def_glob.h:86
#define TRUE
Definition: def_const.h:127
ptr_definition integer
Definition: def_glob.h:93
#define FALSE
Definition: def_const.h:128
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
void mark_quote(ptr_psi_term t)
Definition: copy.c:601
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void read_token_b(ptr_psi_term tok)
Definition: token.c:1069
char * prompt
Definition: def_glob.h:42
ptr_module bi_module
Definition: def_glob.h:155
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
GENERIC heap_alloc(long s)
Definition: memory.c:1518
static long c_read_psi ( )
static

Definition at line 1995 of file built_ins.c.

References c_read(), and TRUE.

1995 { return (c_read(TRUE)); }
static long c_read(long)
Definition: built_ins.c:1999
#define TRUE
Definition: def_const.h:127
static long c_read_token ( )
static

Definition at line 1997 of file built_ins.c.

References c_read(), and FALSE.

1997 { return (c_read(FALSE)); }
static long c_read(long)
Definition: built_ins.c:1999
#define FALSE
Definition: def_const.h:128
static long c_repeat ( )
static

Definition at line 1360 of file built_ins.c.

References wl_goal::aaaa_1, aim, DEFRULES, deref_args, NULL, prove, push_choice_point(), set_empty, and TRUE.

1361 {
1362  ptr_psi_term t;
1363 
1364  t=aim->aaaa_1;
1365  deref_args(t,set_empty);
1367  return TRUE;
1368 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:591
#define set_empty
Definition: def_const.h:193
#define DEFRULES
Definition: def_const.h:138
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
unsigned long * GENERIC
Definition: def_struct.h:17
static long c_retract ( )
static

Definition at line 2383 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, FALSE, get_two_args(), and pred_clause().

2384 {
2385  long success=FALSE;
2386  ptr_psi_term arg1,arg2,g;
2387 
2388  g=aim->aaaa_1;
2389  get_two_args(g->attr_list,&arg1,&arg2);
2390  success=pred_clause(arg1,1,g);
2391 
2392  return success;
2393 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long pred_clause(ptr_psi_term t, long r, ptr_psi_term g)
Definition: built_ins.c:2300
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
ptr_node attr_list
Definition: def_struct.h:171
static long c_rootsort ( )
static

Definition at line 3108 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_two_args(), NULL, push_goal(), resid_aim, set_1, stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

3109 {
3110  long success=TRUE;
3111  ptr_psi_term arg1,arg2,arg3,g,other;
3112 
3113  g=aim->aaaa_1;
3114  deref_ptr(g);
3115  arg3=aim->bbbb_1;
3116  deref(arg3);
3117  get_two_args(g->attr_list,&arg1,&arg2);
3118  if(arg1) {
3119  deref(arg1);
3120  deref_args(g,set_1);
3121  other=stack_psi_term(4); /* 19.11 */
3122  other->type=arg1->type;
3123  other->value_3=arg1->value_3;
3124  resid_aim=NULL;
3125  push_goal(unify,arg3,other,NULL);
3126  }
3127  else
3128  curry();
3129 
3130  return success;
3131 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
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
static long c_same_address ( )
static

Definition at line 3598 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, FALSE, get_bool_value(), get_two_args(), NULL, push_goal(), REAL, resid_aim, set_1_2, TRUE, unify, and unify_bool_result().

3599 {
3600  long success=TRUE;
3601  ptr_psi_term arg1,arg2,funct,result;
3602  REAL val3;
3603  long num3;
3604 
3605  funct=aim->aaaa_1;
3606  deref_ptr(funct);
3607  result=aim->bbbb_1;
3608  get_two_args(funct->attr_list,&arg1,&arg2);
3609 
3610  if (arg1 && arg2) {
3611  success=get_bool_value(result,&val3,&num3);
3612  resid_aim=NULL;
3613  deref(arg1);
3614  deref(arg2);
3615  deref_args(funct,set_1_2);
3616 
3617  if (num3) {
3618  if (val3)
3619  push_goal(unify,arg1,arg2,NULL);
3620  else
3621  success=(arg1!=arg2);
3622  }
3623  else
3624  if (arg1==arg2)
3625  unify_bool_result(result,TRUE);
3626  else
3627  unify_bool_result(result,FALSE);
3628  }
3629  else
3630  curry();
3631 
3632  return success;
3633 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define REAL
Definition: def_const.h:72
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:284
ptr_node attr_list
Definition: def_struct.h:171
static long c_set_choice ( )
static

Definition at line 1757 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, choice_stack, clean_trail(), curry(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_one_arg(), get_real_value(), wl_choice_point::next, REAL, set_1, wl_choice_point::time_stamp, and TRUE.

1758 {
1759  REAL gts_r;
1760  long gts;
1761  long num,success=TRUE;
1762  ptr_psi_term t,arg1;
1763  ptr_choice_point cutpt;
1764 
1765  t=aim->aaaa_1;
1766  deref_ptr(t);
1767  get_one_arg(t->attr_list,&arg1);
1768  if (arg1) {
1769  deref(arg1);
1770  deref_args(t,set_1);
1771  success = get_real_value(arg1,&gts_r,&num);
1772  if (success) {
1773  if (num) {
1774  gts=(unsigned long)gts_r;
1775  if (choice_stack) {
1776  cutpt=choice_stack;
1777  while (cutpt && cutpt->time_stamp>gts) cutpt=cutpt->next;
1778  if (choice_stack!=cutpt) {
1779  choice_stack=cutpt;
1780 #ifdef CLEAN_TRAIL
1782 #endif
1783  }
1784  }
1785  }
1786  else {
1787  Errorline("bad argument to %P.\n",t);
1788  success=FALSE;
1789  }
1790  }
1791  else {
1792  Errorline("bad argument %P.\n",t);
1793  success=FALSE;
1794  }
1795  }
1796  else
1797  curry();
1798 
1799  return success;
1800 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
unsigned long time_stamp
Definition: def_struct.h:232
ptr_choice_point next
Definition: def_struct.h:235
#define REAL
Definition: def_const.h:72
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
static void clean_trail(ptr_choice_point cutpt)
Definition: login.c:757
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_node attr_list
Definition: def_struct.h:171
ptr_choice_point choice_stack
Definition: def_glob.h:51
static long c_set_input ( )
static

Definition at line 2681 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref, deref_args, deref_ptr, equal_types, Errorline(), FALSE, get_stream(), get_two_args(), input_state, inputfilesym, NULL, restore_state(), save_state(), set_1, TRUE, and wl_psi_term::type.

2682 {
2683  long success=FALSE;
2684  ptr_psi_term arg1,arg2,g;
2685  FILE *thestream;
2686 
2687  g=aim->aaaa_1;
2688  deref_ptr(g);
2689  get_two_args(g->attr_list,&arg1,&arg2);
2690  if (arg1) {
2691  deref(arg1);
2692  deref_args(g,set_1);
2693  if (equal_types(arg1->type,inputfilesym)) {
2694  success=TRUE;
2696  thestream=get_stream(arg1);
2697  if (thestream!=NULL) {
2698  input_state=arg1;
2700  }
2701  }
2702  else
2703  Errorline("bad stream in %P.\n",g);
2704  }
2705  else
2706  Errorline("no stream in %P.\n",g);
2707 
2708  return success;
2709 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define set_1
Definition: def_const.h:194
#define NULL
Definition: def_const.h:203
ptr_psi_term input_state
Definition: def_glob.h:199
FILE * get_stream(ptr_psi_term t)
Definition: token.c:219
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define equal_types(A, B)
Definition: def_macro.h:106
void restore_state(ptr_psi_term t)
Definition: token.c:267
#define deref_args(P, S)
Definition: def_macro.h:145
void save_state(ptr_psi_term t)
Definition: token.c:230
ptr_definition type
Definition: def_struct.h:165
ptr_definition inputfilesym
Definition: def_glob.h:120
ptr_node attr_list
Definition: def_struct.h:171
static long c_set_output ( )
static

Definition at line 2716 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref, deref_args, deref_ptr, equal_types, Errorline(), FALSE, get_two_args(), output_stream, set_1, stream, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

2717 {
2718  long success=FALSE;
2719  ptr_psi_term arg1,arg2,g;
2720 
2721  g=aim->aaaa_1;
2722  deref_ptr(g);
2723  get_two_args(g->attr_list,&arg1,&arg2);
2724  if(arg1) {
2725  deref(arg1);
2726  deref_args(g,set_1);
2727  if(equal_types(arg1->type,stream) && arg1->value_3) {
2728  success=TRUE;
2729  output_stream=(FILE *)arg1->value_3;
2730  }
2731  else
2732  Errorline("bad stream in %P.\n",g);
2733  }
2734  else
2735  Errorline("no stream in %P.\n",g);
2736 
2737  return success;
2738 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
ptr_definition stream
Definition: def_glob.h:103
#define set_1
Definition: def_const.h:194
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define equal_types(A, B)
Definition: def_macro.h:106
#define deref_args(P, S)
Definition: def_macro.h:145
FILE * output_stream
Definition: def_glob.h:41
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
static long c_setq ( )
static

Definition at line 2194 of file built_ins.c.

References wl_goal::aaaa_1, wl_pair_list::aaaa_2, aim, wl_psi_term::attr_list, wl_pair_list::bbbb_2, clear_copy(), deref_ptr, deref_rec, Errorline(), FALSE, function_it, get_two_args(), HEAP, HEAP_ALLOC, heap_psi_term(), wl_pair_list::next, NULL, wl_definition::protected, quote_copy(), wl_definition::rule, TRUE, wl_psi_term::type, wl_definition::type_def, and undef.

2195 {
2196  long success=FALSE;
2197  ptr_psi_term arg1,arg2,g;
2198  ptr_pair_list p;
2199  ptr_definition d;
2200 
2201  g=aim->aaaa_1;
2202  get_two_args(g->attr_list,&arg1,&arg2);
2203  if (arg1 && arg2) {
2204  deref_rec(arg2); /* RM: Jan 6 1993 */
2205  deref_ptr(arg1);
2206  d=arg1->type;
2207  if (d->type_def==(def_type)function_it || d->type_def==(def_type)undef) {
2208  if (d->type_def==(def_type)undef || !d->protected) {
2209  if (!arg1->attr_list) {
2211  d->protected=FALSE;
2212  p=HEAP_ALLOC(pair_list);
2213  p->aaaa_2=heap_psi_term(4);
2214  p->aaaa_2->type=d;
2215  clear_copy();
2216  p->bbbb_2=quote_copy(arg2,HEAP);
2217  p->next=NULL;
2218  d->rule=p;
2219  success=TRUE;
2220  }
2221  else
2222  Errorline("%P may not have arguments in %P.\n",arg1,g);
2223  }
2224  else
2225  Errorline("%P should be dynamic in %P.\n",arg1,g);
2226  }
2227  else
2228  Errorline("%P should be a function or uninterpreted in %P.\n",arg1,g);
2229  }
2230  else
2231  Errorline("%P is missing one or both arguments.\n",g);
2232 
2233  return success;
2234 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_psi_term aaaa_2
Definition: def_struct.h:189
#define function_it
Definition: def_const.h:362
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define HEAP
Definition: def_const.h:147
void clear_copy()
Definition: copy.c:52
struct wl_definition * def_type
Definition: def_struct.h:32
ptr_pair_list next
Definition: def_struct.h:191
#define undef
Definition: def_const.h:360
ptr_psi_term heap_psi_term(long stat)
Definition: lefun.c:63
def_type type_def
Definition: def_struct.h:133
#define deref_rec(P)
Definition: def_macro.h:144
#define NULL
Definition: def_const.h:203
ptr_psi_term quote_copy(ptr_psi_term t, long heap_flag)
Definition: copy.c:200
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_pair_list rule
Definition: def_struct.h:126
#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
ptr_definition type
Definition: def_struct.h:165
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_node attr_list
Definition: def_struct.h:171
static long c_split_double ( )
static

Definition at line 3769 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref_ptr, Errorline(), FALSE, get_real_value(), get_two_args(), REAL, residuate(), residuate2(), TRUE, and unify_real_result().

3770 {
3771  long success=FALSE;
3772  ptr_psi_term arg1,arg2,funct,result;
3773  long n;
3774  union {
3775  double d;
3776  struct {
3777  int hi;
3778  int lo;
3779  } w2;
3780  }hack;
3781  double hi,lo;
3782  long n1,n2;
3783 
3784  funct = aim->aaaa_1;
3785  deref_ptr(funct);
3786  result=aim->bbbb_1;
3787 
3788  get_two_args(funct->attr_list, &arg1, &arg2);
3789  if(arg1 && arg2) {
3790  deref_ptr(arg1);
3791  deref_ptr(arg2);
3792  deref_ptr(result);
3793  if(get_real_value(result,(REAL *)&(hack.d),&n) &&
3794  get_real_value(arg1 ,(REAL *)&hi ,&n1) &&
3795  get_real_value(arg2 ,(REAL *)&lo ,&n2)) {
3796 
3797 
3798  if(n) {
3799 
3800  (void)unify_real_result(arg1,(REAL)hack.w2.hi);
3801  (void)unify_real_result(arg2,(REAL)hack.w2.lo);
3802  success=TRUE;
3803  }
3804  else
3805  if(n1 && n2) {
3806 
3807  hack.w2.hi=(int)hi;
3808  hack.w2.lo=(int)lo;
3809  (void)unify_real_result(result,hack.d);
3810  success=TRUE;
3811  }
3812  else {
3813 
3814  residuate(result);
3815  residuate2(arg1,arg2);
3816  }
3817  }
3818  else
3819  Errorline("non-numeric arguments in %P\n",funct);
3820  }
3821  else
3822  curry();
3823 
3824  return success;
3825 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
void curry()
Definition: lefun.c:157
#define REAL
Definition: def_const.h:72
void Errorline(char *format,...)
Definition: error.c:414
void residuate2(ptr_psi_term u, ptr_psi_term v)
Definition: lefun.c:130
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
long unify_real_result(ptr_psi_term t, REAL v)
Definition: built_ins.c:371
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
static long c_static ( )
static

Definition at line 1563 of file built_ins.c.

References wl_goal::aaaa_1, aim, assert_protected(), wl_psi_term::attr_list, deref_ptr, and TRUE.

1564 {
1565  ptr_psi_term t=aim->aaaa_1;
1566  deref_ptr(t);
1567  /* mark_quote(t); 14.9 */
1569  return TRUE;
1570 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void assert_protected(ptr_node n, long prot)
Definition: types.c:235
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
ptr_node attr_list
Definition: def_struct.h:171
static long c_string2psi ( )
static

Definition at line 4547 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, current_module, curry(), deref, deref_args, deref_ptr, error_psi_term, Errorline(), FALSE, get_module(), get_two_args(), NULL, overlap_type(), push_goal(), quoted_string, residuate(), set_1_2, stack_psi_term(), TRUE, wl_psi_term::type, unify, update_symbol(), wl_psi_term::value_3, and warningline().

4548 {
4549  long success=TRUE;
4550  ptr_psi_term arg1,arg2, /* arg3, */ funct,result,t;
4551  // long smaller;
4552  ptr_module mod=NULL; /* RM: Mar 11 1993 */
4553  ptr_module save_current; /* RM: Mar 12 1993 */
4554 
4555 
4556  funct=aim->aaaa_1;
4557  deref_ptr(funct);
4558  result=aim->bbbb_1;
4559  deref(result);
4560 
4561  get_two_args(funct->attr_list,&arg1,&arg2);
4562  if(arg1)
4563  deref(arg1);
4564  if(arg2)
4565  deref(arg2);
4566  deref_args(funct,set_1_2);
4567 
4568  if (arg1) {
4569  success=overlap_type(arg1->type,quoted_string);
4570  if(success) {
4571 
4572  /* RM: Mar 11 1993 */
4573  if(arg2)
4574  success=get_module(arg2,&mod);
4575 
4576  if (success) {
4577  if(!arg1->value_3)
4578  residuate(arg1);
4579  else {
4580  t=stack_psi_term(4);
4581  save_current=current_module;
4582  if(mod)
4583  current_module=mod;
4584  t->type=update_symbol(mod,(char *)arg1->value_3);
4585  current_module=save_current;
4586  if(t->type==error_psi_term->type)
4587  success=FALSE;
4588  else
4589  push_goal(unify,t,result,NULL);
4590  }
4591  }
4592  }
4593  else {
4594  success=FALSE;
4595  warningline("argument of '%P' is not a string.\n",funct);
4596  /* report_warning(funct,"argument is not a string"); 9.9 */
4597  }
4598  }
4599  else
4600  curry();
4601 
4602  if(!success)
4603  Errorline("error occurred in '%P'\n",funct);
4604 
4605  return success;
4606 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
ptr_module current_module
Definition: def_glob.h:161
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
int get_module(ptr_psi_term psi, ptr_module *module)
Definition: modules.c:1207
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_psi_term error_psi_term
Definition: def_glob.h:23
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
void warningline(char *format,...)
Definition: error.c:327
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
static long c_string_address ( )
static

Definition at line 3833 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref_ptr, Errorline(), FALSE, get_real_value(), get_two_args(), matches(), NULL, push_goal(), quoted_string, REAL, residuate2(), stack_psi_term(), wl_psi_term::type, unify, unify_real_result(), and wl_psi_term::value_3.

3834 {
3835  long success=FALSE;
3836  ptr_psi_term arg1,arg2,funct,result,t;
3837  REAL val;
3838  long num;
3839  long smaller;
3840 
3841 
3842  funct = aim->aaaa_1;
3843  deref_ptr(funct);
3844  result=aim->bbbb_1;
3845 
3846  get_two_args(funct->attr_list, &arg1, &arg2);
3847  if(arg1) {
3848  deref_ptr(arg1);
3849  deref_ptr(result);
3850  success=matches(arg1->type,quoted_string,&smaller);
3851  if (success) {
3852  if (arg1->value_3) {
3853  (void)unify_real_result(result,(REAL)(long)(arg1->value_3));
3854  }
3855  else {
3856  if((success=get_real_value(result,&val,&num))) {
3857  if(num) {
3858  t=stack_psi_term(4);
3859  t->type=quoted_string;
3860  t->value_3=(GENERIC)&val; // changed to addr djd
3861  push_goal(unify,t,arg1,NULL);
3862  }
3863  else
3864  residuate2(arg1,result);
3865 
3866  }
3867  else
3868  Errorline("result is not a real in %P\n",funct);
3869  }
3870  }
3871  else
3872  Errorline("argument is not a string in %P\n",funct);
3873  }
3874  else
3875  curry();
3876 
3877  return success;
3878 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
long get_real_value(ptr_psi_term t, REAL *v, long *n)
Definition: built_ins.c:246
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
void Errorline(char *format,...)
Definition: error.c:414
void residuate2(ptr_psi_term u, ptr_psi_term v)
Definition: lefun.c:130
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
long unify_real_result(ptr_psi_term t, REAL v)
Definition: built_ins.c:371
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
long c_string_length ( )

Definition at line 5389 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), wl_node::data, deref, deref_args, deref_ptr, FALSE, FEATCMP, find(), one, overlap_type(), quoted_string, residuate(), set_1, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

5390 {
5391  ptr_psi_term result,funct;
5392  ptr_node n1;
5393  long success=TRUE;
5394  long all_args=TRUE;
5395  long c_result;
5396  ptr_psi_term arg1;
5397  char * c_arg1;
5398 
5399  funct=aim->aaaa_1;
5400  deref_ptr(funct);
5401  result=aim->bbbb_1;
5402 
5403  /* Evaluate all arguments first: */
5404  n1=find(FEATCMP,one,funct->attr_list);
5405  if (n1) {
5406  arg1= (ptr_psi_term )n1->data;
5407  deref(arg1);
5408  }
5409  deref_args(funct,set_1);
5410 
5411  if (success) {
5412  if (n1) {
5413  if (overlap_type(arg1->type,quoted_string)) /* 10.8 */
5414  if (arg1->value_3)
5415  c_arg1= (char *)arg1->value_3;
5416  else {
5417  residuate(arg1);
5418  all_args=FALSE;
5419  }
5420  else
5421  success=FALSE;
5422  }
5423  else {
5424  all_args=FALSE;
5425  curry();
5426  };
5427  };
5428 
5429  if (success && all_args) {
5430  c_result=strlen(c_arg1);
5431  push_goal(unify,real_stack_psi_term(0,(REAL)c_result),result,NULL);
5432  };
5433 
5434  return success;
5435 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
Definition: lefun.c:113
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
Definition: lefun.c:38
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
#define REAL
Definition: def_const.h:72
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
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
char * one
Definition: def_glob.h:250
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
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
static long c_strip ( )
static

Definition at line 3570 of file built_ins.c.

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

3571 {
3572  long success=TRUE;
3573  ptr_psi_term arg1,arg2,funct,result;
3574 
3575  funct=aim->aaaa_1;
3576  deref_ptr(funct);
3577  result=aim->bbbb_1;
3578  get_two_args(funct->attr_list,&arg1,&arg2);
3579  if(arg1) {
3580  deref(arg1);
3581  deref_args(funct,set_1);
3582  resid_aim=NULL;
3583  /* PVR 23.2.94 */
3584  merge_unify(&(result->attr_list),copy_attr_list(arg1->attr_list));
3585  }
3586  else
3587  curry();
3588 
3589  return success;
3590 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void merge_unify(ptr_node *u, ptr_node v)
Definition: login.c:1070
#define set_1
Definition: def_const.h:194
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
static ptr_node copy_attr_list(ptr_node n)
Definition: built_ins.c:3550
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
long c_sub_string ( )

Definition at line 5444 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), wl_node::data, deref, deref_args, deref_ptr, FALSE, FEATCMP, find(), one, overlap_type(), quoted_string, residuate(), set_1_2_3, three, TRUE, two, wl_psi_term::type, and wl_psi_term::value_3.

5445 {
5446  ptr_psi_term result,funct,temp_result;
5447  ptr_node n1,n2,n3;
5448  long success=TRUE;
5449  long all_args=TRUE;
5450  char * c_result;
5451  ptr_psi_term arg1;
5452  char * c_arg1;
5453  ptr_psi_term arg2;
5454  long c_arg2;
5455  ptr_psi_term arg3;
5456  long c_arg3;
5457 
5458  funct=aim->aaaa_1;
5459  deref_ptr(funct);
5460  result=aim->bbbb_1;
5461 
5462  /* Evaluate all arguments first: */
5463  n1=find(FEATCMP,one,funct->attr_list);
5464  if (n1) {
5465  arg1= (ptr_psi_term )n1->data;
5466  deref(arg1);
5467  }
5468  n2=find(FEATCMP,two,funct->attr_list);
5469  if (n2) {
5470  arg2= (ptr_psi_term )n2->data;
5471  deref(arg2);
5472  }
5473  n3=find(FEATCMP,three,funct->attr_list);
5474  if (n3) {
5475  arg3= (ptr_psi_term )n3->data;
5476  deref(arg3);
5477  }
5478  deref_args(funct,set_1_2_3);
5479 
5480  if (success) {
5481  if (n1) {
5482  if (overlap_type(arg1->type,quoted_string)) /* 10.8 */
5483  if (arg1->value_3)
5484  c_arg1= (char *)arg1->value_3;
5485  else {
5486  residuate(arg1);
5487  all_args=FALSE;
5488  }
5489  else
5490  success=FALSE;
5491  }
5492  else {
5493  all_args=FALSE;
5494  curry();
5495  };
5496  };
5497 
5498  if (success) {
5499  if (n2) {
5500  if (overlap_type(arg2->type,integer)) /* 10.8 */
5501  if (arg2->value_3)
5502  c_arg2= (long)(* (double *)(arg2->value_3));
5503  else {
5504  residuate(arg2);
5505  all_args=FALSE;
5506  }
5507  else
5508  success=FALSE;
5509  }
5510  else {
5511  all_args=FALSE;
5512  curry();
5513  };
5514  };
5515 
5516  if (success) {
5517  if (n3) {
5518  if (overlap_type(arg3->type,integer)) /* 10.8 */
5519  if (arg3->value_3)
5520  c_arg3= (long)(* (double *)(arg3->value_3));
5521  else {
5522  residuate(arg3);
5523  all_args=FALSE;
5524  }
5525  else
5526  success=FALSE;
5527  }
5528  else {
5529  all_args=FALSE;
5530  curry();
5531  };
5532  };
5533 
5534  if (success && all_args) {
5535  c_result=sub_str(c_arg1,c_arg2,c_arg3);
5536  temp_result=stack_psi_term(0);
5537  temp_result->type=quoted_string;
5538  temp_result->value_3=(GENERIC)c_result;
5539  push_goal(unify,temp_result,result,NULL);
5540  };
5541 
5542  return success;
5543 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
char * two
Definition: def_glob.h:251
GENERIC data
Definition: def_struct.h:185
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
char * three
Definition: def_glob.h:252
char * sub_str(char *s, long p, long n)
Definition: built_ins.c:5184
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
#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
#define deref(P)
Definition: def_macro.h:142
#define set_1_2_3
Definition: def_const.h:197
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
char * one
Definition: def_glob.h:250
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define deref_args(P, S)
Definition: def_macro.h:145
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
static long c_succeed ( )
static

Definition at line 1346 of file built_ins.c.

References wl_goal::aaaa_1, aim, deref_args, set_empty, and TRUE.

1347 {
1348  ptr_psi_term t;
1349 
1350  t=aim->aaaa_1;
1351  deref_args(t,set_empty);
1352  return TRUE;
1353 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define set_empty
Definition: def_const.h:193
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
static long c_such_that ( )
static

Definition at line 4722 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), DEFRULES, deref_args, deref_ptr, get_two_args(), i_check_out(), NULL, prove, push_goal(), resid_aim, set_1_2, TRUE, and unify.

4723 {
4724  long success=TRUE;
4725  ptr_psi_term arg1,arg2,funct,result;
4726 
4727  funct=aim->aaaa_1;
4728  deref_ptr(funct);
4729  result=aim->bbbb_1;
4730  get_two_args(funct->attr_list,&arg1,&arg2);
4731  if (arg1 && arg2) {
4732  deref_ptr(arg1);
4733  deref_ptr(arg2);
4734  deref_args(funct,set_1_2);
4735  resid_aim=NULL;
4737  push_goal(unify,arg1,result,NULL);
4738  (void)i_check_out(arg1);
4739  }
4740  else
4741  curry();
4742 
4743  return success;
4744 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define DEFRULES
Definition: def_const.h:138
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
static long c_undo ( )
static

Definition at line 4274 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, DEFRULES, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), NULL, prove, push_choice_point(), set_1, and TRUE.

4275 {
4276  long success=TRUE;
4277  ptr_psi_term arg1,arg2,g;
4278 
4279  g=aim->aaaa_1;
4280  deref_ptr(g);
4281  get_two_args(g->attr_list,&arg1,&arg2);
4282  if (arg1) {
4283  deref_args(g,set_1);
4285  }
4286  else {
4287  success=FALSE;
4288  Errorline("argument missing in %P.\n",g);
4289  }
4290 
4291  return success;
4292 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:591
#define DEFRULES
Definition: def_const.h:138
#define set_1
Definition: def_const.h:194
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_node attr_list
Definition: def_struct.h:171
static long c_unify_func ( )
static

Definition at line 4152 of file built_ins.c.

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

4153 {
4154  long success=TRUE;
4155  ptr_psi_term funct,arg1,arg2,result;
4156 
4157  funct=aim->aaaa_1;
4158  deref_ptr(funct);
4159  get_two_args(funct->attr_list,&arg1,&arg2);
4160  if (arg1 && arg2) {
4161  deref(arg1);
4162  deref(arg2);
4163  deref_args(funct,set_1_2);
4164  result=aim->bbbb_1;
4165  push_goal(unify,arg1,result,NULL);
4166  push_goal(unify,arg1,arg2,NULL);
4167  }
4168  else
4169  curry();
4170 
4171  return success;
4172 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
static long c_unify_pred ( )
static

Definition at line 4180 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), NULL, push_goal(), set_1_2, TRUE, and unify.

4181 {
4182  long success=FALSE;
4183  ptr_psi_term arg1,arg2,g;
4184 
4185  g=aim->aaaa_1;
4186  deref_ptr(g);
4187  get_two_args(g->attr_list,&arg1,&arg2);
4188  if (arg1 && arg2) {
4189  deref_args(g,set_1_2);
4190  success=TRUE;
4191  push_goal(unify,arg1,arg2,NULL);
4192  }
4193  else
4194  Errorline("argument missing in %P.\n",g);
4195 
4196  return success;
4197 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
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 Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_node attr_list
Definition: def_struct.h:171
static long c_var ( )
static

Definition at line 1374 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, get_one_arg(), lf_false, lf_true, NULL, push_goal(), resid_aim, set_1, stack_psi_term(), top, TRUE, wl_psi_term::type, and unify.

1375 {
1376  long success=TRUE;
1377  ptr_psi_term arg1,result,g,other;
1378 
1379  g=aim->aaaa_1;
1380  deref_ptr(g);
1381  result=aim->bbbb_1;
1382  deref(result);
1383  get_one_arg(g->attr_list,&arg1);
1384  if (arg1) {
1385  deref(arg1);
1386  deref_args(g,set_1);
1387  other=stack_psi_term(4); /* 19.11 */
1388  other->type=((arg1->type==top)&&(arg1->attr_list==NULL))?lf_true:lf_false;
1389  resid_aim=NULL;
1390  push_goal(unify,result,other,NULL);
1391  }
1392  else {
1393  curry();
1394  /* Errorline("argument missing in %P.\n",t); */
1395  /* return c_abort(); */
1396  }
1397 
1398  return success;
1399 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void get_one_arg(ptr_node t, ptr_psi_term *a)
Definition: login.c:86
#define set_1
Definition: def_const.h:194
ptr_definition top
Definition: def_glob.h:106
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define deref(P)
Definition: def_macro.h:142
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
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
static long c_write ( )
static

Definition at line 2951 of file built_ins.c.

References const_quote, FALSE, generic_write(), indent, write_canon, write_corefs, write_resids, and write_stderr.

2952 {
2953  indent=FALSE;
2959  return generic_write();
2960 }
static long generic_write()
Definition: built_ins.c:2904
long write_corefs
Definition: def_glob.h:182
long write_resids
Definition: def_glob.h:183
long indent
Definition: def_glob.h:179
#define FALSE
Definition: def_const.h:128
long const_quote
Definition: def_glob.h:180
long write_stderr
Definition: def_glob.h:181
long write_canon
Definition: def_glob.h:184
static long c_write_canonical ( )
static

Definition at line 2983 of file built_ins.c.

References const_quote, FALSE, generic_write(), indent, TRUE, write_canon, write_corefs, write_resids, and write_stderr.

2984 {
2985  indent=FALSE;
2986  const_quote=TRUE;
2990  write_canon=TRUE;
2991  return generic_write();
2992 }
static long generic_write()
Definition: built_ins.c:2904
long write_corefs
Definition: def_glob.h:182
long write_resids
Definition: def_glob.h:183
long indent
Definition: def_glob.h:179
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long const_quote
Definition: def_glob.h:180
long write_stderr
Definition: def_glob.h:181
long write_canon
Definition: def_glob.h:184
static long c_write_err ( )
static

Definition at line 2920 of file built_ins.c.

References const_quote, FALSE, generic_write(), indent, TRUE, write_canon, write_corefs, write_resids, and write_stderr.

2921 {
2922  indent=FALSE;
2928  return generic_write();
2929 }
static long generic_write()
Definition: built_ins.c:2904
long write_corefs
Definition: def_glob.h:182
long write_resids
Definition: def_glob.h:183
long indent
Definition: def_glob.h:179
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long const_quote
Definition: def_glob.h:180
long write_stderr
Definition: def_glob.h:181
long write_canon
Definition: def_glob.h:184
static long c_writeq ( )
static

Definition at line 2967 of file built_ins.c.

References const_quote, FALSE, generic_write(), indent, TRUE, write_canon, write_corefs, write_resids, and write_stderr.

2968 {
2969  indent=FALSE;
2970  const_quote=TRUE;
2975  return generic_write();
2976 }
static long generic_write()
Definition: built_ins.c:2904
long write_corefs
Definition: def_glob.h:182
long write_resids
Definition: def_glob.h:183
long indent
Definition: def_glob.h:179
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long const_quote
Definition: def_glob.h:180
long write_stderr
Definition: def_glob.h:181
long write_canon
Definition: def_glob.h:184
static long c_writeq_err ( )
static

Definition at line 2936 of file built_ins.c.

References const_quote, FALSE, generic_write(), indent, TRUE, write_canon, write_corefs, write_resids, and write_stderr.

2937 {
2938  indent=FALSE;
2939  const_quote=TRUE;
2944  return generic_write();
2945 }
static long generic_write()
Definition: built_ins.c:2904
long write_corefs
Definition: def_glob.h:182
long write_resids
Definition: def_glob.h:183
long indent
Definition: def_glob.h:179
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long const_quote
Definition: def_glob.h:180
long write_stderr
Definition: def_glob.h:181
long write_canon
Definition: def_glob.h:184
static long c_xor ( )
static

Definition at line 1033 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_bool(), get_two_args(), matches(), NULL, push_goal(), residuate(), set_1_2, TRUE, wl_psi_term::type, UNDEF, unify, unify_bool(), and unify_bool_result().

1034 {
1035  long success=TRUE;
1036  ptr_psi_term funct,arg1,arg2,arg3;
1037  long sm1, sm2, sm3;
1038  long a1comp, a2comp, a3comp;
1039  long a1, a2, a3;
1040 
1041  funct=aim->aaaa_1;
1042  deref_ptr(funct);
1043  get_two_args(funct->attr_list,&arg1,&arg2);
1044  if (arg1 && arg2) {
1045  deref(arg1);
1046  deref(arg2);
1047  deref_args(funct,set_1_2);
1048  arg3=aim->bbbb_1;
1049  deref(arg3);
1050 
1051  a1comp = matches(arg1->type,boolean,&sm1);
1052  a2comp = matches(arg2->type,boolean,&sm2);
1053  a3comp = matches(arg3->type,boolean,&sm3);
1054  if (a1comp && a2comp && a3comp) {
1055  a1 = get_bool(arg1->type);
1056  a2 = get_bool(arg2->type);
1057  a3 = get_bool(arg3->type);
1058  if ((a1==TRUE || a1==FALSE) && (a2==TRUE || a2==FALSE)) {
1059  unify_bool_result(arg3, a1^a2);
1060  } else if ((a1==TRUE || a1==FALSE) && (a3==TRUE || a3==FALSE)) {
1061  unify_bool_result(arg2, a1^a3);
1062  } else if ((a3==TRUE || a3==FALSE) && (a2==TRUE || a2==FALSE)) {
1063  unify_bool_result(arg1, a3^a2);
1064 
1065  } else if (a1==TRUE && arg3==arg2) {
1066  success=FALSE;
1067  } else if (a2==TRUE && arg3==arg2) {
1068  success=FALSE;
1069  } else if (a3==TRUE && arg1==arg2) {
1070  success=FALSE;
1071 
1072  } else if (a1==FALSE) {
1073  push_goal(unify,arg2,arg3,(GENERIC)NULL);
1074  } else if (a2==FALSE) {
1075  push_goal(unify,arg1,arg3,(GENERIC)NULL);
1076  } else if (a3==FALSE) {
1077  push_goal(unify,arg1,arg2,(GENERIC)NULL);
1078 
1079  } else if (arg1==arg2) {
1080  unify_bool_result(arg3,FALSE);
1081  } else if (arg1==arg3) {
1082  unify_bool_result(arg2,FALSE);
1083  } else if (arg3==arg2) {
1084  unify_bool_result(arg1,FALSE);
1085  } else {
1086  if (a1==UNDEF) residuate(arg1);
1087  if (a2==UNDEF) residuate(arg2);
1088  if (a3==UNDEF) residuate(arg3);
1089  }
1090  if (!sm1) unify_bool(arg1);
1091  if (!sm2) unify_bool(arg2);
1092  if (!sm3) unify_bool(arg3);
1093  }
1094  else {
1095  success=FALSE;
1096  Errorline("Non-boolean argument or result in '%P'.\n",funct);
1097  }
1098  }
1099  else
1100  curry();
1101 
1102  return success;
1103 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void residuate(ptr_psi_term t)
Definition: lefun.c:113
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
static void unify_bool(ptr_psi_term arg)
Definition: built_ins.c:878
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Definition: error.c:414
#define set_1_2
Definition: def_const.h:196
#define UNDEF
Definition: def_const.h:132
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_goal aim
Definition: def_glob.h:49
static long get_bool(ptr_definition typ)
Definition: built_ins.c:870
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
long check_real ( ptr_psi_term  t,
REAL v,
long *  n 
)

Definition at line 217 of file built_ins.c.

References FALSE, matches(), REAL, real, and TRUE.

221 {
222  long success=FALSE;
223  long smaller;
224 
225  if (t) {
226  success=matches(t->type,real,&smaller);
227  if (success) {
228  *n=FALSE;
229  if (smaller && t->value_3) {
230  *v= *(REAL *)t->value_3;
231  *n=TRUE;
232  }
233  }
234  }
235  return success;
236 }
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#define REAL
Definition: def_const.h:72
ptr_definition real
Definition: def_glob.h:102
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term collect_symbols ( long  sel)

Definition at line 3446 of file built_ins.c.

References wl_definition::children, first_definition, fx, fx_sym, fy, fy_sym, greatest_sel, hidden_type(), least_sel, wl_operator_data::next, wl_definition::next, nothing, NULL, one, wl_definition::op_data, op_sel, opsym, wl_definition::parents, wl_operator_data::precedence, stack_add_int_attr(), stack_add_psi_attr(), stack_cons(), stack_nil(), stack_psi_term(), three, top, two, wl_psi_term::type, wl_definition::type_def, type_it, undef, xf, xf_sym, xfx, xfx_sym, xfy, xfy_sym, yf, yf_sym, yfx, and yfx_sym.

3449 {
3450  ptr_psi_term new;
3451  ptr_definition def;
3452  long botflag;
3453  ptr_psi_term result;
3454 
3455 
3456  result=stack_nil();
3457 
3458  for(def=first_definition;def;def=def->next) {
3459 
3460  if (sel==least_sel || sel==greatest_sel) {
3461  botflag=(sel==least_sel);
3462 
3463  /* Insert the node if it's a good one */
3464  if (((botflag?def->children:def->parents)==NULL &&
3465  def!=top && def!=nothing &&
3466  def->type_def==(def_type)type_it ||
3467  def->type_def==(def_type)undef)
3468  && !hidden_type(def)) {
3469  /* Create the node that will be inserted */
3470  new=stack_psi_term(4);
3471  new->type=def;
3472  result=stack_cons((ptr_psi_term)new,(ptr_psi_term)result);
3473  }
3474  }
3475  else if (sel==op_sel) {
3476  ptr_operator_data od=def->op_data;
3477 
3478  while (od) {
3479  ptr_psi_term name_loc,type;
3480 
3481  new=stack_psi_term(4);
3482  new->type=opsym;
3483  result=stack_cons((ptr_psi_term)new,(ptr_psi_term)result);
3484 
3486 
3487  type=stack_psi_term(4);
3488  switch (od->type) {
3489  case xf:
3490  type->type=xf_sym;
3491  break;
3492  case yf:
3493  type->type=yf_sym;
3494  break;
3495  case fx:
3496  type->type=fx_sym;
3497  break;
3498  case fy:
3499  type->type=fy_sym;
3500  break;
3501  case xfx:
3502  type->type=xfx_sym;
3503  break;
3504  case xfy:
3505  type->type=xfy_sym;
3506  break;
3507  case yfx:
3508  type->type=yfx_sym;
3509  break;
3510  }
3511  stack_add_psi_attr(new,two,type);
3512 
3513  name_loc=stack_psi_term(4);
3514  name_loc->type=def;
3515  stack_add_psi_attr(new,three,name_loc);
3516 
3517  od=od->next;
3518  }
3519  }
3520  }
3521 
3522  return result;
3523 }
#define yfx
Definition: def_const.h:268
ptr_definition xfy_sym
Definition: def_glob.h:127
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
Definition: built_ins.c:47
#define least_sel
Definition: def_const.h:6
#define xfx
Definition: def_const.h:265
ptr_definition opsym
Definition: def_glob.h:112
char * two
Definition: def_glob.h:251
#define undef
Definition: def_const.h:360
ptr_operator_data next
Definition: def_struct.h:49
#define fx
Definition: def_const.h:262
def_type type_def
Definition: def_struct.h:133
ptr_definition fy_sym
Definition: def_glob.h:125
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define xfy
Definition: def_const.h:267
char * three
Definition: def_glob.h:252
#define op_sel
Definition: def_const.h:8
void stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
Definition: token.c:192
ptr_definition xfx_sym
Definition: def_glob.h:126
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition yf_sym
Definition: def_glob.h:124
void stack_add_int_attr(ptr_psi_term t, char *attrname, long value)
Definition: token.c:73
#define greatest_sel
Definition: def_const.h:7
ptr_definition first_definition
Definition: def_glob.h:3
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_psi_term stack_nil()
Definition: built_ins.c:29
char * one
Definition: def_glob.h:250
#define xf
Definition: def_const.h:261
#define yf
Definition: def_const.h:263
ptr_definition yfx_sym
Definition: def_glob.h:128
ptr_definition fx_sym
Definition: def_glob.h:123
ptr_definition nothing
Definition: def_glob.h:98
ptr_definition type
Definition: def_struct.h:165
ptr_definition xf_sym
Definition: def_glob.h:122
long hidden_type(ptr_definition t)
Definition: built_ins.c:3421
ptr_int_list children
Definition: def_struct.h:131
ptr_operator_data op_data
Definition: def_struct.h:139
#define fy
Definition: def_const.h:264
ptr_int_list parents
Definition: def_struct.h:130
static ptr_node copy_attr_list ( ptr_node  n)
static

Definition at line 3550 of file built_ins.c.

References wl_node::data, wl_node::key, wl_node::left, NULL, wl_node::right, and STACK_ALLOC.

3552 {
3553  ptr_node m;
3554 
3555  if (n==NULL) return NULL;
3556 
3557  m = STACK_ALLOC(node);
3558  m->key = n->key;
3559  m->data = n->data;
3560  m->left = copy_attr_list(n->left);
3561  m->right = copy_attr_list(n->right);
3562  return m;
3563 }
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 STACK_ALLOC(A)
Definition: def_macro.h:16
static ptr_node copy_attr_list(ptr_node n)
Definition: built_ins.c:3550
ptr_node right
Definition: def_struct.h:184
long declare_operator ( ptr_psi_term  t)

Definition at line 5114 of file built_ins.c.

References wl_node::data, deref_ptr, Errorline(), FALSE, FEATCMP, find(), fx, fx_sym, fy, fy_sym, get_two_args(), integer, wl_definition::keyword, MAX_PRECEDENCE, nop, op_declare(), REAL, sub_type(), wl_keyword::symbol, three, TRUE, wl_psi_term::type, wl_psi_term::value_3, xf, xf_sym, xfx, xfx_sym, xfy, xfy_sym, yf, yf_sym, yfx, and yfx_sym.

5116 {
5117  ptr_psi_term prec,type,atom;
5118  ptr_node n;
5119  char *s;
5120  long p;
5121  operator kind=nop;
5122  long success=FALSE;
5123 
5124  deref_ptr(t);
5125  n=t->attr_list;
5126  get_two_args(n,&prec,&type);
5127  n=find(FEATCMP,three,n);
5128  if (n && prec && type) {
5129  atom=(ptr_psi_term )n->data;
5130  deref_ptr(prec);
5131  deref_ptr(type);
5132  deref_ptr(atom);
5133  if (!atom->value_3) {
5134  s=atom->type->keyword->symbol;
5135  if (sub_type(prec->type,integer) && prec->value_3) { /* 10.8 */
5136  p = * (REAL *)prec->value_3;
5137  if (p>0 && p<=MAX_PRECEDENCE) {
5138 
5139  if (type->type == xf_sym) kind=xf;
5140  else if (type->type == yf_sym) kind=yf;
5141  else if (type->type == fx_sym) kind=fx;
5142  else if (type->type == fy_sym) kind=fy;
5143  else if (type->type == xfx_sym) kind=xfx;
5144  else if (type->type == xfy_sym) kind=xfy;
5145  else if (type->type == yfx_sym) kind=yfx;
5146  else
5147  Errorline("bad operator kind '%s'.\n",type->type->keyword->symbol);
5148 
5149  if (kind!=nop) {
5150  op_declare(p,kind,s);
5151  success=TRUE;
5152  }
5153  }
5154  else
5155  Errorline("precedence must range from 1 to 1200 in %P.\n",t);
5156  }
5157  else
5158  Errorline("precedence must be a positive integer in %P.\n",t);
5159  }
5160  else
5161  Errorline("numbers or strings may not be operators in %P.\n",t);
5162  }
5163  else
5164  Errorline("argument missing in %P.\n",t);
5165 
5166  return success;
5167 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define yfx
Definition: def_const.h:268
#define FEATCMP
Definition: def_const.h:257
ptr_definition xfy_sym
Definition: def_glob.h:127
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
ptr_definition fy_sym
Definition: def_glob.h:125
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
#define xfy
Definition: def_const.h:267
char * three
Definition: def_glob.h:252
char * symbol
Definition: def_struct.h:91
#define nop
Definition: def_const.h:260
#define REAL
Definition: def_const.h:72
ptr_definition xfx_sym
Definition: def_glob.h:126
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
void Errorline(char *format,...)
Definition: error.c:414
ptr_definition yf_sym
Definition: def_glob.h:124
#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
GENERIC value_3
Definition: def_struct.h:170
#define xf
Definition: def_const.h:261
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
#define yf
Definition: def_const.h:263
ptr_definition yfx_sym
Definition: def_glob.h:128
#define MAX_PRECEDENCE
Definition: def_const.h:103
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition fx_sym
Definition: def_glob.h:123
static void op_declare(long p, operator t, char *s)
Definition: built_ins.c:5082
ptr_definition type
Definition: def_struct.h:165
ptr_definition xf_sym
Definition: def_glob.h:122
ptr_node attr_list
Definition: def_struct.h:171
#define fy
Definition: def_const.h:264
void exit_life ( long  nl_flag)

Definition at line 2090 of file built_ins.c.

References garbage_time, life_end, NOTQUIET, and open_input_file().

2092 {
2093  (void)open_input_file("stdin");
2094  (void)times(&life_end);
2095  if (NOTQUIET) { /* 21.1 */
2096  if (nl_flag) printf("\n");
2097  printf("*** Exiting Wild_Life ");
2098  printf("[%1.3fs cpu, %1.3fs gc (%2.1f%%)]\n",
2099  (life_end.tms_utime-life_start.tms_utime)/60.0,
2100  garbage_time,
2101  garbage_time*100 / ((life_end.tms_utime-life_start.tms_utime)/60.0)
2102  );
2103  }
2104 
2105 #ifdef ARITY /* RM: Mar 29 1993 */
2106  arity_end();
2107 #endif
2108 
2109  exit(EXIT_SUCCESS);
2110 }
#define NOTQUIET
Definition: def_macro.h:10
struct tms life_start life_end
Definition: def_glob.h:17
float garbage_time
Definition: def_glob.h:16
long open_input_file(char *file)
Definition: token.c:504
long file_exists ( char *  s)

Definition at line 1622 of file built_ins.c.

References expand_file_name(), FALSE, and TRUE.

1624 {
1625  FILE *f;
1626  char *e;
1627  long success=FALSE;
1628 
1629  e=expand_file_name(s);
1630  if ((f=fopen(e,"r"))) {
1631  (void)fclose(f);
1632  success=TRUE;
1633  }
1634  return success;
1635 }
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
char * expand_file_name(char *s)
Definition: token.c:449
static long generic_write ( )
static

Definition at line 2904 of file built_ins.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_args, pred_write(), set_empty, and TRUE.

2905 {
2906  ptr_psi_term g;
2907 
2908  g=aim->aaaa_1;
2909  /* deref_rec(g); */
2910  deref_args(g,set_empty);
2911  pred_write(g->attr_list);
2912  /* fflush(output_stream); */
2913  return TRUE;
2914 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define set_empty
Definition: def_const.h:193
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
void pred_write(ptr_node n)
Definition: print.c:1365
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_node attr_list
Definition: def_struct.h:171
static long get_bool ( ptr_definition  typ)
static

Definition at line 870 of file built_ins.c.

References FALSE, lf_false, lf_true, sub_type(), TRUE, and UNDEF.

872 {
873  if (sub_type(typ,lf_true)) return TRUE;
874  else if (sub_type(typ,lf_false)) return FALSE;
875  else return UNDEF;
876 }
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
#define UNDEF
Definition: def_const.h:132
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define FALSE
Definition: def_const.h:128
ptr_definition lf_false
Definition: def_glob.h:89
static long get_bool_value ( ptr_psi_term  t,
REAL v,
long *  n 
)
static

Definition at line 284 of file built_ins.c.

References boolean, def_ptr, FALSE, heap_pointer, i_check_out(), int_ptr, lf_false, lf_true, matches(), push_ptr_value(), and TRUE.

288 {
289  long success=FALSE;
290  long smaller;
291 
292 
293  if(t) {
294  success=matches(t->type,boolean,&smaller);
295  if(success) {
296  *n=FALSE;
297  if(smaller) {
298  if(matches(t->type,lf_false,&smaller) && smaller) {
299  *v= 0;
300  *n=TRUE;
301  }
302  else
303  if(matches(t->type,lf_true,&smaller) && smaller) {
304  *v= 1;
305  *n=TRUE;
306  }
307  }
308  else {
309  if((GENERIC)t<heap_pointer) { /* RM: Jun 8 1993 */
312  t->type=boolean;
313  t->status=0;
314  (void)i_check_out(t);
315  }
316  }
317  }
318  }
319 
320  return success;
321 }
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
#define def_ptr
Definition: def_const.h:173
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#define TRUE
Definition: def_const.h:127
ptr_definition lf_true
Definition: def_glob.h:107
#define FALSE
Definition: def_const.h:128
ptr_definition lf_false
Definition: def_glob.h:89
GENERIC heap_pointer
Definition: def_glob.h:12
ptr_definition type
Definition: def_struct.h:165
ptr_definition boolean
Definition: def_glob.h:73
unsigned long * GENERIC
Definition: def_struct.h:17
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
#define int_ptr
Definition: def_const.h:172
long get_real_value ( ptr_psi_term  t,
REAL v,
long *  n 
)

Definition at line 246 of file built_ins.c.

References def_ptr, FALSE, heap_pointer, i_check_out(), int_ptr, matches(), push_ptr_value(), REAL, real, and TRUE.

250 {
251  long success=FALSE;
252  long smaller;
253  if (t) {
254  success=matches(t->type,real,&smaller);
255  if (success) {
256  *n=FALSE;
257  if (smaller) {
258  if (t->value_3) {
259  *v= *(REAL *)t->value_3;
260  *n=TRUE;
261  }
262  }
263  else {
264  if((GENERIC)t<heap_pointer) { /* RM: Jun 8 1993 */
267  t->type=real;
268  t->status=0;
269  (void)i_check_out(t);
270  }
271  }
272  }
273  }
274  return success;
275 }
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
#define def_ptr
Definition: def_const.h:173
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#define REAL
Definition: def_const.h:72
ptr_definition real
Definition: def_glob.h:102
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
GENERIC heap_pointer
Definition: def_glob.h:12
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
#define int_ptr
Definition: def_const.h:172
void global_error_check ( ptr_node  n,
int *  error,
int *  eval_2 
)

Definition at line 2428 of file built_ins.c.

References wl_psi_term::attr_list, deref_eval(), deref_ptr, error_psi_term, Errorline(), FALSE, get_two_args(), global, global_error_check(), leftarrowsym, NULL, TRUE, wl_psi_term::type, wl_definition::type_def, undef, and wl_psi_term::value_3.

2431 {
2432  if (n) {
2433  ptr_psi_term t,a1,a2;
2434  int bad_init=FALSE;
2435  global_error_check(n->left, error, eval_2);
2436 
2437  t=(ptr_psi_term)n->data;
2438  deref_ptr(t);
2439  if (t->type==leftarrowsym) {
2440  get_two_args(t->attr_list,&a1,&a2);
2441  if (a1==NULL || a2==NULL) {
2442  Errorline("%P is an incorrect global variable declaration (%E).\n",t);
2443  *error=TRUE;
2444  bad_init=TRUE;
2445  } else {
2446  deref_ptr(a1);
2447  deref_ptr(a2);
2448  t=a1;
2449  if (deref_eval(a2)) *eval_2=TRUE;
2450  }
2451  }
2452  if (!bad_init && t->type->type_def!=(def_type)undef && t->type->type_def!=(def_type)global) {
2453  Errorline("%T %P cannot be redeclared as a global variable (%E).\n",
2454  t->type->type_def,
2455  t);
2456  t->type=error_psi_term->type;
2457  t->value_3=NULL; /* RM: Mar 23 1993 */
2458  *error=TRUE;
2459  }
2460 
2461  global_error_check(n->right, error, eval_2);
2462  }
2463 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define global
Definition: def_const.h:364
#define undef
Definition: def_const.h:360
def_type type_def
Definition: def_struct.h:133
void global_error_check(ptr_node n, int *error, int *eval_2)
Definition: built_ins.c:2428
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_psi_term error_psi_term
Definition: def_glob.h:23
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_definition leftarrowsym
Definition: def_glob.h:88
long deref_eval(ptr_psi_term t)
Definition: lefun.c:1087
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
ptr_node right
Definition: def_struct.h:184
void global_one ( ptr_psi_term  t)

Definition at line 2482 of file built_ins.c.

References clear_copy(), deref_ptr, get_two_args(), global, HEAP, leftarrowsym, quote_copy(), and stack_psi_term().

2484 {
2485  ptr_psi_term u; // ,val;
2486 
2487  if (t->type==leftarrowsym) {
2488  get_two_args(t->attr_list,&t,&u);
2489  deref_ptr(t);
2490  deref_ptr(u);
2491  }
2492  else
2493  u=stack_psi_term(4);
2494 
2495  clear_copy();
2497  t->type->init_value=quote_copy(u,HEAP); /* RM: Mar 23 1993 */
2498 
2499  /* eval_global_var(t); RM: Feb 4 1994 */
2500 
2501  /* RM: Nov 10 1993
2502  val=t->type->global_value;
2503  if (val && (GENERIC)val<heap_pointer) {
2504  deref_ptr(val);
2505  push_psi_ptr_value(val,&(val->coref));
2506  val->coref=u;
2507  } else
2508  t->type->global_value=u;
2509  */
2510 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
ptr_psi_term init_value
Definition: def_struct.h:142
#define HEAP
Definition: def_const.h:147
void clear_copy()
Definition: copy.c:52
struct wl_definition * def_type
Definition: def_struct.h:32
#define global
Definition: def_const.h:364
def_type type_def
Definition: def_struct.h:133
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
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition leftarrowsym
Definition: def_glob.h:88
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
void global_tree ( ptr_node  n)

Definition at line 2466 of file built_ins.c.

References deref_ptr, global_one(), and global_tree().

2468 {
2469  if (n) {
2470  ptr_psi_term t;
2471  global_tree(n->left);
2472 
2473  t=(ptr_psi_term)n->data;
2474  deref_ptr(t);
2475  global_one(t);
2476 
2477  global_tree(n->right);
2478  }
2479 }
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
void global_tree(ptr_node n)
Definition: built_ins.c:2466
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void global_one(ptr_psi_term t)
Definition: built_ins.c:2482
ptr_node right
Definition: def_struct.h:184
long has_rules ( ptr_pair_list  r)

Definition at line 4799 of file built_ins.c.

References FALSE, NULL, and TRUE.

4801 {
4802  if (r==NULL) return FALSE;
4803  while (r) {
4804  if (r->aaaa_2!=NULL) return TRUE;
4805  r=r->next;
4806  }
4807  return FALSE;
4808 }
ptr_psi_term aaaa_2
Definition: def_struct.h:189
ptr_pair_list next
Definition: def_struct.h:191
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long hidden_type ( ptr_definition  t)

Definition at line 3421 of file built_ins.c.

References comment, constant, functor, and variable.

3423 {
3424  return (/* (t==conjunction) || 19.8 */
3425  /* (t==disjunction) || RM: Dec 9 1992 */
3426  (t==constant) || (t==variable) ||
3427  (t==comment) || (t==functor));
3428 }
ptr_definition comment
Definition: def_glob.h:80
ptr_definition constant
Definition: def_glob.h:82
ptr_definition functor
Definition: def_glob.h:91
ptr_definition variable
Definition: def_glob.h:111
void init_built_in_types ( )

Definition at line 5805 of file built_ins.c.

References aborthooksym, abortsym, add_module1, add_module2, add_module3, alist, all_public_symbols(), and, apply, bi_module, boolpredsym, built_in, c_abort(), c_alias(), c_and(), c_append_file(), c_apply(), c_args(), c_ascii(), c_assert_first(), c_assert_last(), c_bk_assign(), c_boolpred(), c_char(), c_chdir(), c_clause(), c_close(), c_combined_name(), c_concatenate(), c_cond(), c_copy_pointer(), c_copy_term(), c_current_module(), c_declaration(), c_delay_check(), c_deref_length(), c_diff(), c_diff_address(), c_disj(), c_display_modules(), c_display_persistent(), c_dynamic(), c_equal(), c_eval(), c_eval_disjunction(), c_eval_inplace(), c_exist_feature(), c_exists(), c_exists_choice(), c_fail(), c_feature_values(), c_features(), c_get(), c_get_choice(), c_global(), c_global_assign(), c_gt(), c_gtoe(), c_halt(), c_implies(), c_initrandom(), c_int2string(), c_is_function(), c_is_predicate(), c_is_sort(), c_listing(), c_load(), c_lt(), c_ltoe(), c_module_name(), c_non_strict(), c_nonvar(), c_not(), c_not_implemented(), c_op(), c_open_in(), c_open_module(), c_open_out(), c_ops(), c_or(), c_page_width(), c_parse(), c_persistent(), c_print_codes(), c_print_depth(), c_print_variables(), c_private(), c_private_feature(), c_project(), c_psi2string(), c_public(), c_put(), c_put_err(), c_pwrite(), c_pwriteq(), c_random(), c_read_psi(), c_read_token(), c_repeat(), c_replace(), c_retract(), c_rootsort(), c_same_address(), c_set_choice(), c_set_input(), c_set_module(), c_set_output(), c_setq(), c_split_double(), c_static(), c_string2psi(), c_string_address(), c_string_length(), c_strip(), c_sub_string(), c_succeed(), c_such_that(), c_trace_input(), c_undo(), c_unify_func(), c_unify_pred(), c_var(), c_write(), c_write_canonical(), c_write_err(), c_writeq(), c_writeq_err(), c_xor(), call_handlersym, calloncesym, wl_definition::code, colonsym, commasym, comment, constant, cut, day_attr, delay_checksym, disj_nil, disjunction, dynamicsym, encodesym, eof, eqsym, error_psi_term, eval_argsym, final_dot, final_question, funcsym, function_it, functor, fx_sym, fy_sym, hash_lookup(), heap_psi_term(), hour_attr, iff, inputfilesym, insert_math_builtins(), insert_sys_builtins(), insert_system_builtins(), insert_type_builtins(), integer, wl_definition::keyword, leftarrowsym, lf_false, lf_true, life_or, listingsym, loadsym, minus_symbol, minute_attr, month_attr, new_built_in(), nil, no_module, NOT_CODED, nothing, null_psi_term, nullsym, one, opsym, predicate, predsym, wl_keyword::public, quote, quoted_string, real, second_attr, set_current_module(), staticsym, stream, succeed, such_that, wl_keyword::symbol, wl_module::symbol_table, syntax_module, three, timesym, top, tracesym, TRUE, two, wl_psi_term::type, wl_definition::type_def, type_it, typesym, update_symbol(), variable, weekday_attr, xf_sym, xfx_sym, xfy_sym, year_attr, yf_sym, and yfx_sym.

5806 {
5807  ptr_definition t;
5808 
5809  /* symbol_table=NULL; RM: Feb 3 1993 */
5810 
5811 
5812 
5813  /* RM: Jan 13 1993 */
5814  /* Initialize the minimum syntactic symbols */
5815  (void)set_current_module(syntax_module); /* RM: Feb 3 1993 */
5817  (void)update_symbol(syntax_module,"[");
5818  (void)update_symbol(syntax_module,"]");
5819  (void)update_symbol(syntax_module,"(");
5820  (void)update_symbol(syntax_module,")");
5821  (void)update_symbol(syntax_module,"{");
5822  (void)update_symbol(syntax_module,"}");
5823  (void)update_symbol(syntax_module,".");
5824  (void)update_symbol(syntax_module,"?");
5825 
5826 
5831  eof =update_symbol(syntax_module,"end_of_file");
5835  life_or =update_symbol(syntax_module,";");/* RM: Apr 6 1993 */
5836  minus_symbol =update_symbol(syntax_module,"-");/* RM: Jun 21 1993 */
5842 
5843  /* RM: Jul 7 1993 */
5846 
5847 
5848 
5849  /* RM: Feb 3 1993 */
5851  error_psi_term=heap_psi_term(4); /* 8.10 */
5852  error_psi_term->type=update_symbol(bi_module,"*** ERROR ***");
5854 
5855  apply =update_symbol(bi_module,"apply");
5856  boolean =update_symbol(bi_module,"bool");
5857  boolpredsym =update_symbol(bi_module,"bool_pred");
5858  built_in =update_symbol(bi_module,"built_in");
5859  calloncesym =update_symbol(bi_module,"call_once");
5860  /* colon sym */
5861  /* comma sym */
5862  comment =update_symbol(bi_module,"comment");
5863 
5864 
5865  /* RM: Dec 11 1992 conjunctions have been totally scrapped it seems */
5866  /* conjunction=update_symbol("*conjunction*"); 19.8 */
5867 
5868  constant =update_symbol(bi_module,"*constant*");
5869  disjunction =update_symbol(bi_module,"disj");/*RM:9 Dec 92*/
5870  lf_false =update_symbol(bi_module,"false");
5871  functor =update_symbol(bi_module,"functor");
5872  iff =update_symbol(bi_module,"cond");
5874  alist =update_symbol(bi_module,"cons");/*RM:9 Dec 92*/
5875  nothing =update_symbol(bi_module,"bottom");
5876  nil =update_symbol(bi_module,"nil");/*RM:9 Dec 92*/
5878  real =update_symbol(bi_module,"real");
5879  stream =update_symbol(bi_module,"stream");
5880  succeed =update_symbol(bi_module,"succeed");
5881  lf_true =update_symbol(bi_module,"true");
5882  timesym =update_symbol(bi_module,"time");
5883  variable =update_symbol(bi_module,"*variable*");
5884  opsym =update_symbol(bi_module,"op");
5885  loadsym =update_symbol(bi_module,"load");
5886  dynamicsym =update_symbol(bi_module,"dynamic");
5887  staticsym =update_symbol(bi_module,"static");
5888  encodesym =update_symbol(bi_module,"encode");
5889  listingsym =update_symbol(bi_module,"c_listing");
5890  /* provesym =update_symbol(bi_module,"prove"); */
5891  delay_checksym =update_symbol(bi_module,"delay_check");
5892  eval_argsym =update_symbol(bi_module,"non_strict");
5893  inputfilesym =update_symbol(bi_module,"input_file");
5894  call_handlersym =update_symbol(bi_module,"call_handler");
5902  nullsym =update_symbol(bi_module,"<NULL PSI TERM>");
5905 
5906 
5907  (void)set_current_module(no_module); /* RM: Feb 3 1993 */
5908  t=update_symbol(no_module,"1");
5909  one=t->keyword->symbol;
5910  t=update_symbol(no_module,"2");
5911  two=t->keyword->symbol;
5912  t=update_symbol(no_module,"3");
5913  three=t->keyword->symbol;
5914  (void)set_current_module(bi_module); /* RM: Feb 3 1993 */
5915  t=update_symbol(bi_module,"year");
5916  year_attr=t->keyword->symbol;
5917  t=update_symbol(bi_module,"month");
5919  t=update_symbol(bi_module,"day");
5920  day_attr=t->keyword->symbol;
5921  t=update_symbol(bi_module,"hour");
5922  hour_attr=t->keyword->symbol;
5923  t=update_symbol(bi_module,"minute");
5925  t=update_symbol(bi_module,"second");
5927  t=update_symbol(bi_module,"weekday");
5929 
5932 
5933  /* Built-in routines */
5934  // bi_list = fopen("bi_list.txt","w");
5935 
5936  /* Program database */
5946 
5947  /* File I/O */
5959 
5960  /* Term I/O */
5972  new_built_in(bi_module,"c_op",(def_type)predicate,c_op); /* RM: Jan 13 1993 */
5976 
5977  /* Type checks */
5983 
5988 
5989  /* RM: Dec 16 1992 So the symbol can be changed easily */
5990 
5991 
5992  /* Arithmetic */
5994 
5995  /* Comparison */
6007 
6008  /* RM: Nov 22 1993 */
6010 
6011  /* Psi-term navigation */
6013  new_built_in(bi_module,"feature_values",(def_type)function_it,c_feature_values); /* RM: Mar 3 1994 */
6014 
6015  /* RM: Jul 20 1993 */
6016 
6017  new_built_in(syntax_module,".",(def_type)function_it,c_project);/* RM: Jul 7 1993 */
6020  new_built_in(bi_module,"copy_pointer",(def_type)function_it,c_copy_pointer); /* PVR: Dec 17 1992 */
6021  new_built_in(bi_module,"has_feature",(def_type)function_it,c_exist_feature); /* PVR: Dec 17 1992 */
6022 
6023  /* Unification and assignment */
6025  /* new_built_in(syntax_module,"<<-",(def_type)predicate,c_assign); RM: Feb 24 1993 */
6026 
6027  /* RM: Feb 24 1993 */
6029  /* new_built_in(syntax_module,"<<<-",(def_type)predicate,c_global_assign); */
6030 
6031  /* RM: Feb 8 1993 */
6032  new_built_in(syntax_module,"{}",(def_type)function_it,c_fail); /* RM: Feb 16 1993 */
6036  /* UNI new_built_in(syntax_module,":",(def_type)function_it,c_unify_func); */
6037 
6038  /* Type hierarchy navigation */
6040 
6041  /* String and character utilities */
6047 
6048  /* Control */
6054  /* new_built_in(bi_module,"quote",(def_type)function_it,c_quote); */
6055  /*new_built_in(bi_module,"call_once",(def_type)function_it,c_call_once);*/ /* DENYS: Jan 25 1995 */
6056  /* new_built_in(bi_module,"call",(def_type)function_it,c_call); */
6057  /* new_built_in(bi_module,"undefined",(def_type)function_it,c_fail); */ /* RM: Jan 13 1993 */
6064 
6067  /* new_built_in(syntax_module,"::",(def_type)predicate,c_declaration); */
6078  /* new_built_in(bi_module,"freeze",(def_type)predicate,c_freeze); PVR 16.9.93 */
6083 
6084  /* System */
6086 
6093 
6094  /* RM: Jan 8 1993 */
6105  /* new_built_in(bi_module,"#",(def_type)function_it,c_module_access); */
6106 
6107  /* Hack so '.set_up' doesn't issue a Warning message */
6108  /* RM: Feb 3 1993 */
6109  hash_lookup(bi_module->symbol_table,"set_module")->public=TRUE;
6111 
6112  /* RM: Jan 29 1993 */
6113  abortsym=update_symbol(bi_module,"abort"); /* 26.1 */
6114  aborthooksym=update_symbol(bi_module,"aborthook"); /* 26.1 */
6115  tracesym=update_symbol(bi_module,"trace"); /* 26.1 */
6116 
6117 
6118  /* RM: Feb 9 1993 */
6123 
6124  /* RM: Mar 11 1993 */
6126  add_module1=update_symbol(bi_module,"features");
6127  add_module2=update_symbol(bi_module,"str2psi");
6128  add_module3=update_symbol(bi_module,"feature_values"); /* RM: Mar 3 1994 */
6129 
6130  /* RM: Jun 29 1993 */
6133 
6134  /* RM: Jul 15 1993 */
6136 
6137 
6138  /* RM: Sep 20 1993 */
6140 
6141  /* RM: Jan 28 1994 */
6143 
6144 #ifdef CLIFE
6145  life_reals();
6146 #endif /* CLIFE */
6147 
6149  // fclose(bi_list);
6150 }
static long c_diff()
Definition: built_ins.c:1257
ptr_definition encodesym
Definition: def_glob.h:116
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
Definition: built_ins.c:5054
static long c_get()
Definition: built_ins.c:2798
static long c_listing()
Definition: built_ins.c:4859
static long c_char()
Definition: built_ins.c:4443
ptr_definition such_that
Definition: def_glob.h:105
ptr_definition boolpredsym
Definition: def_glob.h:74
static long c_is_sort()
Definition: built_ins.c:1498
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
Definition: hash_table.c:133
long c_initrandom()
Definition: built_ins.c:5690
ptr_definition abortsym
Definition: def_glob.h:64
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
ptr_definition timesym
Definition: def_glob.h:108
static long c_exists()
Definition: built_ins.c:1642
static long c_combined_name()
Definition: built_ins.c:5357
static long c_exists_choice()
Definition: built_ins.c:1812
static long c_static()
Definition: built_ins.c:1563
ptr_definition xfy_sym
Definition: def_glob.h:127
ptr_definition staticsym
Definition: def_glob.h:115
static long c_write()
Definition: built_ins.c:2951
static long c_pwriteq()
Definition: built_ins.c:3012
static long c_unify_func()
Definition: built_ins.c:4152
static long c_clause()
Definition: built_ins.c:2366
struct wl_definition * def_type
Definition: def_struct.h:32
static long c_declaration()
Definition: built_ins.c:2172
long c_random()
Definition: built_ins.c:5626
void insert_type_builtins()
Definition: bi_type.c:655
long c_public()
Definition: modules.c:671
static long c_pwrite()
Definition: built_ins.c:2997
ptr_definition loadsym
Definition: def_glob.h:113
static long c_ascii()
Definition: built_ins.c:4497
static long c_retract()
Definition: built_ins.c:2383
long c_display_modules()
Definition: modules.c:723
static long c_features()
Definition: built_ins.c:3312
static long c_delay_check()
Definition: built_ins.c:1580
static long c_fail()
Definition: built_ins.c:1336
ptr_definition dynamicsym
Definition: def_glob.h:114
ptr_definition opsym
Definition: def_glob.h:112
ptr_definition comment
Definition: def_glob.h:80
static long c_exist_feature()
Definition: built_ins.c:3248
static long c_rootsort()
Definition: built_ins.c:3108
ptr_definition stream
Definition: def_glob.h:103
static long c_persistent()
Definition: built_ins.c:2517
long c_deref_length()
Definition: built_ins.c:5743
ptr_definition listingsym
Definition: def_glob.h:117
#define NOT_CODED
Definition: def_const.h:134
char * two
Definition: def_glob.h:251
static long c_project()
Definition: built_ins.c:1157
ptr_definition commasym
Definition: def_glob.h:79
static long c_int2string()
Definition: built_ins.c:4656
ptr_psi_term heap_psi_term(long stat)
Definition: lefun.c:63
static long c_same_address()
Definition: built_ins.c:3598
static long c_xor()
Definition: built_ins.c:1033
ptr_psi_term null_psi_term
Definition: def_glob.h:140
def_type type_def
Definition: def_struct.h:133
static long c_unify_pred()
Definition: built_ins.c:4180
static long c_cond()
Definition: built_ins.c:3172
long c_set_module()
Definition: modules.c:483
long c_append_file()
Definition: built_ins.c:5552
ptr_definition fy_sym
Definition: def_glob.h:125
static long c_string2psi()
Definition: built_ins.c:4547
static long c_read_psi()
Definition: built_ins.c:1995
static long c_lt()
Definition: built_ins.c:613
long c_abort()
Definition: built_ins.c:2117
ptr_definition aborthooksym
Definition: def_glob.h:65
static long c_boolpred()
Definition: built_ins.c:815
static long c_diff_address()
Definition: built_ins.c:3640
static long c_open_out()
Definition: built_ins.c:2634
ptr_definition constant
Definition: def_glob.h:82
static long c_print_codes()
Definition: built_ins.c:4970
long c_args()
Definition: built_ins.c:5777
ptr_hash_table symbol_table
Definition: def_struct.h:79
ptr_keyword keyword
Definition: def_struct.h:124
ptr_definition top
Definition: def_glob.h:106
static long c_string_address()
Definition: built_ins.c:3833
ptr_definition quote
Definition: def_glob.h:100
static long c_op()
Definition: built_ins.c:1612
static long c_ltoe()
Definition: built_ins.c:746
long c_open_module()
Definition: modules.c:514
char * three
Definition: def_glob.h:252
char * symbol
Definition: def_struct.h:91
ptr_definition apply
Definition: def_glob.h:72
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
static long c_parse()
Definition: built_ins.c:1905
void insert_system_builtins()
Definition: bi_sys.c:626
static long c_page_width()
Definition: built_ins.c:3028
static long c_gtoe()
Definition: built_ins.c:680
ptr_definition minus_symbol
Definition: def_glob.h:96
static long c_psi2string()
Definition: built_ins.c:4613
ptr_definition xfx_sym
Definition: def_glob.h:126
static long c_repeat()
Definition: built_ins.c:1360
#define type_it
Definition: def_const.h:363
long c_display_persistent()
Definition: modules.c:759
ptr_definition add_module3
Definition: def_glob.h:69
static long c_global_assign()
Definition: built_ins.c:4112
static long c_split_double()
Definition: built_ins.c:3769
ptr_definition yf_sym
Definition: def_glob.h:124
ptr_definition disj_nil
Definition: def_glob.h:85
static long c_write_err()
Definition: built_ins.c:2920
static long c_apply()
Definition: built_ins.c:1112
ptr_definition nullsym
Definition: def_glob.h:129
ptr_definition real
Definition: def_glob.h:102
static long c_writeq_err()
Definition: built_ins.c:2936
static long c_global()
Definition: built_ins.c:2404
static long c_get_choice()
Definition: built_ins.c:1720
ptr_definition alist
Definition: def_glob.h:94
ptr_definition functor
Definition: def_glob.h:91
ptr_definition eqsym
Definition: def_glob.h:87
void insert_sys_builtins()
Definition: sys.c:1760
static long c_writeq()
Definition: built_ins.c:2967
ptr_definition eof
Definition: def_glob.h:86
long c_sub_string()
Definition: built_ins.c:5444
#define TRUE
Definition: def_const.h:127
long all_public_symbols()
Definition: modules.c:1349
static long c_open_in()
Definition: built_ins.c:2590
static long c_dynamic()
Definition: built_ins.c:1548
ptr_psi_term error_psi_term
Definition: def_glob.h:23
long c_string_length()
Definition: built_ins.c:5389
ptr_definition built_in
Definition: def_glob.h:75
ptr_definition integer
Definition: def_glob.h:93
ptr_definition lf_true
Definition: def_glob.h:107
ptr_definition iff
Definition: def_glob.h:92
ptr_definition final_dot
Definition: def_glob.h:137
static long c_non_strict()
Definition: built_ins.c:1597
static long c_copy_term()
Definition: built_ins.c:4237
static long c_undo()
Definition: built_ins.c:4274
static long c_eval()
Definition: built_ins.c:3683
static long c_nonvar()
Definition: built_ins.c:1405
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_definition succeed
Definition: def_glob.h:104
long c_halt()
Definition: built_ins.c:2084
static long c_disj()
Definition: built_ins.c:3143
static long c_eval_disjunction()
Definition: built_ins.c:569
ptr_definition and
Definition: def_glob.h:71
ptr_definition lf_false
Definition: def_glob.h:89
long c_current_module()
Definition: modules.c:956
ptr_definition leftarrowsym
Definition: def_glob.h:88
ptr_module syntax_module
Definition: def_glob.h:159
ptr_definition calloncesym
Definition: def_glob.h:76
static long c_succeed()
Definition: built_ins.c:1346
static long c_and()
Definition: built_ins.c:963
static long c_implies()
Definition: built_ins.c:4432
char * weekday_attr
Definition: def_glob.h:259
ptr_definition disjunction
Definition: def_glob.h:84
static long c_strip()
Definition: built_ins.c:3570
char * one
Definition: def_glob.h:250
static long c_put_err()
Definition: built_ins.c:2858
long c_private_feature()
Definition: modules.c:1288
static long c_or()
Definition: built_ins.c:968
static long c_assert_last()
Definition: built_ins.c:2270
ptr_definition add_module2
Definition: def_glob.h:68
ptr_definition life_or
Definition: def_glob.h:95
static long c_close()
Definition: built_ins.c:2743
static long c_read_token()
Definition: built_ins.c:1997
static long c_not()
Definition: built_ins.c:980
ptr_definition delay_checksym
Definition: def_glob.h:118
long c_trace_input()
Definition: modules.c:795
ptr_definition yfx_sym
Definition: def_glob.h:128
ptr_definition final_question
Definition: def_glob.h:138
static long c_is_predicate()
Definition: built_ins.c:1467
static long c_var()
Definition: built_ins.c:1374
long c_alias()
Definition: modules.c:1164
long c_concatenate()
Definition: built_ins.c:5245
static long c_is_function()
Definition: built_ins.c:1436
ptr_definition add_module1
Definition: def_glob.h:67
ptr_definition tracesym
Definition: def_glob.h:109
void insert_math_builtins()
Definition: bi_math.c:1318
static long c_put()
Definition: built_ins.c:2853
static long c_eval_inplace()
Definition: built_ins.c:3714
ptr_definition fx_sym
Definition: def_glob.h:123
long c_private()
Definition: modules.c:697
char * minute_attr
Definition: def_glob.h:257
ptr_definition cut
Definition: def_glob.h:83
static long c_not_implemented()
Definition: built_ins.c:2157
long c_replace()
Definition: modules.c:917
static long c_chdir()
Definition: built_ins.c:3886
ptr_definition nil
Definition: def_glob.h:97
ptr_definition nothing
Definition: def_glob.h:98
char * year_attr
Definition: def_glob.h:253
ptr_module no_module
Definition: def_glob.h:157
static long c_bk_assign()
Definition: built_ins.c:4020
ptr_int_list code
Definition: def_struct.h:129
char * second_attr
Definition: def_glob.h:258
char * day_attr
Definition: def_glob.h:255
ptr_module bi_module
Definition: def_glob.h:155
ptr_definition predsym
Definition: def_glob.h:99
static long c_ops()
Definition: built_ins.c:3531
int public
Definition: def_struct.h:94
static long c_set_input()
Definition: built_ins.c:2681
static long c_equal()
Definition: built_ins.c:488
ptr_definition type
Definition: def_struct.h:165
char * hour_attr
Definition: def_glob.h:256
static long c_setq()
Definition: built_ins.c:2194
static long c_module_name()
Definition: built_ins.c:5326
ptr_definition xf_sym
Definition: def_glob.h:122
static long c_write_canonical()
Definition: built_ins.c:2983
static long c_gt()
Definition: built_ins.c:422
static long c_load()
Definition: built_ins.c:1682
ptr_definition colonsym
Definition: def_glob.h:78
ptr_definition inputfilesym
Definition: def_glob.h:120
ptr_definition variable
Definition: def_glob.h:111
static long c_print_depth()
Definition: built_ins.c:3066
static long c_copy_pointer()
Definition: built_ins.c:4207
static long c_feature_values()
Definition: built_ins.c:3368
ptr_module set_current_module(ptr_module module)
Definition: modules.c:95
static long c_assert_first()
Definition: built_ins.c:2242
static long c_print_variables()
Definition: built_ins.c:1867
static long c_set_choice()
Definition: built_ins.c:1757
ptr_definition call_handlersym
Definition: def_glob.h:121
static long c_set_output()
Definition: built_ins.c:2716
ptr_definition eval_argsym
Definition: def_glob.h:119
ptr_definition funcsym
Definition: def_glob.h:90
char * month_attr
Definition: def_glob.h:254
static long c_such_that()
Definition: built_ins.c:4722
ptr_definition typesym
Definition: def_glob.h:110
long is_built_in ( ptr_pair_list  r)

Definition at line 4811 of file built_ins.c.

References MAX_BUILT_INS.

4813 {
4814  return ((unsigned long)r>0 && (unsigned long)r<MAX_BUILT_INS);
4815 }
#define MAX_BUILT_INS
Definition: def_const.h:82
void list_special ( ptr_psi_term  t)

Definition at line 4820 of file built_ins.c.

References wl_definition::always_check, display_psi_stream(), wl_definition::evaluate_args, FALSE, is_built_in(), output_stream, wl_definition::protected, TRUE, and type_it.

4822 {
4823  ptr_definition d = t->type;
4824  ptr_pair_list r = t->type->rule;
4825  long prflag=FALSE;
4826 
4827  if (t->type->type_def==(def_type)type_it) {
4828  if (!d->always_check) {
4829  if (is_built_in(r)) fprintf(output_stream,"%% ");
4830  fprintf(output_stream,"delay_check(");
4831  display_psi_stream(t);
4832  fprintf(output_stream,")?\n");
4833  prflag=TRUE;
4834  }
4835  } else {
4836  if (!d->protected) {
4837  if (is_built_in(r)) fprintf(output_stream,"%% ");
4838  fprintf(output_stream,"%s(",(d->protected?"static":"dynamic"));
4839  display_psi_stream(t);
4840  fprintf(output_stream,")?\n");
4841  prflag=TRUE;
4842  }
4843  }
4844  if (!d->evaluate_args) {
4845  if (is_built_in(r)) fprintf(output_stream,"%% ");
4846  fprintf(output_stream,"non_strict(");
4847  display_psi_stream(t);
4848  fprintf(output_stream,")?\n");
4849  prflag=TRUE;
4850  }
4851  /* if (prflag) fprintf(output_stream,"\n"); */
4852 }
char evaluate_args
Definition: def_struct.h:136
void display_psi_stream(ptr_psi_term t)
Definition: print.c:1449
def_type type_def
Definition: def_struct.h:133
char always_check
Definition: def_struct.h:134
#define type_it
Definition: def_const.h:363
#define TRUE
Definition: def_const.h:127
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
long is_built_in(ptr_pair_list r)
Definition: built_ins.c:4811
FILE * output_stream
Definition: def_glob.h:41
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term make_feature_list ( ptr_node  tree,
ptr_psi_term  tail,
ptr_module  module,
int  val 
)

Definition at line 156 of file built_ins.c.

References heap_alloc(), integer, make_feature_list(), REAL, real, stack_cons(), stack_psi_term(), str_to_int(), and update_feature().

163 {
164  ptr_psi_term new;
165  ptr_definition def;
166  double d; // strtod();
167 
168 
169  if(tree) {
170  if(tree->right)
171  tail=make_feature_list(tree->right,tail,module,val);
172 
173  /* Insert the feature name into the list */
174 
175  d=str_to_int(tree->key);
176  if (d== -1) { /* Feature is not a number */
177  def=update_feature(module,tree->key); /* Extract module RM: Feb 3 1993 */
178  if(def) {
179  if(val) /* RM: Mar 3 1994 Distinguish between features & values */
180  tail=stack_cons((ptr_psi_term)tree->data,(ptr_psi_term)tail);
181  else {
182  new=stack_psi_term(4);
183  new->type=def;
184  tail=stack_cons((ptr_psi_term)new,(ptr_psi_term)tail);
185  }
186  }
187  }
188  else { /* Feature is a number */
189  if(val) /* RM: Mar 3 1994 Distinguish between features & values */
190  tail=stack_cons((ptr_psi_term)tree->data,(ptr_psi_term)tail);
191  else {
192  new=stack_psi_term(4);
193  new->type=(d==floor(d))?integer:real;
194  new->value_3=heap_alloc(sizeof(REAL));
195  *(REAL *)new->value_3=(REAL)d;
196  tail=stack_cons((ptr_psi_term)new,(ptr_psi_term)tail);
197  }
198  }
199 
200  if(tree->left)
201  tail=make_feature_list(tree->left,tail,module,val);
202  }
203 
204  return tail;
205 }
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
Definition: built_ins.c:47
GENERIC data
Definition: def_struct.h:185
#define REAL
Definition: def_const.h:72
ptr_node left
Definition: def_struct.h:183
ptr_definition real
Definition: def_glob.h:102
char * key
Definition: def_struct.h:182
ptr_definition integer
Definition: def_glob.h:93
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
long str_to_int(char *s)
Definition: print.c:103
ptr_psi_term make_feature_list(ptr_node tree, ptr_psi_term tail, ptr_module module, int val)
Definition: built_ins.c:156
ptr_definition update_feature(ptr_module module, char *feature)
Definition: modules.c:1315
GENERIC heap_alloc(long s)
Definition: memory.c:1518
ptr_node right
Definition: def_struct.h:184
void new_built_in ( ptr_module  m,
char *  s,
def_type  t,
long (*)()  r 
)

Definition at line 5054 of file built_ins.c.

References built_in_index, c_rule, current_module, MAX_BUILT_INS, wl_definition::rule, set_current_module(), wl_definition::type_def, and update_symbol().

5059 {
5060  ptr_definition d;
5061  if (built_in_index >= MAX_BUILT_INS) {
5062  fprintf(stderr,"Too many primitives, increase MAX_BUILT_INS in extern.h\n");
5063  exit(EXIT_FAILURE);
5064  }
5065 
5066  if(m!=current_module) /* RM: Jan 13 1993 */
5067  (void)set_current_module(m);
5068 
5069  d=update_symbol(m,s); /* RM: Jan 8 1993 */
5070  d->type_def=t;
5071  built_in_index++;
5074 }
static long built_in_index
Definition: built_ins.c:13
ptr_module current_module
Definition: def_glob.h:161
long(* c_rule[MAX_BUILT_INS])()
Definition: def_glob.h:247
def_type type_def
Definition: def_struct.h:133
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
ptr_pair_list rule
Definition: def_struct.h:126
struct wl_pair_list * ptr_pair_list
Definition: def_struct.h:36
#define MAX_BUILT_INS
Definition: def_const.h:82
ptr_module set_current_module(ptr_module module)
Definition: modules.c:95
ptr_psi_term new_psi_term ( long  numargs,
ptr_definition  typ,
ptr_psi_term **  a1,
ptr_psi_term **  a2 
)

Definition at line 4764 of file built_ins.c.

References wl_psi_term::attr_list, wl_node::data, wl_node::key, wl_node::left, NULL, one, wl_node::right, STACK_ALLOC, stack_psi_term(), two, and wl_psi_term::type.

4768 {
4769  ptr_psi_term t;
4770  ptr_node n1, n2;
4771 
4772  if (numargs==2) {
4773  n2 = STACK_ALLOC(node);
4774  n2->key = two;
4775  *a2 = (ptr_psi_term *) &(n2->data);
4776  n2->left = NULL;
4777  n2->right = NULL;
4778  }
4779  else
4780  n2=NULL;
4781 
4782  n1 = STACK_ALLOC(node);
4783  n1->key = one;
4784  *a1 = (ptr_psi_term *) &(n1->data);
4785  n1->left = NULL;
4786  n1->right = n2;
4787 
4788  t=stack_psi_term(4);
4789  t->type = typ;
4790  t->attr_list = n1;
4791 
4792  return t;
4793 }
char * two
Definition: def_glob.h:251
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
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
char * one
Definition: def_glob.h:250
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
ptr_node right
Definition: def_struct.h:184
ptr_node one_attr ( )

Definition at line 4749 of file built_ins.c.

References wl_node::data, wl_node::key, wl_node::left, NULL, one, wl_node::right, and STACK_ALLOC.

4750 {
4751  ptr_node n;
4752 
4753  n = STACK_ALLOC(node);
4754  n->key = one;
4755  n->data = NULL; /* To be filled in later */
4756  n->left = NULL;
4757  n->right = NULL;
4758 
4759  return n;
4760 }
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
char * one
Definition: def_glob.h:250
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_node right
Definition: def_struct.h:184
long only_arg1 ( ptr_psi_term  t,
ptr_psi_term arg1 
)

Definition at line 1528 of file built_ins.c.

References wl_node::data, FALSE, featcmp(), wl_node::key, wl_node::left, NULL, one, wl_node::right, and TRUE.

1531 {
1532  ptr_node n=t->attr_list;
1533 
1534  if (n && n->left==NULL && n->right==NULL && !featcmp(n->key,one)) {
1535  *arg1=(ptr_psi_term)n->data;
1536  return TRUE;
1537  }
1538  else
1539  return FALSE;
1540 }
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 FALSE
Definition: def_const.h:128
char * one
Definition: def_glob.h:250
long featcmp(char *str1, char *str2)
Definition: trees.c:89
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_node attr_list
Definition: def_struct.h:171
ptr_node right
Definition: def_struct.h:184
static void op_declare ( long  p,
operator  t,
char *  s 
)
static

Definition at line 5082 of file built_ins.c.

References Errorline(), heap_alloc(), MAX_PRECEDENCE, wl_operator_data::next, NULL, wl_definition::op_data, wl_operator_data::precedence, and update_symbol().

5086 {
5087  ptr_definition d;
5088  ptr_operator_data od;
5089 
5090  if (p>MAX_PRECEDENCE || p<0) {
5091  Errorline("operator precedence must be in the range 0..%d.\n",
5092  MAX_PRECEDENCE);
5093  return;
5094  }
5095  d=update_symbol(NULL,s);
5096 
5097  od= (ptr_operator_data) heap_alloc (sizeof(operator_data));
5098  /* od= (ptr_operator_data) malloc (sizeof(operator_data)); 12.6 */
5099 
5100  od->precedence=p;
5101  od->type=t;
5102  od->next=d->op_data;
5103  d->op_data=od;
5104 }
ptr_operator_data next
Definition: def_struct.h:49
#define NULL
Definition: def_const.h:203
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
void Errorline(char *format,...)
Definition: error.c:414
struct wl_operator_data * ptr_operator_data
Definition: def_struct.h:28
#define MAX_PRECEDENCE
Definition: def_const.h:103
ptr_operator_data op_data
Definition: def_struct.h:139
GENERIC heap_alloc(long s)
Definition: memory.c:1518
void persistent_error_check ( ptr_node  n,
int *  error 
)

Definition at line 2538 of file built_ins.c.

References deref_ptr, error_psi_term, Errorline(), global, persistent_error_check(), TRUE, wl_psi_term::type, wl_definition::type_def, and undef.

2541 {
2542  if (n) {
2543  ptr_psi_term t;
2544  persistent_error_check(n->left, error);
2545 
2546  t=(ptr_psi_term)n->data;
2547  deref_ptr(t);
2548  if (t->type->type_def!=(def_type)undef && t->type->type_def!=(def_type)global) {
2549  Errorline("%T %P cannot be redeclared persistent (%E).\n",
2550  t->type->type_def,
2551  t);
2552  t->type=error_psi_term->type;
2553  *error=TRUE;
2554  }
2555 
2556  persistent_error_check(n->right, error);
2557  }
2558 }
struct wl_definition * def_type
Definition: def_struct.h:32
#define global
Definition: def_const.h:364
#define undef
Definition: def_const.h:360
void persistent_error_check(ptr_node n, int *error)
Definition: built_ins.c:2538
def_type type_def
Definition: def_struct.h:133
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_psi_term error_psi_term
Definition: def_glob.h:23
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_node right
Definition: def_struct.h:184
void persistent_one ( ptr_psi_term  t)

Definition at line 2577 of file built_ins.c.

References global, heap_pointer, heap_psi_term(), wl_psi_term::type, and wl_definition::type_def.

2579 {
2583 }
struct wl_definition * def_type
Definition: def_struct.h:32
#define global
Definition: def_const.h:364
ptr_psi_term heap_psi_term(long stat)
Definition: lefun.c:63
def_type type_def
Definition: def_struct.h:133
ptr_psi_term global_value
Definition: def_struct.h:141
GENERIC heap_pointer
Definition: def_glob.h:12
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
void persistent_tree ( ptr_node  n)

Definition at line 2561 of file built_ins.c.

References deref_ptr, persistent_one(), and persistent_tree().

2563 {
2564  if (n) {
2565  ptr_psi_term t;
2566  persistent_tree(n->left);
2567 
2568  t=(ptr_psi_term)n->data;
2569  deref_ptr(t);
2570  persistent_one(t);
2571 
2572  persistent_tree(n->right);
2573  }
2574 }
void persistent_tree(ptr_node n)
Definition: built_ins.c:2561
void persistent_one(ptr_psi_term t)
Definition: built_ins.c:2577
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
ptr_node right
Definition: def_struct.h:184
long pred_clause ( ptr_psi_term  t,
long  r,
ptr_psi_term  g 
)

Definition at line 2300 of file built_ins.c.

References bk_mark_quote(), clause, del_clause, deref_ptr, Errorline(), FALSE, function_it, get_two_args(), predicate, push_goal(), redefine(), wl_definition::rule, stack_psi_term(), succeed, TRUE, wl_psi_term::type, wl_definition::type_def, and undef.

2303 {
2304  long success=FALSE;
2305  ptr_psi_term head,body;
2306 
2307  bk_mark_quote(g); /* RM: Apr 7 1993 */
2308  if (t) {
2309  deref_ptr(t);
2310 
2311  if (!strcmp(t->type->keyword->symbol,"->")) {
2312  get_two_args(t->attr_list,&head,&body);
2313  if (head) {
2314  deref_ptr(head);
2315  if (head && body &&
2316  (head->type->type_def==(def_type)function_it || head->type->type_def==(def_type)undef))
2317  success=TRUE;
2318  }
2319  }
2320  else if (!strcmp(t->type->keyword->symbol,":-")) {
2321  get_two_args(t->attr_list,&head,&body);
2322  if (head) {
2323  deref_ptr(head);
2324  if (head &&
2325  (head->type->type_def==(def_type)predicate || head->type->type_def==(def_type)undef)) {
2326  success=TRUE;
2327  if (!body) {
2328  body=stack_psi_term(4);
2329  body->type=succeed;
2330  }
2331  }
2332  }
2333  }
2334  /* There is no body, so t is a fact */
2335  else if (t->type->type_def==(def_type)predicate || t->type->type_def==(def_type)undef) {
2336  head=t;
2337  body=stack_psi_term(4);
2338  body->type=succeed;
2339  success=TRUE;
2340  }
2341  }
2342 
2343  if (success) {
2344  if (r) {
2345  if (redefine(head))
2346  push_goal(del_clause,head,body,(GENERIC)&(head->type->rule));
2347  else
2348  success=FALSE;
2349  }
2350  else
2351  push_goal(clause,head,body,(GENERIC)&(head->type->rule));
2352  }
2353  else
2354  Errorline("bad argument in %s.\n", (r?"retract":"clause"));
2355 
2356  return success;
2357 }
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define undef
Definition: def_const.h:360
long redefine(ptr_psi_term t)
Definition: types.c:91
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
char * symbol
Definition: def_struct.h:91
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
void bk_mark_quote(ptr_psi_term t)
Definition: copy.c:630
#define TRUE
Definition: def_const.h:127
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
ptr_definition succeed
Definition: def_glob.h:104
#define clause
Definition: def_const.h:285
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
#define del_clause
Definition: def_const.h:286
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 psi_to_string ( ptr_psi_term  t,
char **  fn 
)

Definition at line 133 of file built_ins.c.

References equal_types, wl_definition::keyword, quoted_string, wl_keyword::symbol, TRUE, and wl_psi_term::value_3.

136 {
137  if (equal_types(t->type,quoted_string)) {
138  if (t->value_3) {
139  *fn = (char *) t->value_3;
140  return TRUE;
141  }
142  else {
143  *fn = quoted_string->keyword->symbol;
144  return TRUE;
145  }
146  }
147  else {
148  *fn = t->type->keyword->symbol;
149  return TRUE;
150  }
151 }
ptr_keyword keyword
Definition: def_struct.h:124
char * symbol
Definition: def_struct.h:91
#define TRUE
Definition: def_const.h:127
ptr_definition quoted_string
Definition: def_glob.h:101
GENERIC value_3
Definition: def_struct.h:170
#define equal_types(A, B)
Definition: def_macro.h:106
ptr_definition type
Definition: def_struct.h:165
static void set_parse_queryflag ( ptr_node  thelist,
long  sort 
)
static

Definition at line 1877 of file built_ins.c.

References bi_module, wl_node::data, FACT, FEATCMP, find(), NULL, push_goal(), QUERY, stack_psi_term(), two, wl_psi_term::type, unify, and update_symbol().

1880 {
1881  ptr_node n; /* node pointing to argument 2 */
1882  ptr_psi_term arg; /* argumenrt 2 psi-term */
1883  ptr_psi_term queryflag; /* query term created by this function */
1884 
1885  n=find(FEATCMP,two,thelist);
1886  if (n) {
1887  /* there was a second argument */
1888  arg=(ptr_psi_term)n->data;
1889  queryflag=stack_psi_term(4);
1890  queryflag->type =
1892  ((sort==QUERY)?"query":
1893  ((sort==FACT)?"declaration":"error")));
1894  push_goal(unify,queryflag,arg,NULL);
1895  }
1896 }
#define FEATCMP
Definition: def_const.h:257
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
char * two
Definition: def_glob.h:251
#define FACT
Definition: def_const.h:151
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
#define QUERY
Definition: def_const.h:152
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
#define unify
Definition: def_const.h:274
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_module bi_module
Definition: def_glob.h:155
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term stack_bytes ( char *  s,
int  n 
)

Definition at line 117 of file built_ins.c.

References heap_ncopy_string(), quoted_string, stack_psi_term(), wl_psi_term::type, and wl_psi_term::value_3.

120 {
122  t->type = quoted_string;
124  return t;
125 }
char * heap_ncopy_string(char *s, int n)
Definition: trees.c:128
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_psi_term stack_cons ( ptr_psi_term  head,
ptr_psi_term  tail 
)

Definition at line 47 of file built_ins.c.

References alist, wl_psi_term::attr_list, cons(), FEATCMP, one, stack_insert(), stack_psi_term(), two, and wl_psi_term::type.

50 {
52 
53  cons=stack_psi_term(4);
54  cons->type=alist;
55  if(head)
56  (void)stack_insert(FEATCMP,one,&(cons->attr_list),(GENERIC)head);
57  if(tail)
58  (void)stack_insert(FEATCMP,two,&(cons->attr_list),(GENERIC)tail);
59 
60  return cons;
61 }
#define FEATCMP
Definition: def_const.h:257
char * two
Definition: def_glob.h:251
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
ptr_definition alist
Definition: def_glob.h:94
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
char * one
Definition: def_glob.h:250
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
ptr_psi_term stack_int ( long  n)

Definition at line 87 of file built_ins.c.

References heap_alloc(), integer, REAL, stack_psi_term(), wl_psi_term::type, and wl_psi_term::value_3.

89 {
90  ptr_psi_term m;
91  m=stack_psi_term(4);
92  m->type=integer;
93  m->value_3= heap_alloc(sizeof(REAL));
94  *(REAL *)m->value_3=(REAL)n;
95  return m;
96 }
#define REAL
Definition: def_const.h:72
ptr_definition integer
Definition: def_glob.h:93
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
GENERIC heap_alloc(long s)
Definition: memory.c:1518
ptr_psi_term stack_nil ( )

Definition at line 29 of file built_ins.c.

References nil, stack_psi_term(), and wl_psi_term::type.

31 {
32  ptr_psi_term empty;
33 
34 
35  empty=stack_psi_term(4);
36  empty->type=nil;
37 
38  return empty;
39 }
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition nil
Definition: def_glob.h:97
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term stack_pair ( ptr_psi_term  left,
ptr_psi_term  right 
)

Definition at line 67 of file built_ins.c.

References and, wl_psi_term::attr_list, FEATCMP, one, stack_insert(), stack_psi_term(), two, and wl_psi_term::type.

70 {
71  ptr_psi_term pair;
72 
73  pair=stack_psi_term(4);
74  pair->type=and;
75  if(left)
76  (void)stack_insert(FEATCMP,one,&(pair->attr_list),(GENERIC)left);
77  if(right)
78  (void)stack_insert(FEATCMP,two,&(pair->attr_list),(GENERIC)right);
79 
80  return pair;
81 }
#define FEATCMP
Definition: def_const.h:257
char * two
Definition: def_glob.h:251
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition and
Definition: def_glob.h:71
char * one
Definition: def_glob.h:250
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
ptr_psi_term stack_string ( char *  s)

Definition at line 102 of file built_ins.c.

References heap_copy_string(), quoted_string, stack_psi_term(), wl_psi_term::type, and wl_psi_term::value_3.

104 {
106  t->type = quoted_string;
108  return t;
109 }
char * heap_copy_string(char *s)
Definition: trees.c:147
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
char* str_conc ( char *  s1,
char *  s2 
)

Definition at line 5171 of file built_ins.c.

References heap_alloc().

5173 {
5174  char *result;
5175 
5176  result=(char *)heap_alloc(strlen(s1)+strlen(s2)+1);
5177  sprintf(result,"%s%s",s1,s2);
5178 
5179  return result;
5180 }
GENERIC heap_alloc(long s)
Definition: memory.c:1518
char* sub_str ( char *  s,
long  p,
long  n 
)

Definition at line 5184 of file built_ins.c.

References heap_alloc().

5188 {
5189  char *result;
5190  long i;
5191  long l;
5192 
5193  l=strlen(s);
5194  if(p>l || p<0 || n<0)
5195  n=0;
5196  else
5197  if(p+n-1>l)
5198  n=l-p+1;
5199 
5200  result=(char *)heap_alloc(n+1);
5201  for(i=0;i<n;i++)
5202  *(result+i)= *(s+p+i-1);
5203 
5204  *(result+n)=0;
5205 
5206  return result;
5207 }
GENERIC heap_alloc(long s)
Definition: memory.c:1518
static void unify_bool ( ptr_psi_term  arg)
static

Definition at line 878 of file built_ins.c.

References boolean, NULL, push_goal(), stack_psi_term(), wl_psi_term::type, and unify.

880 {
881  ptr_psi_term tmp;
882 
883  tmp=stack_psi_term(4);
884  tmp->type=boolean;
885  push_goal(unify,tmp,arg,(GENERIC)NULL);
886 }
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_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
#define unify
Definition: def_const.h:274
ptr_definition type
Definition: def_struct.h:165
ptr_definition boolean
Definition: def_glob.h:73
unsigned long * GENERIC
Definition: def_struct.h:17
void unify_bool_result ( ptr_psi_term  t,
long  v 
)

Definition at line 329 of file built_ins.c.

References lf_false, lf_true, NULL, push_goal(), stack_psi_term(), wl_psi_term::type, and unify.

332 {
333  ptr_psi_term u;
334 
335  u=stack_psi_term(4);
336  u->type=v?lf_true:lf_false;
337  push_goal(unify,t,u,NULL);
338 
339  /* Completely commented out by Richard on Nov 25th 1993
340  What's *your* Birthday? Maybe you'd like a Birthday-Bug-Card!
341  tried restoring 2.07 DJD no effect on test suite - removed again 2.14 DJD
342 
343  if((GENERIC)t<heap_pointer) {
344  push_ptr_value(def_ptr,&(t->type));
345  if (v) {
346  t->type=lf_true;
347  t->status=0;
348  }
349  else {
350  t->type=lf_false;
351  t->status=0;
352  }
353 
354  i_check_out(t);
355  if (t->resid)
356  release_resid(t);
357  }
358  else {
359  warningline("the persistent term '%P' appears in a boolean constraint and cannot be refined\n",t);
360  }
361  / */
362 }
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_definition lf_true
Definition: def_glob.h:107
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
#define unify
Definition: def_const.h:274
ptr_definition type
Definition: def_struct.h:165
long unify_real_result ( ptr_psi_term  t,
REAL  v 
)

Definition at line 371 of file built_ins.c.

References assert, def_ptr, deref_ptr, FALSE, heap_alloc(), heap_pointer, i_check_out(), int_ptr, integer, matches(), NULL, push_ptr_value(), REAL, release_resid(), TRUE, and warningline().

374 {
375  long smaller;
376  long success=TRUE;
377 
378 #ifdef prlDEBUG
379  if (t->value_3) {
380  printf("*** BUG: value already present in UNIFY_REAL_RESULT\n");
381  }
382 #endif
383 
384  if((GENERIC)t<heap_pointer) { /* RM: Jun 8 1993 */
385  deref_ptr(t);
386  assert(t->value_3==NULL); /* 10.6 */
388  t->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
389  *(REAL *)t->value_3 = v;
390 
391  (void)matches(t->type,integer,&smaller);
392 
393  if (v==floor(v)){
394  if (!smaller) {
396  t->type=integer;
397  t->status=0;
398  }
399  }
400  else
401  if (smaller)
402  success=FALSE;
403 
404  if (success) {
405  (void)i_check_out(t);
406  if (t->resid)
407  release_resid(t);
408  }
409  }
410  else {
411  warningline("the persistent term '%P' appears in an arithmetic constraint and cannot be refined\n",t);
412  }
413 
414  return success;
415 }
ptr_residuation resid
Definition: def_struct.h:173
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
#define def_ptr
Definition: def_const.h:173
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
void release_resid(ptr_psi_term t)
Definition: lefun.c:414
#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
GENERIC value_3
Definition: def_struct.h:170
GENERIC heap_pointer
Definition: def_glob.h:12
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
GENERIC heap_alloc(long s)
Definition: memory.c:1518
#define assert(N)
Definition: memory.c:104
#define int_ptr
Definition: def_const.h:172

Variable Documentation

long built_in_index =0
static

Definition at line 13 of file built_ins.c.