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

Built in functions. More...

Go to the source code of this file.

Functions

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

Variables

static long built_in_index =0
 

Detailed Description

Built in functions.

Definition in file built_ins.c.

Function Documentation

long abort_life ( int  nlflag)

abort_life

Parameters
intnlflag

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

2261 {
2263  !aborthooksym->rule->bbbb_2 ||
2265  /* Do a true abort if aborthook is not a function or is equal to 'abort'.*/
2266  main_loop_ok = FALSE;
2267  undo(NULL); /* 8.10 */
2268  if(NOTQUIET) fprintf(stderr,"\n*** Abort"); /* RM: Feb 17 1993 */
2269  if(NOTQUIET && nlflag) fprintf(stderr,"\n");/* RM: Feb 17 1993 */
2270  } else {
2271  /* Do a 'user-defined abort': initialize the system, then */
2272  /* prove the user-defined abort routine (which is set by */
2273  /* means of 'setq(aborthook,user_defined_abort)'. */
2274  ptr_psi_term aborthook;
2275 
2276  undo(NULL);
2277  init_system();
2279  stdin_cleareof();
2280  if(NOTQUIET) fprintf(stderr,"\n*** Abort"); /* RM: Feb 17 1993 */
2281  if(NOTQUIET && nlflag) fprintf(stderr,"\n");/* RM: Feb 17 1993 */
2282  aborthook=stack_psi_term(0);
2283  aborthook->type=aborthooksym;
2285  }
2286  fprintf(stderr,"\n*** END Abort");
2287  return TRUE;
2288 }
#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)
undo
Definition: login.c:691
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)
push_goal
Definition: login.c:600
void init_system()
init_system
Definition: lib.c:94
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)
stack_psi_term
Definition: lefun.c:21
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)
get_two_args
Definition: login.c:47
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
stack_cons
Definition: built_ins.c:46
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
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)
stack_psi_term
Definition: lefun.c:21
ptr_psi_term stack_nil()
stack_nil
Definition: built_ins.c:26
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 
)

append_files

Parameters
char*s1
char*s2

Definition at line 5539 of file built_ins.c.

References Errorline(), FALSE, and TRUE.

5540 {
5541  FILE *f1;
5542  FILE *f2;
5543  long result=FALSE;
5544 
5545  f1=fopen(s1,"a");
5546  if(f1) {
5547  f2=fopen(s2,"r");
5548  if(f2) {
5549  while(!feof(f2))
5550  (void)fputc(fgetc(f2),f1);
5551  (void)fclose(f2);
5552  (void)fclose(f1);
5553  result=TRUE;
5554  }
5555  else
5556  Errorline("couldn't open \"%s\"\n",f2);
5557  /* printf("*** Error: couldn't open \"%s\"\n",f2); PVR 14.9.93 */
5558  }
5559  else
5560  Errorline("couldn't open \"%s\"\n",f1);
5561  /* printf("*** Error: couldn't open \"%s\"\n",f1); PVR 14.9.93 */
5562 
5563  return result;
5564 }
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 ( )

c_abort

C_ABORT Return to the top level of the interpreter.

Definition at line 2248 of file built_ins.c.

References abort_life(), and TRUE.

2249 {
2250  return (abort_life(TRUE));
2251 }
long abort_life(int nlflag)
abort_life
Definition: built_ins.c:2260
#define TRUE
Definition: def_const.h:127
static long c_and ( )
static

c_and

C_AND Logical and & or. These functions do all possible local propagations.

Definition at line 1001 of file built_ins.c.

References c_logical_main(), and TRUE.

1002 {
1003  return c_logical_main(TRUE);
1004 }
#define TRUE
Definition: def_const.h:127
static long c_logical_main(long sel)
c_logical_main
Definition: built_ins.c:929
long c_append_file ( )

c_append_file

C_APPEND_FILE Append the file named by argument 2 to the file named by argument 1. This predicate will not residuate; it requires string arguments.

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

5887 {
5888  ptr_psi_term g;
5889  ptr_node n1,n2;
5890  long success=TRUE;
5891  ptr_psi_term arg1;
5892  char * c_arg1;
5893  ptr_psi_term arg2;
5894  char * c_arg2;
5895 
5896  g=aim->aaaa_1;
5897  deref_ptr(g);
5898 
5899  /* Evaluate all arguments first: */
5900  n1=find(FEATCMP,one,g->attr_list);
5901  if (n1) {
5902  arg1= (ptr_psi_term )n1->data;
5903  deref(arg1);
5904  }
5905  n2=find(FEATCMP,two,g->attr_list);
5906  if (n2) {
5907  arg2= (ptr_psi_term )n2->data;
5908  deref(arg2);
5909  }
5910  deref_args(g,set_1_2);
5911 
5912  if (success) {
5913  if (n1) {
5914  if (overlap_type(arg1->type,quoted_string))
5915  if (arg1->value_3)
5916  c_arg1= (char *)arg1->value_3;
5917  else {
5918  success=FALSE;
5919  Errorline("bad argument in %P.\n",g);
5920  }
5921  else
5922  success=FALSE;
5923  }
5924  else {
5925  success=FALSE;
5926  Errorline("bad argument in %P.\n",g);
5927  };
5928  };
5929 
5930  if (success) {
5931  if (n2) {
5932  if (overlap_type(arg2->type,quoted_string))
5933  if (arg2->value_3)
5934  c_arg2= (char *)arg2->value_3;
5935  else {
5936  success=FALSE;
5937  Errorline("bad argument in %P.\n",g);
5938  }
5939  else
5940  success=FALSE;
5941  }
5942  else {
5943  success=FALSE;
5944  Errorline("bad argument in %P.\n",g);
5945  };
5946  };
5947 
5948  if (success)
5949  success=append_files(c_arg1,c_arg2);
5950 
5951  return success;
5952 }
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)
append_files
Definition: built_ins.c:5539
#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

c_apply

C_APPLY This evaluates "apply(functor => F,Args)". If F is a known function, then it builds the psi-term F(Args), and evaluates it.

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

1162 {
1163  long success=TRUE;
1164  ptr_psi_term funct,other;
1165  ptr_node n,fattr;
1166 
1167  funct=aim->aaaa_1;
1168  deref_ptr(funct);
1170  if (n) {
1171  other=(ptr_psi_term )n->data;
1172  deref(other);
1173  if (other->type==top)
1174  residuate(other);
1175  else
1176  if(other->type && other->type->type_def!=(def_type)function_it) {
1177  success=FALSE;
1178  Errorline("argument is not a function in %P.\n",funct);
1179  }
1180  else {
1181  /* What we really want here is to merge all attributes in */
1182  /* funct->attr_list, except '*functor*', into other->attr_list. */
1183  clear_copy();
1184  other=distinct_copy(other);
1185  fattr=distinct_tree(funct->attr_list); /* Make distinct copy: PVR */
1186  push_goal(eval,other,aim->bbbb_1,(GENERIC)other->type->rule);
1187  merge_unify(&(other->attr_list),fattr);
1188  /* We don't want to remove anything from funct->attr_list here. */
1190  }
1191  }
1192  else
1193  curry();
1194 
1195  return success;
1196 }
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()
clear_copy
Definition: copy.c:53
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void merge_unify(ptr_node *u, ptr_node v)
Definition: login.c:1146
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()
curry
Definition: lefun.c:174
ptr_node distinct_tree(ptr_node t)
distinct_tree
Definition: copy.c:366
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)
distinct_copy
Definition: copy.c:393
#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 ( )

c_args

C_ARGS Return the Unix "ARGV" array as a list of strings. RM: Sep 20 1993

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

6119 {
6120  ptr_psi_term result,list,str;
6121  long success=TRUE;
6122  int i;
6123 
6124  result=aim->bbbb_1;
6125 
6126  list=stack_nil();
6127  for(i=arg_c-1;i>=0;i--) {
6128  str=stack_psi_term(0);
6129  str->type=quoted_string;
6131  list=stack_cons((ptr_psi_term)str,(ptr_psi_term)list);
6132  }
6133  push_goal(unify,result,list,NULL);
6134 
6135  return success;
6136 }
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
stack_cons
Definition: built_ins.c:46
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define NULL
Definition: def_const.h:203
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)
stack_psi_term
Definition: lefun.c:21
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term stack_nil()
stack_nil
Definition: built_ins.c:26
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

c_ascii

C_ASCII Return the Ascii code of the first character of a string or of a psi-term's name.

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

4778 {
4779  long success=TRUE;
4780  ptr_psi_term arg1,arg2,funct,result;
4781  long smaller;
4782 
4783  funct=aim->aaaa_1;
4784  deref_ptr(funct);
4785  result=aim->bbbb_1;
4786  deref(result);
4787 
4788  /* success=get_real_value(result,&val1,&num1); */
4789  /* if (success) { */
4790  get_two_args(funct->attr_list,&arg1,&arg2);
4791  if (arg1) {
4792  deref(arg1);
4793  deref_args(funct,set_1);
4794  success=matches(arg1->type,quoted_string,&smaller);
4795  if (success) {
4796  if (arg1->value_3) {
4797  (void) unify_real_result(result,(REAL)(*((unsigned char *)arg1->value_3)));
4798  }
4799  else
4800  residuate(arg1);
4801  }
4802  else {/* RM: Feb 18 1994 */
4803  success=FALSE;
4804  Errorline("String argument expected in '%P'\n",funct);
4805  }
4806  /*
4807  else {
4808  success=TRUE;
4809  unify_real_result(result,(REAL)(*((unsigned char *)arg1->type->keyword->symbol)));
4810  }
4811  */
4812  }
4813  else
4814  curry();
4815  /* } */
4816 
4817  return success;
4818 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
unify_real_result
Definition: built_ins.c:387
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

c_assert_first

C_ASSERT_FIRST Assert a fact, inserting it as the first clause for that predicate or function.

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

2388 {
2389  long success=FALSE;
2390  ptr_psi_term arg1,g;
2391 
2392  g=aim->aaaa_1;
2393  bk_mark_quote(g); /* RM: Apr 7 1993 */
2394  get_one_arg(g->attr_list,&arg1);
2396  if (arg1) {
2397  deref_ptr(arg1);
2398  assert_clause(arg1);
2399  encode_types();
2400  success=assert_ok;
2401  }
2402  else {
2403  success=FALSE;
2404  Errorline("bad clause in %P.\n",g);
2405  }
2406 
2407  return success;
2408 }
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)
get_one_arg
Definition: login.c:99
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)
bk_mark_quote
Definition: copy.c:709
#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)
assert_clause
Definition: login.c:287
static long c_assert_last ( )
static

c_assert_last

C_ASSERT_LAST Assert a fact, inserting as the last clause for that predicate or function.

Definition at line 2417 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().

2418 {
2419  long success=FALSE;
2420  ptr_psi_term arg1,g;
2421 
2422  g=aim->aaaa_1;
2423  bk_mark_quote(g); /* RM: Apr 7 1993 */
2424  get_one_arg(g->attr_list,&arg1);
2426  if (arg1) {
2427  deref_ptr(arg1);
2428  assert_clause(arg1);
2429  encode_types();
2430  success=assert_ok;
2431  }
2432  else {
2433  success=FALSE;
2434  Errorline("bad clause in %P.\n",g);
2435  }
2436 
2437  return success;
2438 }
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)
get_one_arg
Definition: login.c:99
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)
bk_mark_quote
Definition: copy.c:709
#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)
assert_clause
Definition: login.c:287
static long c_assign ( )
static

c_assign

C_ASSIGN() This implements non-backtrackable assignment. It doesn't work because backtrackable unifications can have been made before this assignment was reached. It is complicated by the fact that the assigned term has to be copied into the heap as it becomes a permanent object.

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

4343 {
4344  long success=FALSE;
4345  ptr_psi_term arg1,arg2,g; // perm ,smallest;
4346 
4347  g=aim->aaaa_1;
4348  deref_ptr(g);
4349  get_two_args(g->attr_list,&arg1,&arg2);
4350  if (arg1 && arg2) {
4351  success=TRUE;
4352  deref_ptr(arg1);
4353  deref_rec(arg2); /* 17.9 */
4354  /* deref(arg2); 17.9 */
4355  deref_args(g,set_1_2);
4356  if ((GENERIC)arg1<heap_pointer || arg1!=arg2) {
4357  clear_copy();
4358  *arg1 = *exact_copy(arg2,HEAP);
4359  }
4360  }
4361  else
4362  Errorline("argument missing in %P.\n",g);
4363 
4364  return success;
4365 }
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)
get_two_args
Definition: login.c:47
#define HEAP
Definition: def_const.h:147
void clear_copy()
clear_copy
Definition: copy.c:53
ptr_psi_term exact_copy(ptr_psi_term t, long heap_flag)
exact_copy
Definition: copy.c:176
#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

c_bk_assign

C_BK_ASSIGN() This implements backtrackable assignment.

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

4284 {
4285  long success=FALSE;
4286  ptr_psi_term arg1,arg2,g;
4287 
4288  g=aim->aaaa_1;
4289  deref_ptr(g);
4290  get_two_args(g->attr_list,&arg1,&arg2);
4291  if (arg1 && arg2) {
4292  success=TRUE;
4293  deref(arg1);
4294  deref_rec(arg2); /* 17.9 */
4295  /* deref(arg2); 17.9 */
4296  deref_args(g,set_1_2);
4297  if (arg1 != arg2) {
4298 
4299  /* RM: Mar 10 1993 */
4300  if((GENERIC)arg1>=heap_pointer) {
4301  Errorline("cannot use '<-' on persistent value in %P\n",g);
4302  return c_abort();
4303  }
4304 
4305 
4306 #ifdef TS
4307  if (!trail_condition(arg1)) {
4308  /* If no trail, then can safely overwrite the psi-term */
4309  release_resid_notrail(arg1);
4310  *arg1 = *arg2;
4311  push_psi_ptr_value(arg2,(GENERIC *)&(arg2->coref)); /* 14.12 */
4312  arg2->coref=arg1; /* 14.12 */
4313  }
4314  else {
4315  push_psi_ptr_value(arg1,(GENERIC *)&(arg1->coref));
4316  arg1->coref=arg2;
4317  release_resid(arg1);
4318  }
4319 #else
4320  push_psi_ptr_value(arg1,(GENERIC *)&(arg1->coref));
4321  arg1->coref=arg2;
4322  release_resid(arg1);
4323 #endif
4324  }
4325  }
4326  else
4327  Errorline("argument missing in %P.\n",g);
4328 
4329  return success;
4330 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long trail_condition(psi_term *Q)
trail_condition
Definition: login.c:2632
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
#define deref_rec(P)
Definition: def_macro.h:144
long c_abort()
c_abort
Definition: built_ins.c:2248
void release_resid(ptr_psi_term t)
release_resid
Definition: lefun.c:445
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)
release_resid_notrail
Definition: lefun.c:456
#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

c_boolpred

C_BOOLPRED Internal built-in predicate that handles functions in predicate positions. This predicate should never be called directly by the user.

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

840 {
841  long success=TRUE,succ,lesseq;
842  ptr_psi_term t,arg1;
843 
844  t=aim->aaaa_1;
845  deref_ptr(t);
846  get_one_arg(t->attr_list,&arg1);
847  if (arg1) {
848  deref(arg1);
849  deref_args(t,set_1);
850  if (sub_type(boolean,arg1->type)) {
851  residuate(arg1);
852  }
853  else {
854  succ=matches(arg1->type,lf_true,&lesseq);
855  if (succ) {
856  if (lesseq) {
857  /* Function returns lf_true: success. */
858  }
859  else
860  residuate(arg1);
861  }
862  else {
863  succ=matches(arg1->type,lf_false,&lesseq);
864  if (succ) {
865  if (lesseq) {
866  /* Function returns lf_false: failure. */
867  success=FALSE;
868  }
869  else
870  residuate(arg1);
871  }
872  else {
873  /* Both lf_true and false are disentailed. */
874  if (arg1->type->type_def==(def_type)predicate) {
876  }
877  else {
878  Errorline("function result '%P' should be a boolean or a predicate.\n",
879  arg1);
880  return (c_abort());
881  }
882  }
883  }
884  }
885  }
886  else {
887  Errorline("missing argument to '*boolpred*'.\n");
888  return (c_abort());
889  }
890 
891  return success;
892 }
#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)
residuate
Definition: lefun.c:125
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
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()
c_abort
Definition: built_ins.c:2248
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#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

c_call

C_CALL Prove a predicate, return true or false if it succeeds or fails. No implicit cut is performed.

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

4233 {
4234  long success=TRUE;
4235  ptr_psi_term arg1,arg2,funct,result,other;
4236  ptr_choice_point cutpt;
4237 
4238  funct=aim->aaaa_1;
4239  deref_ptr(funct);
4240  result=aim->bbbb_1;
4241  get_two_args(funct->attr_list,&arg1,&arg2);
4242  if (arg1) {
4243  deref_ptr(arg1);
4244  deref_args(funct,set_1);
4245  if(arg1->type==top)
4246  residuate(arg1);
4247  else
4248  if(FALSE /*arg1->type->type_def!=predicate*/) {
4249  success=FALSE;
4250  Errorline("argument of %P should be a predicate.\n",funct);
4251  }
4252  else {
4253  resid_aim=NULL;
4254  cutpt=choice_stack;
4255 
4256  /* Result is FALSE */
4257  other=stack_psi_term(0);
4258  other->type=lf_false;
4259 
4260  push_choice_point(unify,result,other,NULL);
4261 
4262  /* Result is TRUE */
4263  other=stack_psi_term(0);
4264  other->type=lf_true;
4265 
4266  push_goal(unify,result,other,NULL);
4268  }
4269  }
4270  else
4271  curry();
4272 
4273  return success;
4274 }
#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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_choice_point
Definition: login.c:638
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#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()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_char

C_CHAR RM: May 6 1993 Changed C_CHAR to return a string Create a 1 character string from an ASCII code.

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

4728 {
4729  long success=TRUE;
4730  ptr_psi_term arg1,arg2,funct,result;
4731  char *str;
4732 
4733  funct=aim->aaaa_1;
4734  deref_ptr(funct);
4735  result=aim->bbbb_1;
4736  deref(result);
4737 
4738  get_two_args(funct->attr_list,&arg1,&arg2);
4739  if (arg1) {
4740  deref(arg1);
4741  deref_args(funct,set_1);
4742  if (overlap_type(arg1->type,integer)) {
4743  if (arg1->value_3) {
4744  ptr_psi_term t;
4745 
4746  t=stack_psi_term(4);
4747  t->type=quoted_string;
4748  str=(char *)heap_alloc(2);
4749  str[0] = (unsigned char) floor(*(REAL *) arg1->value_3);
4750  str[1] = 0;
4751  t->value_3=(GENERIC)str;
4752 
4753  push_goal(unify,t,result,NULL);
4754  }
4755  else
4756  residuate(arg1);
4757  }
4758  else {
4759  Errorline("argument of %P must be an integer.\n",funct);
4760  success=FALSE;
4761  }
4762  }
4763  else
4764  curry();
4765 
4766  return success;
4767 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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)
heap_alloc
Definition: memory.c:1616
static long c_chdir ( )
static

c_chdir

C_CHDIR Change the current working directory

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

4149 {
4150  long success=FALSE;
4151  ptr_psi_term arg1,arg2,funct;
4152  long smaller;
4153 
4154  funct = aim->aaaa_1;
4155  deref_ptr(funct);
4156 
4157  get_two_args(funct->attr_list, &arg1, &arg2);
4158  if(arg1) {
4159  deref_ptr(arg1);
4160  if(matches(arg1->type,quoted_string,&smaller) && arg1->value_3)
4161  success=!chdir(expand_file_name((char *)arg1->value_3));
4162  else
4163  Errorline("bad argument in %P\n",funct);
4164  }
4165  else
4166  Errorline("argument missing in %P\n",funct);
4167 
4168  return success;
4169 }
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)
get_two_args
Definition: login.c:47
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

c_clause

C_CLAUSE Find the clauses that unify with the argument in the rules. The argument must be a predicate or a function. Use PRED_CLAUSE to perform the search.

Definition at line 2520 of file built_ins.c.

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

2521 {
2522  long success=FALSE;
2523  ptr_psi_term arg1,arg2,g;
2524 
2525  g=aim->aaaa_1;
2526  get_two_args(g->attr_list,&arg1,&arg2);
2527  success=pred_clause(arg1,0,g);
2528  return success;
2529 }
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)
get_two_args
Definition: login.c:47
long pred_clause(ptr_psi_term t, long r, ptr_psi_term g)
pred_clause
Definition: built_ins.c:2452
#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

c_close

C_CLOSE Close a stream.

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

2934 {
2935  long success=FALSE;
2936  long inclose,outclose;
2937  ptr_psi_term arg1,arg2,g; // ,s;
2938 
2939  g=aim->aaaa_1;
2940  deref_ptr(g);
2941  get_two_args(g->attr_list,&arg1,&arg2);
2942  if (arg1) {
2943  deref(arg1);
2944  deref_args(g,set_1);
2945  /*
2946  if (sub_type(arg1->type,sys_stream))
2947  return sys_close(arg1);
2948  */
2949  outclose=equal_types(arg1->type,stream) && arg1->value_3;
2950  inclose=FALSE;
2951  if (equal_types(arg1->type,inputfilesym)) {
2953  if (n) {
2954  arg1=(ptr_psi_term)n->data;
2955  inclose=(arg1->value_3!=NULL);
2956  }
2957  }
2958 
2959  if (inclose || outclose) {
2960  success=TRUE;
2961  (void)fclose((FILE *)arg1->value_3);
2962 
2963  if (inclose && (FILE *)arg1->value_3==input_stream)
2964  (void)open_input_file("stdin");
2965  else if (outclose && (FILE *)arg1->value_3==output_stream)
2966  (void)open_output_file("stdout");
2967 
2968  arg1->value_3=NULL;
2969  }
2970  else
2971  Errorline("bad stream in %P.\n",g);
2972  }
2973  else
2974  Errorline("no stream in %P.\n",g);
2975 
2976  return success;
2977 }
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)
get_two_args
Definition: login.c:47
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

c_combined_name

C_COMBINED_NAME Return the string module::name for a term.

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

5690 {
5691  long success=TRUE;
5692  ptr_psi_term arg1,arg2,funct,result;
5693 
5694 
5695  funct=aim->aaaa_1;
5696  result=aim->bbbb_1;
5697  deref_ptr(funct);
5698  deref_ptr(result);
5699 
5700  get_two_args(funct->attr_list,&arg1,&arg2);
5701 
5702  if (arg1) {
5703  deref_ptr(arg1);
5704  arg2=stack_psi_term(0);
5705  arg2->type=quoted_string;
5707  push_goal(unify,arg2,result,NULL);
5708  }
5709  else
5710  curry();
5711 
5712  return success;
5713 }
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)
get_two_args
Definition: login.c:47
char * combined_name
Definition: def_struct.h:92
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
ptr_keyword keyword
Definition: def_struct.h:124
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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 ( )

c_concatenate

C_CONCATENATE Concatenate the strings in arguments 1 and 2.

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

5574 {
5575  ptr_psi_term result,funct,temp_result;
5576  ptr_node n1, n2;
5577  long success=TRUE;
5578  long all_args=TRUE;
5579  char * c_result;
5580  ptr_psi_term arg1;
5581  char * c_arg1;
5582  ptr_psi_term arg2;
5583  char * c_arg2;
5584 
5585  funct=aim->aaaa_1;
5586  deref_ptr(funct);
5587  result=aim->bbbb_1;
5588 
5589  /* Evaluate all arguments first: */
5590  n1=find(FEATCMP,one,funct->attr_list);
5591  if (n1) {
5592  arg1= (ptr_psi_term )n1->data;
5593  deref(arg1);
5594  }
5595  n2=find(FEATCMP,two,funct->attr_list);
5596  if (n2) {
5597  arg2= (ptr_psi_term )n2->data;
5598  deref(arg2);
5599  }
5600  deref_args(funct,set_1_2);
5601 
5602  if (success) {
5603  if (n1) {
5604  if (overlap_type(arg1->type,quoted_string)) /* 10.8 */
5605  if (arg1->value_3)
5606  c_arg1= (char *)arg1->value_3;
5607  else {
5608  residuate(arg1);
5609  all_args=FALSE;
5610  }
5611  else
5612  success=FALSE;
5613  }
5614  else {
5615  all_args=FALSE;
5616  curry();
5617  };
5618  };
5619 
5620  if (success) {
5621  if (n2) {
5622  if (overlap_type(arg2->type,quoted_string)) /* 10.8 */
5623  if (arg2->value_3)
5624  c_arg2= (char *)arg2->value_3;
5625  else {
5626  residuate(arg2);
5627  all_args=FALSE;
5628  }
5629  else
5630  success=FALSE;
5631  }
5632  else {
5633  all_args=FALSE;
5634  curry();
5635  }
5636  }
5637 
5638  if(success && all_args) {
5639  c_result=str_conc( c_arg1, c_arg2 );
5640  temp_result=stack_psi_term(0);
5641  temp_result->type=quoted_string;
5642  temp_result->value_3= (GENERIC)c_result;
5643  push_goal(unify,temp_result,result,NULL);
5644  }
5645 
5646  return success;
5647 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
char * two
Definition: def_glob.h:251
GENERIC data
Definition: def_struct.h:185
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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
char * str_conc(char *s1, char *s2)
str_conc
Definition: built_ins.c:5492
#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_cond ( )
static

c_cond

C_COND This implements COND(Condition,Then,Else). First Condition is evaluated. If it returns true, return the Then value. If it returns false, return the Else value. Either the Then or the Else values may be omitted, in which case they are considered to be true.

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

3420 {
3421  long success=TRUE;
3422  ptr_psi_term arg1,arg2,result,g;
3423  ptr_psi_term *arg1addr;
3424  REAL val1;
3425  long num1;
3426  ptr_node n;
3427 
3428  g=aim->aaaa_1;
3429  deref_ptr(g);
3430  result=aim->bbbb_1;
3431  deref(result);
3432 
3433  get_one_arg_addr(g->attr_list,&arg1addr);
3434  if (arg1addr) {
3435  arg1= *arg1addr;
3436  deref_ptr(arg1);
3437  if (arg1->type->type_def==(def_type)predicate) {
3438  ptr_psi_term call_once;
3439  ptr_node ca;
3440 
3441  /* Transform cond(pred,...) into cond(call_once(pred),...) */
3442  goal_stack=aim;
3443  call_once=stack_psi_term(0);
3444  call_once->type=calloncesym;
3445  call_once->attr_list=(ca=STACK_ALLOC(node));
3446  ca->key=one;
3447  ca->left=ca->right=NULL;
3448  ca->data=(GENERIC)arg1;
3449  push_ptr_value(psi_term_ptr,(GENERIC *)arg1addr);
3450  *arg1addr=call_once;
3451  return success;
3452  }
3453  deref(arg1);
3454  deref_args(g,set_1_2_3);
3455  success=get_bool_value(arg1,&val1,&num1);
3456  if (success) {
3457  if (num1) {
3458  resid_aim=NULL;
3459  n=find(FEATCMP,(val1?two:three),g->attr_list);
3460  if (n) {
3461  arg2=(ptr_psi_term)n->data;
3462  /* mark_eval(arg2); XXX 24.8 */
3463  push_goal(unify,result,arg2,NULL);
3464  (void)i_check_out(arg2);
3465  }
3466  else {
3467  ptr_psi_term trueterm;
3468  trueterm=stack_psi_term(4);
3469  trueterm->type=lf_true;
3470  push_goal(unify,result,trueterm,NULL);
3471  }
3472  }
3473  else
3474  residuate(arg1);
3475  }
3476  else /* RM: Apr 15 1993 */
3477  Errorline("argument to cond is not boolean in %P\n",g);
3478  }
3479  else
3480  curry();
3481 
3482  return success;
3483 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define predicate
Definition: def_const.h:361
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
void get_one_arg_addr(ptr_node t, ptr_psi_term **a)
get_one_arg_addr
Definition: login.c:132
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
ptr_goal goal_stack
Definition: def_glob.h:50
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
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()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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)
get_bool_value
Definition: built_ins.c:301
ptr_node attr_list
Definition: def_struct.h:171
long i_check_out(ptr_psi_term t)
i_check_out
Definition: lefun.c:1033
ptr_node right
Definition: def_struct.h:184
#define psi_term_ptr
Definition: def_const.h:170
static long c_copy_pointer ( )
static

c_copy_pointer

C_COPY_POINTER Make a fresh copy of the input's sort, keeping exactly the same arguments as before (i.e., copying the sort and feature table but not the feature values).

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

4479 {
4480  long success=TRUE;
4481  ptr_psi_term funct,arg1,result,other;
4482 
4483  funct=aim->aaaa_1;
4484  deref_ptr(funct);
4485  get_one_arg(funct->attr_list,&arg1);
4486  if (arg1) {
4487  deref(arg1);
4488  deref_args(funct,set_1);
4489  other=stack_psi_term(4);
4490  other->type=arg1->type;
4491  other->value_3=arg1->value_3;
4492  other->attr_list=copy_attr_list(arg1->attr_list); /* PVR 23.2.94 */
4493  result=aim->bbbb_1;
4494  push_goal(unify,other,result,NULL);
4495  }
4496  else
4497  curry();
4498 
4499  return success;
4500 }
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)
push_goal
Definition: login.c:600
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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)
copy_attr_list
Definition: built_ins.c:3802
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

c_copy_term

C_COPY_TERM Make a fresh copy of the input argument, keeping its structure but with no connections to the input.

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

4511 {
4512  long success=TRUE;
4513  ptr_psi_term funct,arg1,copy_arg1,result;
4514 
4515  funct=aim->aaaa_1;
4516  deref_ptr(funct);
4517  get_one_arg(funct->attr_list,&arg1);
4518  if (arg1) {
4519  deref(arg1);
4520  deref_args(funct,set_1);
4521  result=aim->bbbb_1;
4522  clear_copy();
4523  copy_arg1=exact_copy(arg1,STACK);
4524  push_goal(unify,copy_arg1,result,NULL);
4525  }
4526  else
4527  curry();
4528 
4529  return success;
4530 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void clear_copy()
clear_copy
Definition: copy.c:53
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
ptr_psi_term exact_copy(ptr_psi_term t, long heap_flag)
exact_copy
Definition: copy.c:176
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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

c_declaration

C_DECLARATION This function always fails, it is in fact identical to BOTTOM.

Definition at line 2314 of file built_ins.c.

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

2315 {
2316  ptr_psi_term t;
2317 
2318  t=aim->aaaa_1;
2319  deref_ptr(t);
2320  Errorline("%P is a declaration, not a query.\n",t);
2321  return FALSE;
2322 }
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

static long c_delay_check()

C_DELAY_CHECK() Mark that the properties of the types in the arguments are delay checked during unification (i.e. they are only checked when the psi-term is given attributes, and they are not checked as long as the psi-term has no attributes.)

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

1663 {
1664  ptr_psi_term t=aim->aaaa_1;
1665 
1666  deref_ptr(t);
1667  /* mark_quote(t); 14.9 */
1670  return TRUE;
1671 }
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 ( )

c_deref_length

C_DEREF_LENGTH Return the length of the dereference chain for argument 1. RM: Jul 15 1993

Definition at line 6083 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().

6084 {
6085  ptr_psi_term result,funct;
6086  long success=TRUE;
6087  int count;
6088  ptr_psi_term arg1; // ,arg2;
6089  ptr_node n1;
6090 
6091  funct=aim->aaaa_1;
6092  deref_ptr(funct);
6093  result=aim->bbbb_1;
6094 
6095  n1=find(FEATCMP,one,funct->attr_list);
6096  if (n1) {
6097  count=0;
6098  arg1= (ptr_psi_term )n1->data;
6099  while(arg1->coref) {
6100  count++;
6101  arg1=arg1->coref;
6102  }
6103  success=unify_real_result(result,(REAL)count);
6104  }
6105  else
6106  curry();
6107 
6108  return success;
6109 }
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()
curry
Definition: lefun.c:174
#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)
unify_real_result
Definition: built_ins.c:387
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
static long c_diff ( )
static

c_diff

C_DIFF Arithmetic not-equal.

Definition at line 1309 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().

1310 {
1311  long success=TRUE;
1312  ptr_psi_term arg1,arg2,arg3,t;
1313  long num1,num2,num3;
1314  REAL val1,val2,val3;
1315 
1316  t=aim->aaaa_1;
1317  deref_ptr(t);
1318  get_two_args(t->attr_list,&arg1,&arg2);
1319  arg3=aim->bbbb_1;
1320 
1321  if(arg1) {
1322  deref(arg1);
1323  success=get_real_value(arg1,&val1,&num1);
1324  if(success && arg2) {
1325  deref(arg2);
1326  deref_args(t,set_1_2);
1327  success=get_real_value(arg2,&val2,&num2);
1328  }
1329  }
1330 
1331  if(success)
1332  if(arg1 && arg2) {
1333  deref(arg3);
1334  success=get_bool_value(arg3,&val3,&num3);
1335  if(success)
1336  switch(num1+2*num2+4*num3) {
1337  case 0:
1338  if(arg1==arg2)
1339  unify_bool_result(arg3,FALSE);
1340  else
1341  residuate2(arg1,arg2);
1342  break;
1343  case 1:
1344  residuate2(arg2,arg3);
1345  break;
1346  case 2:
1347  residuate2(arg1,arg3);
1348  break;
1349  case 3:
1350  unify_bool_result(arg3,(val1!=val2));
1351  break;
1352  case 4:
1353  if(arg1==arg2 && val3)
1354  success=FALSE;
1355  else
1356  residuate2(arg1,arg2);
1357  break;
1358  case 5:
1359  if(val3)
1360  residuate(arg2);
1361  else
1362  success=unify_real_result(arg2,val1);
1363  break;
1364  case 6:
1365  if(val3)
1366  residuate(arg1);
1367  else
1368  success=unify_real_result(arg1,val2);
1369  break;
1370  case 7:
1371  success=(val3==(REAL)(val1!=val2));
1372  break;
1373  }
1374  }
1375  else
1376  curry();
1377 
1378  nonnum_warning(t,arg1,arg2);
1379  return success;
1380 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
curry
Definition: lefun.c:174
#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)
residuate2
Definition: lefun.c:144
#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)
unify_real_result
Definition: built_ins.c:387
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
get_bool_value
Definition: built_ins.c:301
ptr_node attr_list
Definition: def_struct.h:171
static long c_diff_address ( )
static

c_diff_address

C_DIFF_ADDRESS Return TRUE if two arguments have different addresses.

Definition at line 3897 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().

3898 {
3899  long success=TRUE;
3900  ptr_psi_term arg1,arg2,funct,result;
3901  REAL val3;
3902  long num3;
3903 
3904  funct=aim->aaaa_1;
3905  deref_ptr(funct);
3906  result=aim->bbbb_1;
3907  get_two_args(funct->attr_list,&arg1,&arg2);
3908 
3909  if (arg1 && arg2) {
3910  success=get_bool_value(result,&val3,&num3);
3911  resid_aim=NULL;
3912  deref(arg1);
3913  deref(arg2);
3914  deref_args(funct,set_1_2);
3915 
3916  if (num3) {
3917  if (val3)
3918  push_goal(unify,arg1,arg2,NULL);
3919  else
3920  success=(arg1==arg2);
3921  }
3922  else
3923  if (arg1==arg2)
3924  unify_bool_result(result,FALSE);
3925  else
3926  unify_bool_result(result,TRUE);
3927  }
3928  else
3929  curry();
3930 
3931  return success;
3932 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
void curry()
curry
Definition: lefun.c:174
#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)
get_bool_value
Definition: built_ins.c:301
ptr_node attr_list
Definition: def_struct.h:171
static long c_disj ( )
static

c_disj

C_DISJ This implements disjunctions (A;B). A nonexistent A or B is taken to mean 'fail'. Disjunctions should not be implemented in Life, because doing so results in both A and B being evaluated before the disjunction is. Disjunctions could be implemented in Life if there were a 'melt' predicate.

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

3389 {
3390  long success=TRUE;
3391  ptr_psi_term arg1,arg2,g;
3392 
3393  g=aim->aaaa_1;
3394  resid_aim=NULL;
3395  deref_ptr(g);
3396  get_two_args(g->attr_list,&arg1,&arg2);
3397  deref_args(g,set_1_2);
3398  traceline("pushing predicate disjunction choice point for %P\n",g);
3400  if (arg1) push_goal(prove,arg1,(ptr_psi_term)DEFRULES,(GENERIC)NULL);
3401  if (!arg1 && !arg2) {
3402  success=FALSE;
3403  Errorline("neither first nor second arguments exist in %P.\n",g);
3404  }
3405 
3406  return success;
3407 }
#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)
get_two_args
Definition: login.c:47
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_choice_point
Definition: login.c:638
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#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

c_dynamic

C_DYNAMIC() Mark all the arguments as 'unprotected', i.e. they may be changed by assert/retract/redefinition.

Definition at line 1626 of file built_ins.c.

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

1627 {
1628  ptr_psi_term t=aim->aaaa_1;
1629  deref_ptr(t);
1630  /* mark_quote(t); 14.9 */
1632  return TRUE;
1633 }
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

static long c_equal()

C_EQUAL Arithmetic equality.

Definition at line 508 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().

509 {
510  long success=TRUE;
511  ptr_psi_term arg1,arg2,arg3,t;
512  long num1,num2,num3;
513  REAL val1,val2,val3;
514 
515  t=aim->aaaa_1;
516  deref_ptr(t);
517  get_two_args(t->attr_list,&arg1,&arg2);
518  arg3=aim->bbbb_1;
519 
520  if(arg1) {
521  deref(arg1);
522  success=get_real_value(arg1,&val1,&num1);
523  if(success && arg2) {
524  deref(arg2);
525  deref_args(t,set_1_2);
526  success=get_real_value(arg2,&val2,&num2);
527  }
528  }
529 
530  if(success)
531  if(arg1 && arg2) {
532  deref(arg3);
533  success=get_bool_value(arg3,&val3,&num3);
534  if(success)
535  switch(num1+2*num2+4*num3) {
536  case 0:
537  if(arg1==arg2)
538  unify_bool_result(arg3,TRUE);
539  else
540  residuate2(arg1,arg2);
541  break;
542  case 1:
543  residuate2(arg2,arg3);
544  break;
545  case 2:
546  residuate2(arg1,arg3);
547  break;
548  case 3:
549  unify_bool_result(arg3,(val1==val2));
550  break;
551  case 4:
552  if(arg1==arg2 && !val3)
553  success=FALSE;
554  else
555  residuate2(arg1,arg2);
556  break;
557  case 5:
558  if(!val3)
559  residuate(arg2);
560  else
561  success=unify_real_result(arg2,val1);
562  break;
563  case 6:
564  if(!val3)
565  residuate(arg1);
566  else
567  success=unify_real_result(arg1,val2);
568  break;
569  case 7:
570  success=(val3==(REAL)(val1==val2));
571  break;
572  }
573  }
574  else
575  curry();
576 
577  nonnum_warning(t,arg1,arg2);
578  return success;
579 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
curry
Definition: lefun.c:174
#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)
residuate2
Definition: lefun.c:144
#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)
unify_real_result
Definition: built_ins.c:387
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long get_bool_value(ptr_psi_term t, REAL *v, long *n)
get_bool_value
Definition: built_ins.c:301
ptr_node attr_list
Definition: def_struct.h:171
static long c_eval ( )
static

c_eval

C_EVAL Evaluate an expression and return its value.

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

3942 {
3943  long success=TRUE;
3944  ptr_psi_term arg1, copy_arg1, arg2, funct, result;
3945 
3946  funct = aim->aaaa_1;
3947  deref_ptr(funct);
3948  result = aim->bbbb_1;
3949  deref(result);
3950  get_two_args(funct->attr_list, &arg1, &arg2);
3951  if (arg1) {
3952  deref(arg1);
3953  deref_args(funct,set_1);
3954  assert((unsigned long)(arg1->type)!=4);
3955  clear_copy();
3956  copy_arg1 = eval_copy(arg1,STACK);
3957  resid_aim = NULL;
3958  push_goal(unify,copy_arg1,result,NULL);
3959  (void)i_check_out(copy_arg1);
3960  } else
3961  curry();
3962 
3963  return success;
3964 }
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)
get_two_args
Definition: login.c:47
void clear_copy()
clear_copy
Definition: copy.c:53
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
eval_copy
Definition: copy.c:196
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)
i_check_out
Definition: lefun.c:1033
#define STACK
Definition: def_const.h:148
#define assert(N)
Definition: memory.c:113
static long c_eval_disjunction ( )
static

c_eval_disjunction

C_EVAL_DISJUNCTION Evaluate a disjunction.

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

592 {
593  ptr_psi_term arg1,arg2,funct,result;
594 
595 
596  funct=aim->aaaa_1;
597  deref_ptr(funct);
598  result=aim->bbbb_1;
599  get_two_args(funct->attr_list,&arg1,&arg2);
600 
601  /* deref_args(funct,set_1_2); Don't know about this */
602 
603  if (arg1 && arg2) {
604  deref_ptr(arg1);
605  deref_ptr(arg2);
606 
607  resid_aim=NULL; /* Function evaluation is over */
608 
609  if(arg2->type!=disj_nil) /* RM: Feb 1 1993 */
610  /* Create the alternative */
611  push_choice_point(eval,arg2,result,(GENERIC)funct->type->rule);
612 
613  /* Unify the result with the first argument */
614  push_goal(unify,result,arg1,NULL);
615  (void)i_check_out(arg1);
616  }
617  else {
618  Errorline("malformed disjunction '%P'\n",funct);
619  return (c_abort());
620  }
621 
622  return TRUE;
623 }
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)
get_two_args
Definition: login.c:47
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_choice_point
Definition: login.c:638
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
long c_abort()
c_abort
Definition: built_ins.c:2248
#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)
i_check_out
Definition: lefun.c:1033
static long c_eval_inplace ( )
static

c_eval_inplace

C_EVAL_INPLACE Evaluate an expression and return its value.

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

3974 {
3975  long success=TRUE;
3976  ptr_psi_term arg1,/* copy_arg1, */ arg2, funct, result;
3977 
3978  funct = aim->aaaa_1;
3979  deref_ptr(funct);
3980  result = aim->bbbb_1;
3981  deref(result);
3982  get_two_args(funct->attr_list, &arg1, &arg2);
3983  if (arg1) {
3984  deref(arg1);
3985  deref_args(funct,set_1);
3986  resid_aim = NULL;
3987  mark_eval(arg1);
3988  push_goal(unify,arg1,result,NULL);
3989  (void)i_check_out(arg1);
3990  } else
3991  curry();
3992 
3993  return success;
3994 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
mark_eval
Definition: copy.c:498
#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)
i_check_out
Definition: lefun.c:1033
static long c_exist_feature ( )
static

c_exist_feature

C_EXIST_FEATURE Here we evaluate "has_feature(Label,Psi-term,Value)". This is a boolean function that returns true iff Psi-term has the feature Label.

Added optional 3rd argument which is unified with the feature value if it exists.

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

3497 {
3498  long success=TRUE,v;
3499  ptr_psi_term arg1,arg2,arg3,funct,result,ans;
3500  ptr_node n;
3501  char * label;
3502  /* char *thebuffer="integer"; 18.5 */
3503  char thebuffer[20]; /* Maximum number of digits in an integer */
3504  // char *np1;
3505 
3506  funct=aim->aaaa_1;
3507  deref_ptr(funct);
3508  result=aim->bbbb_1;
3509  get_two_args(funct->attr_list,&arg1,&arg2);
3510 
3511  n=find(FEATCMP,three,funct->attr_list); /* RM: Feb 10 1993 */
3512  if(n)
3513  arg3=(ptr_psi_term)n->data;
3514  else
3515  arg3=NULL;
3516 
3517  if (arg1 && arg2) {
3518  deref(arg1);
3519  deref(arg2);
3520 
3521  if(arg3) /* RM: Feb 10 1993 */
3522  deref(arg3);
3523 
3524  deref_args(funct,set_1_2);
3525  label=NULL;
3526 
3527  if (arg1->value_3 && sub_type(arg1->type,quoted_string))
3528  label=(char *)arg1->value_3;
3529  else if (arg1->value_3 && sub_type(arg1->type,integer)) {
3530  v= *(REAL *)arg1->value_3;
3531  (void)snprintf(thebuffer,20,"%ld",(long)v);
3532  label=heap_copy_string(thebuffer); /* A little voracious */
3533  } else if (arg1->type->keyword->private_feature) {
3534  label=arg1->type->keyword->combined_name;
3535  } else
3536  label=arg1->type->keyword->symbol;
3537 
3538  n=find(FEATCMP,(char *)label,arg2->attr_list);
3539  ans=stack_psi_term(4);
3540  ans->type=(n!=NULL)?lf_true:lf_false;
3541 
3542  if(arg3 && n) /* RM: Feb 10 1993 */
3544 
3545  push_goal(unify,result,ans,NULL);
3546  }
3547  else
3548  curry();
3549 
3550  return success;
3551 }
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)
get_two_args
Definition: login.c:47
#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)
push_goal
Definition: login.c:600
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_exists

C_EXISTS Succeed iff a file can be read in (i.e. if it exists).

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

1734 {
1735  ptr_psi_term g;
1736  ptr_node n;
1737  long success=TRUE;
1738  ptr_psi_term arg1;
1739  char *c_arg1;
1740 
1741  g=aim->aaaa_1;
1742  deref_ptr(g);
1743 
1744  if (success) {
1745  n=find(FEATCMP,one,g->attr_list);
1746  if (n) {
1747  arg1= (ptr_psi_term )n->data;
1748  deref(arg1);
1749  deref_args(g,set_1);
1750  if (!psi_to_string(arg1,&c_arg1)) {
1751  success=FALSE;
1752  Errorline("bad argument in %P.\n",g);
1753  }
1754  }
1755  else {
1756  success=FALSE;
1757  Errorline("bad argument in %P.\n",g);
1758  }
1759  }
1760 
1761  if (success)
1762  success=file_exists(c_arg1);
1763 
1764  return success;
1765 }
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)
file_exists
Definition: built_ins.c:1712
ptr_node attr_list
Definition: def_struct.h:171
long psi_to_string(ptr_psi_term t, char **fn)
psi_to_string
Definition: built_ins.c:146
static long c_exists_choice ( )
static

c_exists_choice

C_EXISTS_CHOICE() Return true iff there exists a choice point A such that arg1 < A <= arg2, i.e. A is more recent than the choice point marked by arg1 and no more recent than the choice point marked by arg2. The two arguments to exists_choice must come from past calls to get_choice. This function allows one to check whether a choice point exists between any two arbitrary execution points of the program.

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

1912 {
1913  REAL gts_r;
1914  long ans,gts1,gts2,num,success=TRUE;
1915  ptr_psi_term funct,result,arg1,arg2,ans_term;
1916  ptr_choice_point cp;
1917 
1918  funct=aim->aaaa_1;
1919  deref_ptr(funct);
1920  result=aim->bbbb_1;
1921  deref_args(funct,set_empty);
1922  get_two_args(funct->attr_list,&arg1,&arg2);
1923  if (arg1 && arg2) {
1924  deref(arg1);
1925  deref(arg2);
1926  deref_args(funct,set_1_2);
1927  success = get_real_value(arg1,&gts_r,&num);
1928  if (success && num) {
1929  gts1 = (unsigned long) gts_r;
1930  success = get_real_value(arg2,&gts_r,&num);
1931  if (success && num) {
1932  gts2 = (unsigned long) gts_r;
1933  cp = choice_stack;
1934  if (cp) {
1935  while (cp && cp->time_stamp>gts2) cp=cp->next;
1936  ans=(cp && cp->time_stamp>gts1);
1937  }
1938  else
1939  ans=FALSE;
1940  ans_term=stack_psi_term(4);
1941  ans_term->type=ans?lf_true:lf_false;
1942  push_goal(unify,result,ans_term,NULL);
1943  }
1944  else {
1945  Errorline("bad second argument to %P.\n",funct);
1946  success=FALSE;
1947  }
1948  }
1949  else {
1950  Errorline("bad first argument %P.\n",funct);
1951  success=FALSE;
1952  }
1953  }
1954  else
1955  curry();
1956 
1957  return success;
1958 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
#define set_empty
Definition: def_const.h:193
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_fail

C_FAIL Always fail.

Definition at line 1389 of file built_ins.c.

References FALSE.

1390 {
1391  return FALSE;
1392 }
#define FALSE
Definition: def_const.h:128
static long c_feature_values ( )
static

c_feature_values

C_FEATURES Return the list of values of the features of a term.

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

3616 {
3617  long success=TRUE;
3618  ptr_psi_term arg1,arg2,funct,result;
3619  /* ptr_psi_term the_list; RM: Dec 9 1992
3620  Modified the routine to use 'cons'
3621  instead of the old list representation.
3622  */
3623  /* RM: Mar 11 1993 Added MODULE argument */
3624  ptr_module module=NULL;
3625  ptr_module save_current;
3626 
3627  funct=aim->aaaa_1;
3628  deref_ptr(funct);
3629  result=aim->bbbb_1;
3630  get_two_args(funct->attr_list,&arg1,&arg2);
3631 
3632  if(arg2) {
3633  deref(arg2);
3634  success=get_module(arg2,&module);
3635  }
3636  else
3637  module=current_module;
3638 
3639  if(arg1 && success) {
3640  deref(arg1);
3641  deref_args(funct,set_1);
3642  resid_aim=NULL;
3643 
3644  save_current=current_module;
3645  if(module)
3646  current_module=module;
3647 
3648  push_goal(unify,
3649  result,
3650  make_feature_list(arg1->attr_list,stack_nil(),module,1),
3651  NULL);
3652 
3653  current_module=save_current;
3654  }
3655  else
3656  curry();
3657 
3658  return success;
3659 }
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)
get_two_args
Definition: login.c:47
ptr_module current_module
Definition: def_glob.h:161
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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()
stack_nil
Definition: built_ins.c:26
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)
make_feature_list
Definition: built_ins.c:176
#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

c_features

C_FEATURES Convert the feature names of a psi_term into a list of psi-terms. This uses the MAKE_FEATURE_LIST routine.

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

3562 {
3563  long success=TRUE;
3564  ptr_psi_term arg1,arg2,funct,result;
3565  /* ptr_psi_term the_list; RM: Dec 9 1992
3566  Modified the routine to use 'cons'
3567  instead of the old list representation.
3568  */
3569  /* RM: Mar 11 1993 Added MODULE argument */
3570  ptr_module module=NULL;
3571  ptr_module save_current;
3572 
3573  funct=aim->aaaa_1;
3574  deref_ptr(funct);
3575  result=aim->bbbb_1;
3576  get_two_args(funct->attr_list,&arg1,&arg2);
3577 
3578 
3579  if(arg2) {
3580  deref(arg2);
3581  success=get_module(arg2,&module);
3582  }
3583  else
3584  module=current_module;
3585 
3586  if(arg1 && success) {
3587  deref(arg1);
3588  deref_args(funct,set_1);
3589  resid_aim=NULL;
3590 
3591  save_current=current_module;
3592  if(module)
3593  current_module=module;
3594 
3595  push_goal(unify,
3596  result,
3597  make_feature_list(arg1->attr_list,stack_nil(),module,0),
3598  NULL);
3599 
3600  current_module=save_current;
3601  }
3602  else
3603  curry();
3604 
3605  return success;
3606 }
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)
get_two_args
Definition: login.c:47
ptr_module current_module
Definition: def_glob.h:161
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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()
stack_nil
Definition: built_ins.c:26
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)
make_feature_list
Definition: built_ins.c:176
#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

c_freeze

C_FREEZE() See c_freeze_inner.

Definition at line 4702 of file built_ins.c.

References c_freeze_inner(), and TRUE.

4703 {
4704  return c_freeze_inner(TRUE);
4705 }
static long c_freeze_inner(long freeze_flag)
c_freeze_inner
Definition: built_ins.c:4593
#define TRUE
Definition: def_const.h:127
static long c_freeze_inner ( long  freeze_flag)
static

c_freeze_inner

Parameters
longfreeze_flag

C_FREEZE_INNER This implements the freeze and implies predicates. For example:

freeze(g)

The proof will use matching on the heads of g's definition rather than unification to prove Goal. An implicit cut is put at the beginning of each clause body. Body goals are executed in the same way as without freeze. Essentially, the predicate is called as if it were a function.

implies(g)

The proof will use matching as for freeze, but there is no cut at the beginning of the clause body & no residuation is done (the clause fails if its head is not implied by the caller). Essentially, the predicate is called as before except that matching is used instead of unification to decide whether to enter a clause.

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

4594 {
4595  long success=TRUE;
4596  ptr_psi_term arg1,g;
4597  ptr_psi_term head, body;
4598  ptr_pair_list rule;
4599  /* RESID */ ptr_resid_block rb;
4600  ptr_choice_point cutpt;
4601  ptr_psi_term match_date;
4602 
4603  g=aim->aaaa_1;
4604  deref_ptr(g);
4605  get_one_arg(g->attr_list,&arg1);
4606 
4607  if (arg1) {
4608  deref_ptr(arg1);
4609  /* if (!arg1->type->evaluate_args) mark_quote(arg1); 8.9 */ /* 18.2 PVR */
4610  deref_args(g,set_1);
4611  deref_ptr(arg1);
4612 
4613  if (arg1->type->type_def!=(def_type)predicate) {
4614  success=FALSE;
4615  Errorline("the argument %P of freeze must be a predicate.\n",arg1);
4616  /* main_loop_ok=FALSE; 8.9 */
4617  return success;
4618  }
4619  resid_aim=aim;
4620  match_date=(ptr_psi_term)stack_pointer;
4621  cutpt=choice_stack; /* 13.6 */
4622  /* Third argument of freeze's aim is used to keep track of which */
4623  /* clause is being tried in the frozen goal. */
4624  rule=(ptr_pair_list)aim->cccc_1; /* 8.9 */ /* Isn't aim->cccc always NULL? */
4625  resid_vars=NULL;
4626  curried=FALSE;
4627  can_curry=TRUE; /* 8.9 */
4628 
4629  if (!rule) rule=arg1->type->rule; /* 8.9 */
4630  /* if ((unsigned long)rule==DEFRULES) rule=arg1->type->rule; 8.9 */
4631 
4632  if (rule) {
4633  traceline("evaluate frozen predicate %P\n",g);
4634  /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
4635 
4636  if ((unsigned long)rule<=MAX_BUILT_INS) {
4637  success=FALSE; /* 8.9 */
4638  Errorline("the argument %P of freeze must be user-defined.\n",arg1); /* 8.9 */
4639  return success; /* 8.9 */
4640  /* Removed obsolete stuff here 11.9 */
4641  }
4642  else {
4643  while (rule && (rule->aaaa_2==NULL || rule->bbbb_2==NULL)) {
4644  rule=rule->next;
4645  traceline("alternative clause has been retracted\n");
4646  }
4647  if (rule) {
4648  /* RESID */ rb = STACK_ALLOC(resid_block);
4649  /* RESID */ save_resid(rb,match_date);
4650  /* RESID */ /* resid_aim = NULL; */
4651 
4652  clear_copy();
4653  if (TRUE /*arg1->type->evaluate_args 8.9 */)
4654  head=eval_copy(rule->aaaa_2,STACK);
4655  else
4656  head=quote_copy(rule->aaaa_2,STACK);
4657  body=eval_copy(rule->bbbb_2,STACK);
4658  head->status=4;
4659 
4660  if (rule->next)
4661  /* push_choice_point(prove,g,rule->next,NULL); 8.9 */
4663 
4664  push_goal(prove,body,(ptr_psi_term)DEFRULES,NULL);
4665  if (freeze_flag) /* 12.10 */
4666  push_goal(freeze_cut,body,(ptr_psi_term)cutpt,(GENERIC)rb); /* 13.6 */
4667  else
4668  push_goal(implies_cut,body,(ptr_psi_term)cutpt,(GENERIC)rb);
4669  /* RESID */ push_goal(match,arg1,head,(GENERIC)rb);
4670  /* eval_args(head->attr_list); */
4671  }
4672  else {
4673  success=FALSE;
4674  /* resid_aim=NULL; */
4675  }
4676  }
4677  }
4678  else {
4679  success=FALSE;
4680  /* resid_aim=NULL; */
4681  }
4682  resid_aim=NULL;
4683  resid_vars=NULL; /* 22.9 */
4684  }
4685  else {
4686  success=FALSE;
4687  Errorline("goal missing in %P.\n",g);
4688  }
4689 
4690  /* match_date=NULL; */ /* 13.6 */
4691  return success;
4692 }
#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()
clear_copy
Definition: copy.c:53
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_choice_point
Definition: login.c:638
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
ptr_pair_list next
Definition: def_struct.h:191
GENERIC cccc_1
Definition: def_struct.h:226
#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)
get_one_arg
Definition: login.c:99
#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)
quote_copy
Definition: copy.c:186
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)
save_resid
Definition: lefun.c:1398
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)
eval_copy
Definition: copy.c:196
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

c_funct

C_FUNCT Template for C built-in functions.

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

5328 {
5329  long success=TRUE;
5330  ptr_psi_term arg1,arg2,funct;
5331 
5332 
5333  funct=aim->aaaa_1;
5334  deref_ptr(funct);
5335 
5336  get_two_args(funct->attr_list,&arg1,&arg2);
5337 
5338  if (arg1 && arg2) {
5339  deref_args(funct,set_1_2);
5340  }
5341  else
5342  curry();
5343 
5344  return success;
5345 }
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)
get_two_args
Definition: login.c:47
void curry()
curry
Definition: lefun.c:174
#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

c_get

C_GET Read the next character from the current input stream and return its Ascii code. This includes blank characters, so this predicate differs slightly from Edinburgh Prolog's get(X). At end of file, return the psi-term 'end_of_file'.

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

2990 {
2991  long success=TRUE;
2992  ptr_psi_term arg1,arg2,g,t;
2993  long c;
2994 
2995  g=aim->aaaa_1;
2996  deref_ptr(g);
2997  get_two_args(g->attr_list,&arg1,&arg2);
2998  if (arg1) {
2999  deref(arg1);
3000  deref_args(g,set_1);
3001 
3002  if (eof_flag) {
3003  success=FALSE;
3004  }
3005  else {
3006  prompt="";
3007  c=read_char();
3008  t=stack_psi_term(0);
3009  if (c==EOF) {
3010  t->type=eof;
3011  eof_flag=TRUE;
3012  }
3013  else {
3014  t->type=integer;
3015  t->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
3016  * (REAL *)t->value_3 = (REAL) c;
3017  }
3018  }
3019 
3020  if (success) {
3021  push_goal(unify,t,arg1,NULL);
3022  (void)i_check_out(t);
3023  }
3024  }
3025  else {
3026  Errorline("argument missing in %P.\n",g);
3027  success=FALSE;
3028  }
3029 
3030  return success;
3031 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
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)
stack_psi_term
Definition: lefun.c:21
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)
i_check_out
Definition: lefun.c:1033
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
static long c_get_choice ( )
static

c_get_choice

C_GET_CHOICE() Return the current state of the choice point stack (i.e., the time stamp of the current choice point).

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

1816 {
1817  long gts,success=TRUE;
1818  ptr_psi_term funct,result;
1819 
1820  funct=aim->aaaa_1;
1821  deref_ptr(funct);
1822  result=aim->bbbb_1;
1823  deref_args(funct,set_empty);
1824  if (choice_stack)
1825  gts=choice_stack->time_stamp;
1826  else
1827  gts=global_time_stamp-1;
1828  /* gts=INIT_TIME_STAMP; PVR 11.2.94 */
1829  push_goal(unify,result,real_stack_psi_term(4,(REAL)gts),NULL);
1830 
1831  return success;
1832 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
real_stack_psi_term
Definition: lefun.c:48
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#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:28
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

c_global

C_GLOBAL Declare that a symbol is a global variable. Handle multiple arguments and initialization (the initialization term is evaluated). If there is an error anywhere in the declaration, then evaluate and declare nothing.

Definition at line 2562 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().

2563 {
2564  int error=FALSE;
2565  int eval_2=FALSE;
2566  ptr_psi_term g;
2567 
2568  g=aim->aaaa_1;
2569  deref_ptr(g);
2570  if (g->attr_list) {
2571  /* Do error check of all arguments first: */
2572  global_error_check(g->attr_list, &error, &eval_2);
2573  if (eval_2) return !error;
2574  /* If no errors, then make the arguments global: */
2575  if (!error)
2576  global_tree(g->attr_list);
2577  } else {
2578  Errorline("argument(s) missing in %P\n",g);
2579  }
2580 
2581  return !error;
2582 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void global_error_check(ptr_node n, int *error, int *eval_2)
global_error_check
Definition: built_ins.c:2592
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
void global_tree(ptr_node n)
global_tree
Definition: built_ins.c:2632
#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

c_global_assign

C_GLOBAL_ASSIGN() This implements non-backtrackable assignment on global variables.

Closely modelled on 'c_assign', except that pointers to the heap are not copied again onto the heap.

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

4380 {
4381  long success=FALSE;
4382  ptr_psi_term arg1,arg2,g; // ,perm,smallest;
4383  ptr_psi_term new;
4384 
4385  g=aim->aaaa_1;
4386  deref_ptr(g);
4387  get_two_args(g->attr_list,&arg1,&arg2);
4388  if (arg1 && arg2) {
4389  success=TRUE;
4390  deref_rec(arg1);
4391  deref_rec(arg2);
4392  deref_args(g,set_1_2);
4393  if (arg1!=arg2) {
4394 
4395  clear_copy();
4396  new=inc_heap_copy(arg2);
4397 
4398  if((GENERIC)arg1<heap_pointer) {
4399  push_psi_ptr_value(arg1,(GENERIC *)&(arg1->coref));
4400  arg1->coref= new;
4401  }
4402  else {
4403  *arg1= *new; /* Overwrite in-place */
4404  new->coref=arg1;
4405  }
4406  }
4407  }
4408  else
4409  Errorline("argument missing in %P.\n",g);
4410 
4411  return success;
4412 }
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)
get_two_args
Definition: login.c:47
void clear_copy()
clear_copy
Definition: copy.c:53
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
#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)
inc_heap_copy
Definition: copy.c:206
#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

c_gt

C_GT Greater than.

Definition at line 440 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().

441 {
442  long success=TRUE;
443  ptr_psi_term arg1,arg2,arg3,t;
444  long num1,num2,num3;
445  REAL val1,val2,val3;
446 
447  t=aim->aaaa_1;
448  deref_ptr(t);
449  get_two_args(t->attr_list,&arg1,&arg2);
450  arg3=aim->bbbb_1;
451 
452  if (arg1) {
453  deref(arg1);
454  success=get_real_value(arg1,&val1,&num1);
455  if(success && arg2) {
456  deref(arg2);
457  deref_args(t,set_1_2);
458  success=get_real_value(arg2,&val2,&num2);
459  }
460  }
461 
462  if(success)
463  if(arg1 && arg2) {
464  deref(arg3);
465  success=get_bool_value(arg3,&val3,&num3);
466  if(success)
467  switch(num1+num2*2+num3*4) {
468  case 0:
469  residuate2(arg1,arg2);
470  break;
471  case 1:
472  residuate(arg2);
473  break;
474  case 2:
475  residuate(arg1);
476  break;
477  case 3:
478  unify_bool_result(arg3,(val1>val2));
479  break;
480  case 4:
481  residuate2(arg1,arg2);
482  break;
483  case 5:
484  residuate(arg2);
485  break;
486  case 6:
487  residuate(arg1);
488  break;
489  case 7:
490  success=(val3==(REAL)(val1>val2));
491  break;
492  }
493  }
494  else
495  curry();
496 
497  nonnum_warning(t,arg1,arg2);
498  return success;
499 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
curry
Definition: lefun.c:174
#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)
residuate2
Definition: lefun.c:144
#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)
get_bool_value
Definition: built_ins.c:301
ptr_node attr_list
Definition: def_struct.h:171
static long c_gtoe ( )
static

c_gtoe

C_GTOE Greater than or equal.

Definition at line 702 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().

703 {
704  long success=TRUE;
705  ptr_psi_term arg1,arg2,arg3,t;
706  long num1,num2,num3;
707  REAL val1,val2,val3;
708 
709  t=aim->aaaa_1;
710  deref_ptr(t);
711  get_two_args(t->attr_list,&arg1,&arg2);
712  arg3=aim->bbbb_1;
713 
714  if(arg1) {
715  deref(arg1);
716  success=get_real_value(arg1,&val1,&num1);
717  if(success && arg2) {
718  deref(arg2);
719  deref_args(t,set_1_2);
720  success=get_real_value(arg2,&val2,&num2);
721  }
722  }
723 
724  if(success)
725  if(arg1 && arg2) {
726  deref(arg3);
727  success=get_bool_value(arg3,&val3,&num3);
728  if(success)
729  switch(num1+num2*2+num3*4) {
730  case 0:
731  residuate2(arg1,arg2);
732  break;
733  case 1:
734  residuate(arg2);
735  break;
736  case 2:
737  residuate(arg1);
738  break;
739  case 3:
740  unify_bool_result(arg3,(val1>=val2));
741  break;
742  case 4:
743  residuate2(arg1,arg2);
744  break;
745  case 5:
746  residuate(arg2);
747  break;
748  case 6:
749  residuate(arg1);
750  break;
751  case 7:
752  success=(val3==(REAL)(val1>=val2));
753  break;
754  }
755  }
756  else
757  curry();
758 
759  nonnum_warning(t,arg1,arg2);
760  return success;
761 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
curry
Definition: lefun.c:174
#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)
residuate2
Definition: lefun.c:144
#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)
get_bool_value
Definition: built_ins.c:301
ptr_node attr_list
Definition: def_struct.h:171
long c_halt ( )

c_halt

C_HALT Exit the Wild_Life interpreter.

Definition at line 2209 of file built_ins.c.

References exit_life(), and TRUE.

2210 {
2211  exit_life(TRUE);
2212 }
void exit_life(long nl_flag)
exit_life
Definition: built_ins.c:2220
#define TRUE
Definition: def_const.h:127
static long c_implies ( )
static

c_implies

C_IMPLIES() See c_freeze_inner.

Definition at line 4714 of file built_ins.c.

References c_freeze_inner(), and FALSE.

4715 {
4716  return c_freeze_inner(FALSE);
4717 }
static long c_freeze_inner(long freeze_flag)
c_freeze_inner
Definition: built_ins.c:4593
#define FALSE
Definition: def_const.h:128
long c_initrandom ( )

c_initrandom

C_INITRANDOM Uses its integer argument to initialize the random number generator, which is the Unix random() function.

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

6029 {
6030  ptr_psi_term t;
6031  ptr_node n1;
6032  long success=TRUE;
6033  long all_args=TRUE;
6034  // long c_result;
6035  ptr_psi_term arg1;
6036  long c_arg1;
6037 
6038  t=aim->aaaa_1;
6039  deref_ptr(t);
6040 
6041  /* Evaluate all arguments first: */
6042  n1=find(FEATCMP,one,t->attr_list);
6043  if (n1) {
6044  arg1= (ptr_psi_term )n1->data;
6045  deref(arg1);
6046  }
6047  deref_args(t,set_1);
6048 
6049  if (success) {
6050  if (n1) {
6051  if (overlap_type(arg1->type,integer))
6052  if (arg1->value_3)
6053  c_arg1= (long)(* (double *)(arg1->value_3));
6054  else {
6055  residuate(arg1);
6056  all_args=FALSE;
6057  }
6058  else
6059  success=FALSE;
6060  }
6061  else {
6062  all_args=FALSE;
6063  }
6064  }
6065 
6066 #ifdef SOLARIS
6067  if (success && all_args) randomseed=c_arg1;
6068 #else
6069  if (success && all_args) srandom(c_arg1);
6070 #endif
6071 
6072  return success;
6073 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
#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

c_int2string

C_INT2STRING(P) Convert an integer psi-term into a string representing its value.

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

4940 {
4941  char val[STRLEN]; /* Big enough for a _long_ number */
4942  long success=TRUE,i;
4943  ptr_psi_term arg1, /* arg3, */ funct,result,t;
4944  REAL the_int,next,neg;
4945 
4946  funct=aim->aaaa_1;
4947  deref_ptr(funct);
4948  result=aim->bbbb_1;
4949  deref(result);
4950 
4951  get_one_arg(funct->attr_list,&arg1);
4952  if (arg1) {
4953  deref(arg1);
4954  deref_args(funct,set_1);
4955  if (overlap_type(arg1->type,integer)) {
4956  if (arg1->value_3) {
4957  the_int = *(REAL *)arg1->value_3;
4958 
4959  if (the_int!=floor(the_int)) return FALSE;
4960 
4961  neg = (the_int<0.0);
4962  if (neg) the_int = -the_int;
4963  i=STRLEN;
4964  i--;
4965  val[i]=0;
4966  do {
4967  i--;
4968  if (i<=0) {
4969  Errorline("internal buffer too small for int2str(%P).\n",arg1);
4970  return FALSE;
4971  }
4972  next = floor(the_int/10);
4973  val[i]= '0' + (unsigned long) (the_int-next*10);
4974  the_int = next;
4975  } while (the_int);
4976 
4977  if (neg) { i--; val[i]='-'; }
4978  t=stack_psi_term(0);
4979  t->type=quoted_string;
4980  t->value_3=(GENERIC)heap_copy_string(&val[i]);
4981  push_goal(unify,t,result,NULL);
4982  }
4983  else
4984  residuate(arg1);
4985  }
4986  else
4987  success=FALSE;
4988  }
4989  else
4990  curry();
4991 
4992  return success;
4993 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_is_function

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

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

1503 {
1504  long success=TRUE;
1505  ptr_psi_term arg1,result,g,other;
1506 
1507  g=aim->aaaa_1;
1508  deref_ptr(g);
1509  result=aim->bbbb_1;
1510  deref(result);
1511  get_one_arg(g->attr_list,&arg1);
1512  if (arg1) {
1513  deref(arg1);
1514  deref_args(g,set_1);
1515  other=stack_psi_term(4); /* 19.11 */
1517  resid_aim=NULL;
1518  push_goal(unify,result,other,NULL);
1519  }
1520  else {
1521  curry();
1522  /* Errorline("argument missing in %P.\n",t); */
1523  /* return c_abort(); */
1524  }
1525 
1526  return success;
1527 }
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)
push_goal
Definition: login.c:600
def_type type_def
Definition: def_struct.h:133
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_is_predicate

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

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

1538 {
1539  long success=TRUE;
1540  ptr_psi_term arg1,result,g,other;
1541 
1542  g=aim->aaaa_1;
1543  deref_ptr(g);
1544  result=aim->bbbb_1;
1545  deref(result);
1546  get_one_arg(g->attr_list,&arg1);
1547  if (arg1) {
1548  deref(arg1);
1549  deref_args(g,set_1);
1550  other=stack_psi_term(4); /* 19.11 */
1551  other->type=(arg1->type->type_def==(def_type)predicate)?lf_true:lf_false;
1552  resid_aim=NULL;
1553  push_goal(unify,result,other,NULL);
1554  }
1555  else {
1556  curry();
1557  /* Errorline("argument missing in %P.\n",t); */
1558  /* return c_abort(); */
1559  }
1560 
1561  return success;
1562 }
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)
push_goal
Definition: login.c:600
def_type type_def
Definition: def_struct.h:133
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_is_sort

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

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

1572 {
1573  long success=TRUE;
1574  ptr_psi_term arg1,result,g,other;
1575 
1576  g=aim->aaaa_1;
1577  deref_ptr(g);
1578  result=aim->bbbb_1;
1579  deref(result);
1580  get_one_arg(g->attr_list,&arg1);
1581  if (arg1) {
1582  deref(arg1);
1583  deref_args(g,set_1);
1584  other=stack_psi_term(4); /* 19.11 */
1585  other->type=(arg1->type->type_def==(def_type)type_it)?lf_true:lf_false;
1586  resid_aim=NULL;
1587  push_goal(unify,result,other,NULL);
1588  }
1589  else {
1590  curry();
1591  /* Errorline("argument missing in %P.\n",t); */
1592  /* return c_abort(); */
1593  }
1594 
1595  return success;
1596 }
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)
push_goal
Definition: login.c:600
def_type type_def
Definition: def_struct.h:133
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_listing

C_LISTING List the definition of a predicate or a function, and the own constraints of a type (i.e. the non-inherited constraints).

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

5169 {
5170  long success=TRUE;
5171  ptr_psi_term arg1,arg2,g;
5172  def_type fp;
5173  ptr_pair_list r;
5174  ptr_node n;
5175  ptr_psi_term t, t2, *a1, *a2, *a3;
5176  char *s1,*s2;
5177 
5178  g=aim->aaaa_1;
5179  deref_ptr(g);
5180  get_two_args(g->attr_list,&arg1,&arg2);
5181  if (arg1) {
5182  deref_ptr(arg1);
5183  list_special(arg1);
5184  fp=arg1->type->type_def;
5185  r=arg1->type->rule;
5186  if (is_built_in(r) || !has_rules(r)) {
5187 
5188  if (is_built_in(r)) {
5189  s1="built-in ";
5190  s2="";
5191  }
5192  else {
5193  s1="user-defined ";
5194  s2=" with an empty definition";
5195  }
5196  switch ((long)fp) {
5197  case (long)function_it:
5198  fprintf(output_stream,"%% '%s' is a %sfunction%s.\n",
5199  arg1->type->keyword->symbol,s1,s2);
5200  break;
5201  case (long)predicate:
5202  fprintf(output_stream,"%% '%s' is a %spredicate%s.\n",
5203  arg1->type->keyword->symbol,s1,s2);
5204  break;
5205  case (long)type_it:
5206  if (arg1->value_3) {
5207  fprintf(output_stream,"%% ");
5208  if (arg1->type!=quoted_string) fprintf(output_stream,"'");
5209  display_psi_stream(arg1);
5210  if (arg1->type!=quoted_string) fprintf(output_stream,"'");
5211  fprintf(output_stream," is a value of sort '%s'.\n",
5212  arg1->type->keyword->symbol);
5213  }
5214  break;
5215 
5216  case (long)global: /* RM: Feb 9 1993 */
5217  fprintf(output_stream,"%% ");
5218  outputline("'%s' is a %sglobal variable worth %P.\n",
5219  arg1->type->keyword->symbol,
5220  s1,
5221  arg1->type->global_value);
5222  break;
5223 
5224 #ifdef CLIFE
5225  case (long)block: /* AA: Mar 10 1993 */
5226  fprintf(output_stream,"%% '%s' is a %block.\n",
5227  arg1->type->keyword->symbol,"","");
5228 #endif
5229 
5230  default:
5231  fprintf(output_stream,"%% '%s' is undefined.\n", arg1->type->keyword->symbol);
5232  }
5233  }
5234  else {
5235  if (fp==(def_type)type_it || fp==(def_type)function_it || fp==(def_type)predicate) {
5236  n = one_attr();
5237  if (fp==(def_type)function_it)
5238  t = new_psi_term(2, funcsym, &a1, &a2);
5239  else if (fp==(def_type)predicate)
5240  t = new_psi_term(2, predsym, &a1, &a2);
5241  else { /* fp==type */
5242  t = new_psi_term(1, typesym, &a3, &a2); /* a2 is a dummy */
5243  t2 = new_psi_term(2, such_that, &a1, &a2);
5244  }
5245  n->data = (GENERIC) t;
5246  while (r) {
5247  *a1 = r->aaaa_2; /* Func, pred, or type */
5248  *a2 = r->bbbb_2;
5249  if (r->aaaa_2) {
5250  /* Handle an attribute constraint with no predicate: */
5251  if (fp==(def_type)type_it) { if (r->bbbb_2==NULL) *a3 = r->aaaa_2; else *a3 = t2; }
5252  listing_pred_write(n, (fp==(def_type)function_it)||(fp==(def_type)type_it));
5253  fprintf(output_stream,".\n");
5254  }
5255  r = r->next;
5256  }
5257  /* fprintf(output_stream,"\n"); */
5258  /* fflush(output_stream); */
5259  }
5260  else {
5261  success=FALSE;
5262  Errorline("argument of %P must be a predicate, function, or sort.\n",g);
5263  }
5264  }
5265  }
5266  else {
5267  success=FALSE;
5268  Errorline("argument missing in %P.\n",g);
5269  }
5270 
5271  return success;
5272 }
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)
get_two_args
Definition: login.c:47
void listing_pred_write(ptr_node n, long fflag)
Definition: print.c:1341
void list_special(ptr_psi_term t)
list_special
Definition: built_ins.c:5127
#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)
new_psi_term
Definition: built_ins.c:5060
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)
has_rules
Definition: built_ins.c:5097
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)
is_built_in
Definition: built_ins.c:5114
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()
one_attr
Definition: built_ins.c:5038
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

c_load

C_LOAD Load a file. This load accepts and executes any queries in the loaded file, including calls to user-defined predicates and other load predicates.

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

1776 {
1777  long success=FALSE;
1778  ptr_psi_term arg1,arg2,t;
1779  char *fn;
1780  t=aim->aaaa_1;
1781  deref_ptr(t);
1782  get_two_args(t->attr_list,&arg1,&arg2);
1783  if(arg1) {
1784  deref(arg1);
1785  deref_args(t,set_1);
1786  if (psi_to_string(arg1,&fn)) {
1787  success=open_input_file(fn);
1788  if (success) {
1789  file_date+=2;
1791  file_date+=2;
1792  }
1793  }
1794  else {
1795  Errorline("bad file name in %P.\n",t);
1796  success=FALSE;
1797  }
1798  }
1799  else {
1800  Errorline("no file name in %P.\n",t);
1801  success=FALSE;
1802  }
1803 
1804  return success;
1805 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
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)
psi_to_string
Definition: built_ins.c:146
static long c_logical_main ( long  sel)
static

c_logical_main

Parameters
longsel

Main routine to handle the and & or functions. sel = TRUE (for and) or FALSE (for or)

Definition at line 929 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().

930 {
931  long success=TRUE;
932  ptr_psi_term funct,arg1,arg2,arg3;
933  long sm1, sm2, sm3;
934  long a1comp, a2comp, a3comp;
935  long a1, a2, a3;
936 
937  funct=aim->aaaa_1;
938  deref_ptr(funct);
939  get_two_args(funct->attr_list,&arg1,&arg2);
940  if (arg1 && arg2) {
941  deref(arg1);
942  deref(arg2);
943  deref_args(funct,set_1_2);
944  arg3=aim->bbbb_1;
945  deref(arg3);
946 
947  a1comp = matches(arg1->type,boolean,&sm1);
948  a2comp = matches(arg2->type,boolean,&sm2);
949  a3comp = matches(arg3->type,boolean,&sm3);
950  if (a1comp && a2comp && a3comp) {
951  a1 = get_bool(arg1->type);
952  a2 = get_bool(arg2->type);
953  a3 = get_bool(arg3->type);
954  if (a1== !sel || a2== !sel) {
955  unify_bool_result(arg3,!sel);
956  } else if (a1==sel) {
957  /* tmp=stack_psi_term(4); */
958  /* tmp->type=boolean; */
959  /* push_goal(unify,tmp,arg3,NULL); */
960  push_goal(unify,arg2,arg3,(GENERIC)NULL);
961  } else if (a2==sel) {
962  /* tmp=stack_psi_term(4); */
963  /* tmp->type=boolean; */
964  /* push_goal(unify,tmp,arg3,NULL); */
965  push_goal(unify,arg1,arg3,(GENERIC)NULL);
966  } else if (a3==sel) {
967  unify_bool_result(arg1,sel);
968  unify_bool_result(arg2,sel);
969  } else if (arg1==arg2) {
970  /* tmp=stack_psi_term(4); */
971  /* tmp->type=boolean; */
972  /* push_goal(unify,tmp,arg3,NULL); */
973  push_goal(unify,arg1,arg3,(GENERIC)NULL);
974  } else {
975  if (a1==UNDEF) residuate(arg1);
976  if (a2==UNDEF) residuate(arg2);
977  if (a3==UNDEF) residuate(arg3);
978  }
979  if (!sm1) unify_bool(arg1);
980  if (!sm2) unify_bool(arg2);
981  if (!sm3) unify_bool(arg3);
982  }
983  else {
984  success=FALSE;
985  Errorline("Non-boolean argument or result in '%P'.\n",funct);
986  }
987  }
988  else
989  curry();
990 
991  return success;
992 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
static void unify_bool(ptr_psi_term arg)
unify_bool
Definition: built_ins.c:912
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
void curry()
curry
Definition: lefun.c:174
#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)
get_bool
Definition: built_ins.c:899
#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

c_lt C_LT Less than.

Definition at line 634 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().

635 {
636  long success=TRUE;
637  ptr_psi_term arg1,arg2,arg3,t;
638  long num1,num2,num3;
639  REAL val1,val2,val3;
640 
641  t=aim->aaaa_1;
642  deref_ptr(t);
643  get_two_args(t->attr_list,&arg1,&arg2);
644  arg3=aim->bbbb_1;
645 
646  if(arg1) {
647  deref(arg1);
648  success=get_real_value(arg1,&val1,&num1);
649  if(success && arg2) {
650  deref(arg2);
651  deref_args(t,set_1_2);
652  success=get_real_value(arg2,&val2,&num2);
653  }
654  }
655 
656  if(success)
657  if(arg1 && arg2) {
658  deref(arg3);
659  success=get_bool_value(arg3,&val3,&num3);
660  if(success)
661  switch(num1+num2*2+num3*4) {
662  case 0:
663  residuate2(arg1,arg2);
664  break;
665  case 1:
666  residuate(arg2);
667  break;
668  case 2:
669  residuate(arg1);
670  break;
671  case 3:
672  unify_bool_result(arg3,(val1<val2));
673  break;
674  case 4:
675  residuate2(arg1,arg2);
676  break;
677  case 5:
678  residuate(arg2);
679  break;
680  case 6:
681  residuate(arg1);
682  break;
683  case 7:
684  success=(val3==(REAL)(val1<val2));
685  break;
686  }
687  }
688  else
689  curry();
690 
691  nonnum_warning(t,arg1,arg2);
692  return success;
693 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
curry
Definition: lefun.c:174
#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)
residuate2
Definition: lefun.c:144
#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)
get_bool_value
Definition: built_ins.c:301
ptr_node attr_list
Definition: def_struct.h:171
static long c_ltoe ( )
static

c_ltoe

C_LTOE Less than or equal.

Definition at line 770 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().

771 {
772  long success=TRUE;
773  ptr_psi_term arg1,arg2,arg3,t;
774  long num1,num2,num3;
775  REAL val1,val2,val3;
776 
777  t=aim->aaaa_1;
778  deref_ptr(t);
779  get_two_args(t->attr_list,&arg1,&arg2);
780  arg3=aim->bbbb_1;
781 
782  if(arg1) {
783  deref(arg1);
784  success=get_real_value(arg1,&val1,&num1);
785  if(success && arg2) {
786  deref(arg2);
787  deref_args(t,set_1_2);
788  success=get_real_value(arg2,&val2,&num2);
789  }
790  }
791 
792  if(success)
793  if(arg1 && arg2) {
794  deref(arg3);
795  success=get_bool_value(arg3,&val3,&num3);
796  if(success)
797  switch(num1+num2*2+num3*4) {
798  case 0:
799  residuate2(arg1,arg2);
800  break;
801  case 1:
802  residuate(arg2);
803  break;
804  case 2:
805  residuate(arg1);
806  break;
807  case 3:
808  unify_bool_result(arg3,(val1<=val2));
809  break;
810  case 4:
811  residuate2(arg1,arg2);
812  break;
813  case 5:
814  residuate(arg2);
815  break;
816  case 6:
817  residuate(arg1);
818  break;
819  case 7:
820  success=(val3==(REAL)(val1<=val2));
821  break;
822  }
823  }
824  else
825  curry();
826 
827  nonnum_warning(t,arg1,arg2);
828  return success;
829 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
void nonnum_warning(ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
Definition: error.c:796
void curry()
curry
Definition: lefun.c:174
#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)
residuate2
Definition: lefun.c:144
#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)
get_bool_value
Definition: built_ins.c:301
ptr_node attr_list
Definition: def_struct.h:171
static long c_module_name ( )
static

c_module_name

C_MODULE_NAME Return the module in which a term resides.

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

5657 {
5658  long success=TRUE;
5659  ptr_psi_term arg1,arg2,funct,result;
5660 
5661 
5662  funct=aim->aaaa_1;
5663  result=aim->bbbb_1;
5664  deref_ptr(funct);
5665  deref_ptr(result);
5666 
5667  get_two_args(funct->attr_list,&arg1,&arg2);
5668 
5669  if (arg1) {
5670  deref_ptr(arg1);
5671  arg2=stack_psi_term(0);
5672  arg2->type=quoted_string;
5674  push_goal(unify,arg2,result,NULL);
5675  }
5676  else
5677  curry();
5678 
5679  return success;
5680 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
ptr_keyword keyword
Definition: def_struct.h:124
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_non_strict

C_NON_STRICT() Mark that the function or predicate's arguments are not evaluated when the function or predicate is called.

Definition at line 1681 of file built_ins.c.

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

1682 {
1683  ptr_psi_term t=aim->aaaa_1;
1684 
1685  deref_ptr(t);
1686  /* mark_quote(t); 14.9 */
1688  return TRUE;
1689 }
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

c_nonvar

C_NONVAR Return lf_true/false iff argument is not/is '@' (top with no attributes).

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

1469 {
1470  long success=TRUE;
1471  ptr_psi_term arg1,result,g,other;
1472 
1473  g=aim->aaaa_1;
1474  deref_ptr(g);
1475  result=aim->bbbb_1;
1476  deref(result);
1477  get_one_arg(g->attr_list,&arg1);
1478  if (arg1) {
1479  deref(arg1);
1480  deref_args(g,set_1);
1481  other=stack_psi_term(4); /* 19.11 */
1482  other->type=((arg1->type==top)&&(arg1->attr_list==NULL))?lf_false:lf_true;
1483  resid_aim=NULL;
1484  push_goal(unify,result,other,NULL);
1485  }
1486  else {
1487  curry();
1488  /* Errorline("argument missing in %P.\n",t); */
1489  /* return c_abort(); */
1490  }
1491 
1492  return success;
1493 }
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)
push_goal
Definition: login.c:600
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
ptr_definition top
Definition: def_glob.h:106
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_not

C_NOT Logical not. This function does all possible local propagations.

Definition at line 1027 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().

1028 {
1029  long success=TRUE;
1030  ptr_psi_term funct,arg1,arg2;
1031  long sm1, sm2;
1032  long a1comp, a2comp;
1033  long a1, a2;
1034 
1035  funct=aim->aaaa_1;
1036  deref_ptr(funct);
1037  get_one_arg(funct->attr_list,&arg1);
1038  if (arg1) {
1039  deref(arg1);
1040  deref_args(funct,set_1);
1041  arg2=aim->bbbb_1;
1042  deref(arg2);
1043 
1044  a1comp = matches(arg1->type,boolean,&sm1);
1045  a2comp = matches(arg2->type,boolean,&sm2);
1046  if (a1comp && a2comp) {
1047  a1 = get_bool(arg1->type);
1048  a2 = get_bool(arg2->type);
1049  if (a1==TRUE || a1==FALSE) {
1050  unify_bool_result(arg2,!a1);
1051  } else if (a2==TRUE || a2==FALSE) {
1052  unify_bool_result(arg1,!a2);
1053  } else if (arg1==arg2) {
1054  success=FALSE;
1055  } else {
1056  if (a1==UNDEF) residuate(arg1);
1057  if (a2==UNDEF) residuate(arg2);
1058  }
1059  if (!sm1) unify_bool(arg1);
1060  if (!sm2) unify_bool(arg2);
1061  }
1062  else {
1063  success=FALSE;
1064  Errorline("Non-boolean argument or result in '%P'.\n",funct);
1065  }
1066  }
1067  else
1068  curry();
1069 
1070  return success;
1071 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
static void unify_bool(ptr_psi_term arg)
unify_bool
Definition: built_ins.c:912
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)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
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)
get_bool
Definition: built_ins.c:899
#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

c_not_implemented

C_NOT_IMPLEMENTED This function always fails, it is in fact identical to BOTTOM.

Definition at line 2297 of file built_ins.c.

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

2298 {
2299  ptr_psi_term t;
2300 
2301  t=aim->aaaa_1;
2302  deref_ptr(t);
2303  Errorline("built-in %P is not implemented yet.\n",t);
2304  return FALSE;
2305 }
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

c_op

C_OP() Declare an operator.

Definition at line 1698 of file built_ins.c.

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

1699 {
1700  // long declare_operator();
1701  ptr_psi_term t=aim->aaaa_1;
1702 
1703  return declare_operator(t);
1704 }
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)
declare_operator
Definition: built_ins.c:5432
static long c_open_in ( )
static

c_open_in

C_OPEN_IN Create a stream for input from the specified file.

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

2771 {
2772  long success=FALSE;
2773  ptr_psi_term arg1,arg2,g;
2774  char *fn;
2775 
2776  g=aim->aaaa_1;
2777  deref_ptr(g);
2778  get_two_args(g->attr_list,&arg1,&arg2);
2779  if(arg1) {
2780  deref(arg1);
2781  if (psi_to_string(arg1,&fn))
2782  if (arg2) {
2783  deref(arg2);
2784  deref_args(g,set_1_2);
2785  if (is_top(arg2)) {
2786  if (open_input_file(fn)) {
2787  /* push_ptr_value(psi_term_ptr,&(arg2->coref)); 9.6 */
2788  push_psi_ptr_value(arg2,(GENERIC *)&(arg2->coref));
2789  arg2->coref=input_state;
2790  success=TRUE;
2791  }
2792  else
2793  success=FALSE;
2794  }
2795  else
2796  Errorline("bad input stream in %P.\n",g);
2797  }
2798  else
2799  Errorline("no stream in %P.\n",g);
2800  else
2801  Errorline("bad file name in %P.\n",g);
2802  }
2803  else
2804  Errorline("no file name in %P.\n",g);
2805 
2806  return success;
2807 }
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)
get_two_args
Definition: login.c:47
#define is_top(T)
Definition: def_macro.h:108
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
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)
psi_to_string
Definition: built_ins.c:146
static long c_open_out ( )
static

c_open_out

C_OPEN_OUT Create a stream for output from the specified file.

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

2817 {
2818  long success=FALSE;
2819  ptr_psi_term arg1,arg2,arg3,g;
2820  char *fn;
2821 
2822  g=aim->aaaa_1;
2823  deref_ptr(g);
2824  get_two_args(g->attr_list,&arg1,&arg2);
2825  if(arg1) {
2826  deref(arg1);
2827  if (psi_to_string(arg1,&fn))
2828  if (arg2) {
2829  deref(arg2);
2830  deref(g);
2831  if (overlap_type(arg2->type,stream)) /* 10.8 */
2832  if (open_output_file(fn)) {
2833  arg3=stack_psi_term(4);
2834  arg3->type=stream;
2835  arg3->value_3=(GENERIC)output_stream;
2836  /* push_ptr_value(psi_term_ptr,&(arg2->coref)); 9.6 */
2837  push_psi_ptr_value(arg2,(GENERIC *)&(arg2->coref));
2838  arg2->coref=arg3;
2839  success=TRUE;
2840  }
2841  else
2842  success=FALSE;
2843  else
2844  Errorline("bad stream in %P.\n",g);
2845  }
2846  else
2847  Errorline("no stream in %P.\n",g);
2848  else
2849  Errorline("bad file name in %P.\n",g);
2850  }
2851  else
2852  Errorline("no file name in %P.\n",g);
2853 
2854  return success;
2855 }
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)
get_two_args
Definition: login.c:47
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)
push_psi_ptr_value
Definition: login.c:474
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)
stack_psi_term
Definition: lefun.c:21
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)
psi_to_string
Definition: built_ins.c:146
static long c_ops ( )
static

c_ops

C_OPS Return a list of all operators (represented as 3-tuples op(prec,type,atom)). This function has no arguments.

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

3782 {
3783  long success=TRUE;
3784  ptr_psi_term result, g, t;
3785 
3786  g=aim->aaaa_1;
3787  deref_args(g,set_empty);
3788  result=aim->bbbb_1;
3789  t=collect_symbols(op_sel); /* RM: Feb 3 1993 */
3790  push_goal(unify,result,t,NULL);
3791 
3792  return success;
3793 }
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)
push_goal
Definition: login.c:600
#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)
collect_symbols
Definition: built_ins.c:3696
ptr_psi_term bbbb_1
Definition: def_struct.h:225
static long c_or ( )
static

c_or

C_OR Logical and & or. These functions do all possible local propagations.

Definition at line 1014 of file built_ins.c.

References c_logical_main(), and FALSE.

1015 {
1016  return c_logical_main(FALSE);
1017 }
static long c_logical_main(long sel)
c_logical_main
Definition: built_ins.c:929
#define FALSE
Definition: def_const.h:128
static long c_page_width ( )
static

c_page_width

static long c_page_width() C_PAGE_WIDTH Set the page width.

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

3269 {
3270  long success=FALSE;
3271  ptr_psi_term arg1,arg2,g;
3272  long pw;
3273 
3274  g=aim->aaaa_1;
3275  deref_ptr(g);
3276  get_two_args(g->attr_list,&arg1,&arg2);
3277  if(arg1) {
3278  deref(arg1);
3279  deref_args(g,set_1);
3280  if (equal_types(arg1->type,integer) && arg1->value_3) {
3281  pw = *(REAL *)arg1->value_3;
3282  if (pw>0)
3283  page_width=pw;
3284  else
3285  Errorline("argument in %P must be positive.\n",g);
3286  success=TRUE;
3287  }
3288  else if (sub_type(integer,arg1->type)) {
3290  success=TRUE;
3291  }
3292  else
3293  Errorline("bad argument in %P.\n",g);
3294  }
3295  else
3296  Errorline("argument missing in %P.\n",g);
3297 
3298  return success;
3299 }
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)
get_two_args
Definition: login.c:47
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
real_stack_psi_term
Definition: lefun.c:48
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#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

c_parse

C_PARSE Parse a string and return a quoted psi-term. The global variable names are recognized (see the built-in print_variables). All variables in the parsed string are added to the set of global variables.

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

2014 {
2015  long success=TRUE;
2016  ptr_psi_term arg1,arg2,arg3,funct,result;
2017  long smaller,sort,old_var_occurred;
2018  ptr_node n;
2019  parse_block pb;
2020 
2021  funct=aim->aaaa_1;
2022  deref_ptr(funct);
2023  result=aim->bbbb_1;
2024  get_one_arg(funct->attr_list,&arg1);
2025  if (arg1) {
2026  deref(arg1);
2027  deref_args(funct,set_1);
2028  success=matches(arg1->type,quoted_string,&smaller);
2029  if (success) {
2030  if (arg1->value_3) {
2031  ptr_psi_term t;
2032 
2033  /* Parse the string in its own state */
2034  save_parse_state(&pb);
2035  init_parse_state();
2036  stringparse=TRUE;
2037  stringinput=(char*)arg1->value_3;
2038 
2039  old_var_occurred=var_occurred;
2041  t=stack_copy_psi_term(parse(&sort));
2042 
2043  /* Optional second argument returns 'query', 'declaration', or 'error'. */
2044  n=find(FEATCMP,two,funct->attr_list);
2045  if (n) {
2046  ptr_psi_term queryflag;
2047  arg2=(ptr_psi_term)n->data;
2048  queryflag=stack_psi_term(4);
2049  queryflag->type=
2051  ((sort==QUERY)?"query":((sort==FACT)?"declaration":"error"))
2052  );
2053  push_goal(unify,queryflag,arg2,NULL);
2054  }
2055 
2056  /* Optional third argument returns true or false if the psi-term
2057  contains a variable or not. */
2058  n=find(FEATCMP,three,funct->attr_list);
2059  if (n) {
2060  ptr_psi_term varflag;
2061  arg3=(ptr_psi_term)n->data;
2062  varflag=stack_psi_term(4);
2063  varflag->type=var_occurred?lf_true:lf_false;
2064  push_goal(unify,varflag,arg3,NULL);
2065  }
2066 
2067  var_occurred = var_occurred || old_var_occurred;
2069  restore_parse_state(&pb);
2070 
2071  /* parse_ok flag says whether there was a syntax error. */
2072  if (TRUE /*parse_ok*/) {
2073  mark_quote(t);
2074  push_goal(unify,t,result,NULL);
2075  }
2076  else
2077  success=FALSE;
2078  }
2079  else
2080  residuate(arg1);
2081  }
2082  else
2083  success=FALSE;
2084  }
2085  else
2086  curry();
2087 
2088  return success;
2089 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
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)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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)
mark_quote
Definition: copy.c:675
#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

c_persistent

C_PERSISTENT Declare that a symbol is a persistent variable.

Definition at line 2687 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().

2688 {
2689  int error=FALSE;
2690  ptr_psi_term g;
2691 
2692  g=aim->aaaa_1;
2693  deref_ptr(g);
2694  if (g->attr_list) {
2695  /* Do error check of all arguments first: */
2696  persistent_error_check(g->attr_list, &error);
2697  /* If no errors, then make the arguments persistent: */
2698  if (!error)
2700  } else {
2701  Errorline("argument(s) missing in %P\n",g);
2702  }
2703 
2704  return !error;
2705 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void persistent_error_check(ptr_node n, int *error)
persistent_error_check
Definition: built_ins.c:2712
void persistent_tree(ptr_node n)
persistent_tree
Definition: built_ins.c:2737
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

c_pred

C_PRED Template for C built-in predicates.

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

5302 {
5303  long success=TRUE;
5304  ptr_psi_term arg1,arg2,g;
5305 
5306  g=aim->aaaa_1;
5307  deref_ptr(g);
5308  get_two_args(g->attr_list,&arg1,&arg2);
5309  if (arg1 && arg2) {
5310  deref_args(g,set_1_2);
5311  }
5312  else {
5313  success=FALSE;
5314  Errorline("argument(s) missing in %P.\n",g);
5315  }
5316 
5317  return success;
5318 }
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)
get_two_args
Definition: login.c:47
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

c_print_codes

C_print_codes Print the codes of all the sorts.

Definition at line 5281 of file built_ins.c.

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

5282 {
5283  ptr_psi_term t;
5284 
5285  t=aim->aaaa_1;
5286  deref_args(t,set_empty);
5287  outputline("There are %d sorts.\n",type_count);
5288  print_codes();
5289  return TRUE;
5290 }
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

c_print_depth

static long c_print_depth() C_PRINT_DEPTH Set the depth limit of printing.

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

3309 {
3310  long success=FALSE;
3311  ptr_psi_term arg1,arg2,g;
3312  long dl;
3313 
3314  g=aim->aaaa_1;
3315  deref_ptr(g);
3316  get_two_args(g->attr_list,&arg1,&arg2);
3317  if (arg1) {
3318  deref(arg1);
3319  deref_args(g,set_1);
3320  if (equal_types(arg1->type,integer) && arg1->value_3) {
3321  dl = *(REAL *)arg1->value_3;
3322  if (dl>=0)
3323  print_depth=dl;
3324  else
3325  Errorline("argument in %P must be positive or zero.\n",g);
3326  success=TRUE;
3327  }
3328  else if (sub_type(integer,arg1->type)) {
3330  success=TRUE;
3331  }
3332  else
3333  Errorline("bad argument in %P.\n",g);
3334  }
3335  else {
3336  /* No arguments: reset print depth to default value */
3338  success=TRUE;
3339  }
3340 
3341  return success;
3342 }
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)
get_two_args
Definition: login.c:47
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
real_stack_psi_term
Definition: lefun.c:48
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#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

c_print_variables

C_PRINT_VARIABLES Print the global variables and their values, in the same way as is done in the user interface.

Definition at line 1968 of file built_ins.c.

References print_variables(), and TRUE.

1969 {
1970  long success=TRUE;
1971 
1972  (void)print_variables(TRUE); /* 21.1 */
1973 
1974  return success;
1975 }
#define TRUE
Definition: def_const.h:127
long print_variables(long printflag)
Definition: print.c:1272
static long c_project ( )
static

c_project

C_PROJECT RM: Jan 7 1993 Here we evaluate "project(Psi-term,Label)". This returns the psi-term associated to label Label in Psi-term. It is identical to C_PROJECT except that the order of the arguments is inversed.

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

1210 {
1211  long success=TRUE;
1212  ptr_psi_term arg1,arg2,funct,result;
1213  ptr_node n;
1214  char *label;
1215  double v;
1216 
1217  /* char *thebuffer="integer"; 18.5 */
1218  char thebuffer[20]; /* Maximum number of digits in an integer */
1219 
1220  funct=aim->aaaa_1;
1221  deref_ptr(funct);
1222  result=aim->bbbb_1;
1223  get_two_args(funct->attr_list,&arg1,&arg2);
1224  if (arg2 && arg1) {
1225  deref(arg1);
1226  deref(arg2);
1227  deref_args(funct,set_1_2);
1228 
1229  label=NULL;
1230 
1231  /* RM: Jul 20 1993: Don't residuate on 'string' etc... */
1232  if(arg2->type!=top) {
1233  if(arg2->value_3 && sub_type(arg2->type,quoted_string)) /* 10.8 */
1234  label=(char *)arg2->value_3;
1235  else
1236  if(arg2->value_3 && sub_type(arg2->type,integer)) { /* 10.8 */
1237  v= *(REAL *)arg2->value_3;
1238  if(v==floor(v)) {
1239  (void)snprintf(thebuffer,20,"%ld",(long)v);
1240  label=heap_copy_string(thebuffer); /* A little voracious */
1241  }
1242  else { /* RM: Jul 28 1993 */
1243  Errorline("non-integer numeric feature in %P\n",funct);
1244  return FALSE;
1245  }
1246  }
1247  else {
1248  if(arg2->type->keyword->private_feature) /* RM: Mar 12 1993 */
1249  label=arg2->type->keyword->combined_name;
1250  else
1251  label=arg2->type->keyword->symbol;
1252  }
1253  }
1254 
1255  if (label) {
1256  n=find(FEATCMP,(char *)label,arg1->attr_list);
1257 
1258  if (n)
1260  else if (arg1->type->type_def==(def_type)function_it && !(arg1->flags&QUOTED_TRUE)) {
1261  Errorline("attempt to add a feature to curried function %P\n",
1262  arg1);
1263  return FALSE;
1264  }
1265  else {
1266  deref_ptr(result);
1267  if((GENERIC)arg1>=heap_pointer) { /* RM: Feb 9 1993 */
1268  if((GENERIC)result<heap_pointer)
1269  push_psi_ptr_value(result,(GENERIC *)&(result->coref));
1270  clear_copy();
1271  result->coref=inc_heap_copy(result);
1272  (void)heap_insert(FEATCMP,label,&(arg1->attr_list),(GENERIC)result->coref);
1273  }
1274  else {
1275 
1276 #ifdef ARITY /* RM: Mar 29 1993 */
1277  arity_add(arg1,label);
1278 #endif
1279 
1280  /* RM: Mar 25 1993 */
1281  if(arg1->type->always_check || arg1->attr_list)
1282  (void)bk_stack_insert(FEATCMP,label,&(arg1->attr_list),(GENERIC)result);
1283  else {
1284  (void)bk_stack_insert(FEATCMP,label,&(arg1->attr_list),(GENERIC)result);
1285  fetch_def_lazy(arg1, arg1->type,arg1->type,NULL,NULL,0,0); // djd added zeros
1286  }
1287 
1288  if (arg1->resid)
1289  release_resid(arg1);
1290  }
1291  }
1292  }
1293  else
1294  residuate(arg2);
1295  }
1296  else
1297  curry();
1298 
1299  return success;
1300 }
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)
get_two_args
Definition: login.c:47
#define FEATCMP
Definition: def_const.h:257
void clear_copy()
clear_copy
Definition: copy.c:53
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
char * combined_name
Definition: def_struct.h:92
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
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)
push_psi_ptr_value
Definition: login.c:474
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()
curry
Definition: lefun.c:174
#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)
release_resid
Definition: lefun.c:445
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)
fetch_def_lazy
Definition: login.c:1276
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)
inc_heap_copy
Definition: copy.c:206
#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

c_psi2string

C_PSI2STRING(P) Convert a psi-term's name into a string with the name as value.

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

4895 {
4896  long success=TRUE;
4897  ptr_psi_term arg1, /* arg3, */ funct,result,t;
4898  char buf[100]; /* RM: Mar 10 1993 */
4899 
4900  funct=aim->aaaa_1;
4901  deref_ptr(funct);
4902  result=aim->bbbb_1;
4903  deref(result);
4904 
4905  get_one_arg(funct->attr_list,&arg1);
4906  if (arg1) {
4907  deref(arg1);
4908  deref_args(funct,set_1);
4909  t=stack_psi_term(0);
4910  t->type=quoted_string;
4911 
4912  /* RM: Mar 10 1993 */
4913  if(arg1->value_3 && sub_type(arg1->type,real)) {
4914  (void)snprintf(buf,100,"%g", *((double *)(arg1->value_3)));
4915  t->value_3=(GENERIC)heap_copy_string(buf);
4916  }
4917  else
4918  if(arg1->value_3 && sub_type(arg1->type,quoted_string)) {
4919  t->value_3=(GENERIC)heap_copy_string((char *)arg1->value_3);
4920  }
4921  else
4923 
4924  push_goal(unify,t,result,NULL);
4925  }
4926  else
4927  curry();
4928 
4929  return success;
4930 }
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)
push_goal
Definition: login.c:600
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
ptr_keyword keyword
Definition: def_struct.h:124
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_put

C_PUT Write the root of a psi-term to the current output stream. This routine accepts the string type (which is written without quotes), a number type (whose integer part is considered an Ascii code if it is in the range 0..255), and any other psi-term (in which case its name is written).

Definition at line 3046 of file built_ins.c.

References c_put_main(), and FALSE.

3047 {
3048  return c_put_main(FALSE);
3049 }
static long c_put_main(long)
c_put_main
Definition: built_ins.c:3073
#define FALSE
Definition: def_const.h:128
static long c_put_err ( )
static

c_put_err

C_PUT_ERR Write the root of a psi-term to stderr. This routine accepts the string type (which is written without quotes), a number type (whose integer part is considered an Ascii code if it is in the range 0..255), and any other psi-term (in which case its name is written).

Definition at line 3062 of file built_ins.c.

References c_put_main(), and TRUE.

3063 {
3064  return c_put_main(TRUE);
3065 }
static long c_put_main(long)
c_put_main
Definition: built_ins.c:3073
#define TRUE
Definition: def_const.h:127
static long c_put_main ( long  to_stderr)
static

c_put_main

Parameters
longto_stderr if TRUE stderr otherwise current output

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

3074 {
3075  long i,success=FALSE;
3076  ptr_psi_term arg1,arg2,g;
3077  char tstr[2], *str=tstr;
3078 
3079  g=aim->aaaa_1;
3080  deref_ptr(g);
3081  get_two_args(g->attr_list,&arg1,&arg2);
3082  if (arg1) {
3083  deref(arg1);
3084  deref_args(g,set_1);
3085  if ((equal_types(arg1->type,integer) || equal_types(arg1->type,real))
3086  && arg1->value_3) {
3087  i = (unsigned long) floor(*(REAL *) arg1->value_3);
3088  if (i==(unsigned long)(unsigned char)i) {
3089  str[0] = i; str[1] = 0;
3090  success=TRUE;
3091  }
3092  else {
3093  Errorline("out-of-range character value in %P.\n",g);
3094  }
3095  }
3096  else if (psi_to_string(arg1,&str)) {
3097  success=TRUE;
3098  }
3099  if (success)
3100  fprintf((to_stderr?stderr:output_stream),"%s",str);
3101  }
3102  else
3103  Errorline("argument missing in %P.\n",g);
3104 
3105  return success;
3106 }
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)
get_two_args
Definition: login.c:47
#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)
psi_to_string
Definition: built_ins.c:146
static long c_pwrite ( )
static

c_pwrite

C_PRETTY_WRITE The same as write, only indenting if output is wider than PAGEWIDTH.

Definition at line 3232 of file built_ins.c.

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

3233 {
3234  indent=TRUE;
3240  return generic_write();
3241 }
static long generic_write()
generic_write
Definition: built_ins.c:3115
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

c_pwriteq

C_PRETTY_WRITEQ The same as writeq, only indenting if output is wider than PAGEWIDTH.

Definition at line 3250 of file built_ins.c.

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

3251 {
3252  indent=TRUE;
3253  const_quote=TRUE;
3258  return generic_write();
3259 }
static long generic_write()
generic_write
Definition: built_ins.c:3115
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

c_quote

C_QUOTE Quote an expression, i.e. do not evaluate it but mark it as completely evaluated. This works if the function is declared as non_strict.

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

4006 {
4007  long success=TRUE;
4008  ptr_psi_term arg1,arg2,funct,result;
4009 
4010  funct = aim->aaaa_1;
4011  deref_ptr(funct);
4012  result = aim->bbbb_1;
4013  deref(result);
4014  get_two_args(funct->attr_list, &arg1, &arg2);
4015  if (arg1) {
4016  push_goal(unify,arg1,result,NULL);
4017  } else
4018  curry();
4019 
4020  return success;
4021 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void curry()
curry
Definition: lefun.c:174
#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 ( )

c_random

C_RANDOM Return an integer random number between 0 and abs(argument1). Uses the Unix random() function (rand_r(&seed) for Solaris).

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

5963 {
5964  ptr_psi_term result,funct;
5965  ptr_node n1;
5966  long success=TRUE;
5967  long all_args=TRUE;
5968  long c_result;
5969  ptr_psi_term arg1;
5970  long c_arg1;
5971 
5972  funct=aim->aaaa_1;
5973  deref_ptr(funct);
5974  result=aim->bbbb_1;
5975 
5976  /* Evaluate all arguments first: */
5977  n1=find(FEATCMP,one,funct->attr_list);
5978  if (n1) {
5979  arg1= (ptr_psi_term )n1->data;
5980  deref(arg1);
5981  }
5982  deref_args(funct,set_1);
5983 
5984  if (success) {
5985  if (n1) {
5986  if (overlap_type(arg1->type,integer))
5987  if (arg1->value_3)
5988  c_arg1= (long)(* (double *)(arg1->value_3));
5989  else {
5990  residuate(arg1);
5991  all_args=FALSE;
5992  }
5993  else
5994  success=FALSE;
5995  }
5996  else {
5997  all_args=FALSE;
5998  curry();
5999  }
6000  }
6001 
6002  if (success && all_args) {
6003  if (c_arg1) {
6004 #ifdef SOLARIS
6005  c_result=(rand_r(&randomseed)<<15) + rand_r(&randomseed);
6006 #else
6007  c_result=random();
6008 #endif
6009  c_result=c_result-(c_result/c_arg1)*c_arg1;
6010  }
6011  else
6012  c_result=0;
6013 
6014  push_goal(unify,real_stack_psi_term(0,(REAL)c_result),result,NULL);
6015  }
6016 
6017  return success;
6018 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
real_stack_psi_term
Definition: lefun.c:48
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
void curry()
curry
Definition: lefun.c:174
#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

c_read

Parameters
longpsi_flag

C_READ Read a psi_term or a token from the current input stream. The variables in the object read are not added to the set of global variables.

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

2124 {
2125  long success=TRUE;
2126  long sort;
2127  ptr_psi_term arg1,arg2,arg3,g,t;
2128  ptr_node old_var_tree;
2129  ptr_node n;
2130  int line=line_count+1;
2131 
2132  g=aim->aaaa_1;
2133  deref_ptr(g);
2134  get_one_arg(g->attr_list,&arg1);
2135  if (arg1) {
2136  deref_args(g,set_1);
2137  if (eof_flag) {
2138  Errorline("attempt to read past end of file (%E).\n");
2139  return (abort_life(TRUE));
2140  }
2141  else {
2142  prompt="";
2143  old_var_tree=var_tree;
2144  var_tree=NULL;
2145  if (psi_flag) {
2146 
2147  t=stack_copy_psi_term(parse(&sort));
2148 
2149 
2150  /* Optional second argument returns 'query', 'declaration', or
2151  'error'. */
2152  n=find(FEATCMP,two,g->attr_list); /* RM: Jun 8 1993 */
2153  if (n) {
2154  ptr_psi_term queryflag;
2155  arg2=(ptr_psi_term)n->data;
2156  queryflag=stack_psi_term(4);
2157  queryflag->type=
2159  ((sort==QUERY)?"query":((sort==FACT)?"declaration":"error"))
2160  );
2161  push_goal(unify,queryflag,arg2,NULL);
2162  }
2163 
2164 
2165  /* Optional third argument returns the starting line number */
2166  /* RM: Oct 11 1993 */
2167  n=find(FEATCMP,three,g->attr_list);
2168  if (n) {
2169  arg3=(ptr_psi_term)n->data;
2170  g=stack_psi_term(4);
2171  g->type=integer;
2172  g->value_3=heap_alloc(sizeof(REAL));
2173  *(REAL *)g->value_3=line;
2174  push_goal(unify,g,arg3,NULL);
2175  }
2176 
2177  }
2178  else {
2179  t=stack_psi_term(0);
2180  read_token_b(t);
2181  /* RM: Jan 5 1993 removed spurious argument: &quot (??) */
2182 
2183  }
2184  if (t->type==eof) eof_flag=TRUE;
2185  var_tree=old_var_tree;
2186  }
2187 
2188  if (success) {
2189  mark_quote(t);
2190  push_goal(unify,t,arg1,NULL);
2191  /* i_check_out(t); */
2192  }
2193  }
2194  else {
2195  Errorline("argument missing in %P.\n",g);
2196  success=FALSE;
2197  }
2198 
2199  return success;
2200 }
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)
push_goal
Definition: login.c:600
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)
get_one_arg
Definition: login.c:99
#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)
abort_life
Definition: built_ins.c:2260
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)
stack_psi_term
Definition: lefun.c:21
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
void mark_quote(ptr_psi_term t)
mark_quote
Definition: copy.c:675
#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)
heap_alloc
Definition: memory.c:1616
static long c_read_psi ( )
static

c_read_psi

Definition at line 2098 of file built_ins.c.

References c_read(), and TRUE.

2099 {
2100  return (c_read(TRUE));
2101 }
static long c_read(long)
c_read
Definition: built_ins.c:2123
#define TRUE
Definition: def_const.h:127
static long c_read_token ( )
static

c_read_token

Definition at line 2108 of file built_ins.c.

References c_read(), and FALSE.

2109 {
2110  return (c_read(FALSE));
2111 }
static long c_read(long)
c_read
Definition: built_ins.c:2123
#define FALSE
Definition: def_const.h:128
static long c_repeat ( )
static

c_repeat

C_REPEAT Succeed indefinitely on backtracking.

Definition at line 1417 of file built_ins.c.

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

1418 {
1419  ptr_psi_term t;
1420 
1421  t=aim->aaaa_1;
1422  deref_args(t,set_empty);
1424  return TRUE;
1425 }
#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)
push_choice_point
Definition: login.c:638
#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

c_retract

C_RETRACT Retract the first clause that unifies with the argument. Use PRED_CLAUSE to perform the search.

Definition at line 2539 of file built_ins.c.

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

2540 {
2541  long success=FALSE;
2542  ptr_psi_term arg1,arg2,g;
2543 
2544  g=aim->aaaa_1;
2545  get_two_args(g->attr_list,&arg1,&arg2);
2546  success=pred_clause(arg1,1,g);
2547 
2548  return success;
2549 }
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)
get_two_args
Definition: login.c:47
long pred_clause(ptr_psi_term t, long r, ptr_psi_term g)
pred_clause
Definition: built_ins.c:2452
#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

c_rootsort

C_ROOTSORT Return the principal sort of the argument == create a copy with the attributes detached.

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

3353 {
3354  long success=TRUE;
3355  ptr_psi_term arg1,arg2,arg3,g,other;
3356 
3357  g=aim->aaaa_1;
3358  deref_ptr(g);
3359  arg3=aim->bbbb_1;
3360  deref(arg3);
3361  get_two_args(g->attr_list,&arg1,&arg2);
3362  if(arg1) {
3363  deref(arg1);
3364  deref_args(g,set_1);
3365  other=stack_psi_term(4); /* 19.11 */
3366  other->type=arg1->type;
3367  other->value_3=arg1->value_3;
3368  resid_aim=NULL;
3369  push_goal(unify,arg3,other,NULL);
3370  }
3371  else
3372  curry();
3373 
3374  return success;
3375 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_same_address

C_SAME_ADDRESS Return TRUE if two arguments share the same address.

Definition at line 3853 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().

3854 {
3855  long success=TRUE;
3856  ptr_psi_term arg1,arg2,funct,result;
3857  REAL val3;
3858  long num3;
3859 
3860  funct=aim->aaaa_1;
3861  deref_ptr(funct);
3862  result=aim->bbbb_1;
3863  get_two_args(funct->attr_list,&arg1,&arg2);
3864 
3865  if (arg1 && arg2) {
3866  success=get_bool_value(result,&val3,&num3);
3867  resid_aim=NULL;
3868  deref(arg1);
3869  deref(arg2);
3870  deref_args(funct,set_1_2);
3871 
3872  if (num3) {
3873  if (val3)
3874  push_goal(unify,arg1,arg2,NULL);
3875  else
3876  success=(arg1!=arg2);
3877  }
3878  else
3879  if (arg1==arg2)
3880  unify_bool_result(result,TRUE);
3881  else
3882  unify_bool_result(result,FALSE);
3883  }
3884  else
3885  curry();
3886 
3887  return success;
3888 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
void curry()
curry
Definition: lefun.c:174
#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)
get_bool_value
Definition: built_ins.c:301
ptr_node attr_list
Definition: def_struct.h:171
static long c_set_choice ( )
static

c_set_choice

C_SET_CHOICE() Set the choice point stack to a state no later than (i.e. the same or earlier than) the state of the first argument (i.e., remove all choice points up to the first one whose time stamp is =< the first argument). This predicate will remove zero or more choice points, never add them. The first argument must come from a past call to get_choice. Together, get_choice and set_choice allow one to implement an "ancestor cut" that removes all choice points created between the current execution point and an execution point arbitarily remote in the past. The built-ins get_choice, set_choice, and exists_choice are implemented using the timestamping mechanism in the interpreter. The two relevant properties of the timestamping mechanism are that each choice point is identified by an integer and that the integers are in increasing order (but not necessarily consecutive) from the bottom to the top of the choice point stack.

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

1855 {
1856  REAL gts_r;
1857  long gts;
1858  long num,success=TRUE;
1859  ptr_psi_term t,arg1;
1860  ptr_choice_point cutpt;
1861 
1862  t=aim->aaaa_1;
1863  deref_ptr(t);
1864  get_one_arg(t->attr_list,&arg1);
1865  if (arg1) {
1866  deref(arg1);
1867  deref_args(t,set_1);
1868  success = get_real_value(arg1,&gts_r,&num);
1869  if (success) {
1870  if (num) {
1871  gts=(unsigned long)gts_r;
1872  if (choice_stack) {
1873  cutpt=choice_stack;
1874  while (cutpt && cutpt->time_stamp>gts) cutpt=cutpt->next;
1875  if (choice_stack!=cutpt) {
1876  choice_stack=cutpt;
1877 #ifdef CLEAN_TRAIL
1879 #endif
1880  }
1881  }
1882  }
1883  else {
1884  Errorline("bad argument to %P.\n",t);
1885  success=FALSE;
1886  }
1887  }
1888  else {
1889  Errorline("bad argument %P.\n",t);
1890  success=FALSE;
1891  }
1892  }
1893  else
1894  curry();
1895 
1896  return success;
1897 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
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)
clean_trail
Definition: login.c:810
#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

c_set_input

C_SET_INPUT Set the current input stream to a given stream. If the given stream is closed, then do nothing.

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

2866 {
2867  long success=FALSE;
2868  ptr_psi_term arg1,arg2,g;
2869  FILE *thestream;
2870 
2871  g=aim->aaaa_1;
2872  deref_ptr(g);
2873  get_two_args(g->attr_list,&arg1,&arg2);
2874  if (arg1) {
2875  deref(arg1);
2876  deref_args(g,set_1);
2877  if (equal_types(arg1->type,inputfilesym)) {
2878  success=TRUE;
2880  thestream=get_stream(arg1);
2881  if (thestream!=NULL) {
2882  input_state=arg1;
2884  }
2885  }
2886  else
2887  Errorline("bad stream in %P.\n",g);
2888  }
2889  else
2890  Errorline("no stream in %P.\n",g);
2891 
2892  return success;
2893 }
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)
get_two_args
Definition: login.c:47
#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

c_set_output

C_SET_OUTPUT Set the current output stream.

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

2903 {
2904  long success=FALSE;
2905  ptr_psi_term arg1,arg2,g;
2906 
2907  g=aim->aaaa_1;
2908  deref_ptr(g);
2909  get_two_args(g->attr_list,&arg1,&arg2);
2910  if(arg1) {
2911  deref(arg1);
2912  deref_args(g,set_1);
2913  if(equal_types(arg1->type,stream) && arg1->value_3) {
2914  success=TRUE;
2915  output_stream=(FILE *)arg1->value_3;
2916  }
2917  else
2918  Errorline("bad stream in %P.\n",g);
2919  }
2920  else
2921  Errorline("no stream in %P.\n",g);
2922 
2923  return success;
2924 }
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)
get_two_args
Definition: login.c:47
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

c_setq

C_SETQ

Create a function with one rule F -> X, where F and X are the arguments of setq. Setq evaluates its first argument and quotes the first. away any previous definition of F. F must be undefined or a function, there is an error if F is a sort or a predicate. This gives an error for a static function, but none for an undefined (i.e. uninterpreted) psi-term, which is made dynamic.

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

2338 {
2339  long success=FALSE;
2340  ptr_psi_term arg1,arg2,g;
2341  ptr_pair_list p;
2342  ptr_definition d;
2343 
2344  g=aim->aaaa_1;
2345  get_two_args(g->attr_list,&arg1,&arg2);
2346  if (arg1 && arg2) {
2347  deref_rec(arg2); /* RM: Jan 6 1993 */
2348  deref_ptr(arg1);
2349  d=arg1->type;
2350  if (d->type_def==(def_type)function_it || d->type_def==(def_type)undef) {
2351  if (d->type_def==(def_type)undef || !d->protected) {
2352  if (!arg1->attr_list) {
2354  d->protected=FALSE;
2355  p=HEAP_ALLOC(pair_list);
2356  p->aaaa_2=heap_psi_term(4);
2357  p->aaaa_2->type=d;
2358  clear_copy();
2359  p->bbbb_2=quote_copy(arg2,HEAP);
2360  p->next=NULL;
2361  d->rule=p;
2362  success=TRUE;
2363  }
2364  else
2365  Errorline("%P may not have arguments in %P.\n",arg1,g);
2366  }
2367  else
2368  Errorline("%P should be dynamic in %P.\n",arg1,g);
2369  }
2370  else
2371  Errorline("%P should be a function or uninterpreted in %P.\n",arg1,g);
2372  }
2373  else
2374  Errorline("%P is missing one or both arguments.\n",g);
2375 
2376  return success;
2377 }
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)
get_two_args
Definition: login.c:47
#define HEAP
Definition: def_const.h:147
void clear_copy()
clear_copy
Definition: copy.c:53
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)
heap_psi_term
Definition: lefun.c:75
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)
quote_copy
Definition: copy.c:186
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

c_split_double

C_SPLIT_DOUBLE Split a double into two 32-bit words.

Definition at line 4030 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().

4031 {
4032  long success=FALSE;
4033  ptr_psi_term arg1,arg2,funct,result;
4034  long n;
4035  union {
4036  double d;
4037  struct {
4038  int hi;
4039  int lo;
4040  } w2;
4041  }hack;
4042  double hi,lo;
4043  long n1,n2;
4044 
4045  funct = aim->aaaa_1;
4046  deref_ptr(funct);
4047  result=aim->bbbb_1;
4048 
4049  get_two_args(funct->attr_list, &arg1, &arg2);
4050  if(arg1 && arg2) {
4051  deref_ptr(arg1);
4052  deref_ptr(arg2);
4053  deref_ptr(result);
4054  if(get_real_value(result,(REAL *)&(hack.d),&n) &&
4055  get_real_value(arg1 ,(REAL *)&hi ,&n1) &&
4056  get_real_value(arg2 ,(REAL *)&lo ,&n2)) {
4057 
4058 
4059  if(n) {
4060 
4061  (void)unify_real_result(arg1,(REAL)hack.w2.hi);
4062  (void)unify_real_result(arg2,(REAL)hack.w2.lo);
4063  success=TRUE;
4064  }
4065  else
4066  if(n1 && n2) {
4067 
4068  hack.w2.hi=(int)hi;
4069  hack.w2.lo=(int)lo;
4070  (void)unify_real_result(result,hack.d);
4071  success=TRUE;
4072  }
4073  else {
4074 
4075  residuate(result);
4076  residuate2(arg1,arg2);
4077  }
4078  }
4079  else
4080  Errorline("non-numeric arguments in %P\n",funct);
4081  }
4082  else
4083  curry();
4084 
4085  return success;
4086 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
void curry()
curry
Definition: lefun.c:174
#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)
residuate2
Definition: lefun.c:144
#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)
unify_real_result
Definition: built_ins.c:387
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
static long c_static ( )
static

c_static

C_STATIC() Mark all the arguments as 'protected', i.e. they may not be changed by assert/retract/redefinition.

Definition at line 1643 of file built_ins.c.

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

1644 {
1645  ptr_psi_term t=aim->aaaa_1;
1646  deref_ptr(t);
1647  /* mark_quote(t); 14.9 */
1649  return TRUE;
1650 }
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

c_string2psi

C_STRING2PSI(P) Convert a string to a psi-term whose name is the string's value.

Definition at line 4827 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().

4828 {
4829  long success=TRUE;
4830  ptr_psi_term arg1,arg2, funct,result,t;
4831  ptr_module mod=NULL; /* RM: Mar 11 1993 */
4832  ptr_module save_current; /* RM: Mar 12 1993 */
4833 
4834 
4835  funct=aim->aaaa_1;
4836  deref_ptr(funct);
4837  result=aim->bbbb_1;
4838  deref(result);
4839 
4840  get_two_args(funct->attr_list,&arg1,&arg2);
4841  if(arg1)
4842  deref(arg1);
4843  if(arg2)
4844  deref(arg2);
4845  deref_args(funct,set_1_2);
4846 
4847  if (arg1) {
4848  success=overlap_type(arg1->type,quoted_string);
4849  if(success) {
4850 
4851  /* RM: Mar 11 1993 */
4852  if(arg2)
4853  success=get_module(arg2,&mod);
4854 
4855  if (success) {
4856  if(!arg1->value_3)
4857  residuate(arg1);
4858  else {
4859  t=stack_psi_term(4);
4860  save_current=current_module;
4861  if(mod)
4862  current_module=mod;
4863  t->type=update_symbol(mod,(char *)arg1->value_3);
4864  current_module=save_current;
4865  if(t->type==error_psi_term->type)
4866  success=FALSE;
4867  else
4868  push_goal(unify,t,result,NULL);
4869  }
4870  }
4871  }
4872  else {
4873  success=FALSE;
4874  warningline("argument of '%P' is not a string.\n",funct);
4875  /* report_warning(funct,"argument is not a string"); 9.9 */
4876  }
4877  }
4878  else
4879  curry();
4880 
4881  if(!success)
4882  Errorline("error occurred in '%P'\n",funct);
4883 
4884  return success;
4885 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
ptr_module current_module
Definition: def_glob.h:161
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_string_address

C_STRING_ADDRESS Return the address of a string.

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

4096 {
4097  long success=FALSE;
4098  ptr_psi_term arg1,arg2,funct,result,t;
4099  REAL val;
4100  long num;
4101  long smaller;
4102 
4103  funct = aim->aaaa_1;
4104  deref_ptr(funct);
4105  result=aim->bbbb_1;
4106 
4107  get_two_args(funct->attr_list, &arg1, &arg2);
4108  if(arg1) {
4109  deref_ptr(arg1);
4110  deref_ptr(result);
4111  success=matches(arg1->type,quoted_string,&smaller);
4112  if (success) {
4113  if (arg1->value_3) {
4114  (void)unify_real_result(result,(REAL)(long)(arg1->value_3));
4115  }
4116  else {
4117  if((success=get_real_value(result,&val,&num))) {
4118  if(num) {
4119  t=stack_psi_term(4);
4120  t->type=quoted_string;
4121  t->value_3=(GENERIC)&val; // changed to addr djd
4122  push_goal(unify,t,arg1,NULL);
4123  }
4124  else
4125  residuate2(arg1,result);
4126 
4127  }
4128  else
4129  Errorline("result is not a real in %P\n",funct);
4130  }
4131  }
4132  else
4133  Errorline("argument is not a string in %P\n",funct);
4134  }
4135  else
4136  curry();
4137 
4138  return success;
4139 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
long get_real_value(ptr_psi_term t, REAL *v, long *n)
get_real_value
Definition: built_ins.c:262
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
void curry()
curry
Definition: lefun.c:174
#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)
residuate2
Definition: lefun.c:144
#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)
stack_psi_term
Definition: lefun.c:21
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)
unify_real_result
Definition: built_ins.c:387
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 ( )

c_string_length

C_STRING_LENGTH Return the length of the string in argument 1.

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

5723 {
5724  ptr_psi_term result,funct;
5725  ptr_node n1;
5726  long success=TRUE;
5727  long all_args=TRUE;
5728  long c_result;
5729  ptr_psi_term arg1;
5730  char * c_arg1;
5731 
5732  funct=aim->aaaa_1;
5733  deref_ptr(funct);
5734  result=aim->bbbb_1;
5735 
5736  /* Evaluate all arguments first: */
5737  n1=find(FEATCMP,one,funct->attr_list);
5738  if (n1) {
5739  arg1= (ptr_psi_term )n1->data;
5740  deref(arg1);
5741  }
5742  deref_args(funct,set_1);
5743 
5744  if (success) {
5745  if (n1) {
5746  if (overlap_type(arg1->type,quoted_string)) /* 10.8 */
5747  if (arg1->value_3)
5748  c_arg1= (char *)arg1->value_3;
5749  else {
5750  residuate(arg1);
5751  all_args=FALSE;
5752  }
5753  else
5754  success=FALSE;
5755  }
5756  else {
5757  all_args=FALSE;
5758  curry();
5759  };
5760  };
5761 
5762  if (success && all_args) {
5763  c_result=strlen(c_arg1);
5764  push_goal(unify,real_stack_psi_term(0,(REAL)c_result),result,NULL);
5765  };
5766 
5767  return success;
5768 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
ptr_psi_term real_stack_psi_term(long stat, REAL thereal)
real_stack_psi_term
Definition: lefun.c:48
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define set_1
Definition: def_const.h:194
GENERIC data
Definition: def_struct.h:185
void curry()
curry
Definition: lefun.c:174
#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

c_strip

C_STRIP Return the attributes of a psi-term, that is, a psi-term of type @ but with all the attributes of the argument.

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

3825 {
3826  long success=TRUE;
3827  ptr_psi_term arg1,arg2,funct,result;
3828 
3829  funct=aim->aaaa_1;
3830  deref_ptr(funct);
3831  result=aim->bbbb_1;
3832  get_two_args(funct->attr_list,&arg1,&arg2);
3833  if(arg1) {
3834  deref(arg1);
3835  deref_args(funct,set_1);
3836  resid_aim=NULL;
3837  /* PVR 23.2.94 */
3838  merge_unify(&(result->attr_list),copy_attr_list(arg1->attr_list));
3839  }
3840  else
3841  curry();
3842 
3843  return success;
3844 }
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)
get_two_args
Definition: login.c:47
void merge_unify(ptr_node *u, ptr_node v)
Definition: login.c:1146
#define set_1
Definition: def_const.h:194
void curry()
curry
Definition: lefun.c:174
#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)
copy_attr_list
Definition: built_ins.c:3802
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
long c_sub_string ( )

c_sub_string

C_SUB_STRING Return the substring of argument 1 from position argument 2 for a length of argument 3 characters.

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

5778 {
5779  ptr_psi_term result,funct,temp_result;
5780  ptr_node n1,n2,n3;
5781  long success=TRUE;
5782  long all_args=TRUE;
5783  char * c_result;
5784  ptr_psi_term arg1;
5785  char * c_arg1;
5786  ptr_psi_term arg2;
5787  long c_arg2;
5788  ptr_psi_term arg3;
5789  long c_arg3;
5790 
5791  funct=aim->aaaa_1;
5792  deref_ptr(funct);
5793  result=aim->bbbb_1;
5794 
5795  /* Evaluate all arguments first: */
5796  n1=find(FEATCMP,one,funct->attr_list);
5797  if (n1) {
5798  arg1= (ptr_psi_term )n1->data;
5799  deref(arg1);
5800  }
5801  n2=find(FEATCMP,two,funct->attr_list);
5802  if (n2) {
5803  arg2= (ptr_psi_term )n2->data;
5804  deref(arg2);
5805  }
5806  n3=find(FEATCMP,three,funct->attr_list);
5807  if (n3) {
5808  arg3= (ptr_psi_term )n3->data;
5809  deref(arg3);
5810  }
5811  deref_args(funct,set_1_2_3);
5812 
5813  if (success) {
5814  if (n1) {
5815  if (overlap_type(arg1->type,quoted_string)) /* 10.8 */
5816  if (arg1->value_3)
5817  c_arg1= (char *)arg1->value_3;
5818  else {
5819  residuate(arg1);
5820  all_args=FALSE;
5821  }
5822  else
5823  success=FALSE;
5824  }
5825  else {
5826  all_args=FALSE;
5827  curry();
5828  };
5829  };
5830 
5831  if (success) {
5832  if (n2) {
5833  if (overlap_type(arg2->type,integer)) /* 10.8 */
5834  if (arg2->value_3)
5835  c_arg2= (long)(* (double *)(arg2->value_3));
5836  else {
5837  residuate(arg2);
5838  all_args=FALSE;
5839  }
5840  else
5841  success=FALSE;
5842  }
5843  else {
5844  all_args=FALSE;
5845  curry();
5846  };
5847  };
5848 
5849  if (success) {
5850  if (n3) {
5851  if (overlap_type(arg3->type,integer)) /* 10.8 */
5852  if (arg3->value_3)
5853  c_arg3= (long)(* (double *)(arg3->value_3));
5854  else {
5855  residuate(arg3);
5856  all_args=FALSE;
5857  }
5858  else
5859  success=FALSE;
5860  }
5861  else {
5862  all_args=FALSE;
5863  curry();
5864  };
5865  };
5866 
5867  if (success && all_args) {
5868  c_result=sub_str(c_arg1,c_arg2,c_arg3);
5869  temp_result=stack_psi_term(0);
5870  temp_result->type=quoted_string;
5871  temp_result->value_3=(GENERIC)c_result;
5872  push_goal(unify,temp_result,result,NULL);
5873  };
5874 
5875  return success;
5876 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
char * two
Definition: def_glob.h:251
GENERIC data
Definition: def_struct.h:185
void curry()
curry
Definition: lefun.c:174
#define NULL
Definition: def_const.h:203
char * three
Definition: def_glob.h:252
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
char * sub_str(char *s, long p, long n)
sub_str
Definition: built_ins.c:5510
#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)
stack_psi_term
Definition: lefun.c:21
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

c_succeed

C_SUCCEED Always succeed.

Definition at line 1401 of file built_ins.c.

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

1402 {
1403  ptr_psi_term t;
1404 
1405  t=aim->aaaa_1;
1406  deref_args(t,set_empty);
1407  return TRUE;
1408 }
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

c_such_that

C_SUCH_THAT This implements 'Value | Goal'. First it unifies Value with the result, then it proves Goal.

This routine is different than the straight-forward implementation in Life which would have been: "V|G => cond(G,V,{})" because V is evaluated and unified before G is proved.

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

5008 {
5009  long success=TRUE;
5010  ptr_psi_term arg1,arg2,funct,result;
5011 
5012  funct=aim->aaaa_1;
5013  deref_ptr(funct);
5014  result=aim->bbbb_1;
5015  get_two_args(funct->attr_list,&arg1,&arg2);
5016  if (arg1 && arg2) {
5017  deref_ptr(arg1);
5018  deref_ptr(arg2);
5019  deref_args(funct,set_1_2);
5020  resid_aim=NULL;
5022  push_goal(unify,arg1,result,NULL);
5023  (void)i_check_out(arg1);
5024  }
5025  else
5026  curry();
5027 
5028  return success;
5029 }
#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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define DEFRULES
Definition: def_const.h:138
void curry()
curry
Definition: lefun.c:174
#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)
i_check_out
Definition: lefun.c:1033
static long c_undo ( )
static

c_undo

C_UNDO This will prove a goal on backtracking. This is a completely uninteresting implmentation which is equivalent to:

undo. undo(G) :- G.

The problem is that it can be affected by CUT. A correct implementation would be very simple: stack the pair (ADDRESS=NULL, VALUE=GOAL) onto the trail and when undoing push the goal onto the goal-stack.

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

4549 {
4550  long success=TRUE;
4551  ptr_psi_term arg1,arg2,g;
4552 
4553  g=aim->aaaa_1;
4554  deref_ptr(g);
4555  get_two_args(g->attr_list,&arg1,&arg2);
4556  if (arg1) {
4557  deref_args(g,set_1);
4559  }
4560  else {
4561  success=FALSE;
4562  Errorline("argument missing in %P.\n",g);
4563  }
4564 
4565  return success;
4566 }
#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)
get_two_args
Definition: login.c:47
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_choice_point
Definition: login.c:638
#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

c_unify_func

C_UNIFY_FUNC An explicit unify function that curries on its two arguments.

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

4422 {
4423  long success=TRUE;
4424  ptr_psi_term funct,arg1,arg2,result;
4425 
4426  funct=aim->aaaa_1;
4427  deref_ptr(funct);
4428  get_two_args(funct->attr_list,&arg1,&arg2);
4429  if (arg1 && arg2) {
4430  deref(arg1);
4431  deref(arg2);
4432  deref_args(funct,set_1_2);
4433  result=aim->bbbb_1;
4434  push_goal(unify,arg1,result,NULL);
4435  push_goal(unify,arg1,arg2,NULL);
4436  }
4437  else
4438  curry();
4439 
4440  return success;
4441 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void curry()
curry
Definition: lefun.c:174
#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

c_unify_pred

C_UNIFY_PRED() This unifies its two arguments (i.e. implements the predicate A=B).

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

4451 {
4452  long success=FALSE;
4453  ptr_psi_term arg1,arg2,g;
4454 
4455  g=aim->aaaa_1;
4456  deref_ptr(g);
4457  get_two_args(g->attr_list,&arg1,&arg2);
4458  if (arg1 && arg2) {
4459  deref_args(g,set_1_2);
4460  success=TRUE;
4461  push_goal(unify,arg1,arg2,NULL);
4462  }
4463  else
4464  Errorline("argument missing in %P.\n",g);
4465 
4466  return success;
4467 }
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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define NULL
Definition: def_const.h:203
void 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

static long c_var()

C_VAR Return lf_true/lf_false iff argument is/is not '@' (top with no attributes).

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

1435 {
1436  long success=TRUE;
1437  ptr_psi_term arg1,result,g,other;
1438 
1439  g=aim->aaaa_1;
1440  deref_ptr(g);
1441  result=aim->bbbb_1;
1442  deref(result);
1443  get_one_arg(g->attr_list,&arg1);
1444  if (arg1) {
1445  deref(arg1);
1446  deref_args(g,set_1);
1447  other=stack_psi_term(4); /* 19.11 */
1448  other->type=((arg1->type==top)&&(arg1->attr_list==NULL))?lf_true:lf_false;
1449  resid_aim=NULL;
1450  push_goal(unify,result,other,NULL);
1451  }
1452  else {
1453  curry();
1454  /* Errorline("argument missing in %P.\n",t); */
1455  /* return c_abort(); */
1456  }
1457 
1458  return success;
1459 }
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)
push_goal
Definition: login.c:600
void get_one_arg(ptr_node t, ptr_psi_term *a)
get_one_arg
Definition: login.c:99
#define set_1
Definition: def_const.h:194
ptr_definition top
Definition: def_glob.h:106
void curry()
curry
Definition: lefun.c:174
#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)
stack_psi_term
Definition: lefun.c:21
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

c_write

C_WRITE Write a list of arguments. Print cyclical terms correctly, but don't use the pretty printer indentation.

Definition at line 3174 of file built_ins.c.

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

3175 {
3176  indent=FALSE;
3182  return generic_write();
3183 }
static long generic_write()
generic_write
Definition: built_ins.c:3115
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

c_write_canonical

C_WRITE_CANONICAL Write a list of arguments in a form that allows them to be read in again. Print cyclical terms correctly, but don't use the pretty printer indentation.

Definition at line 3214 of file built_ins.c.

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

3215 {
3216  indent=FALSE;
3217  const_quote=TRUE;
3221  write_canon=TRUE;
3222  return generic_write();
3223 }
static long generic_write()
generic_write
Definition: built_ins.c:3115
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

c_write_err

C_WRITE_ERR Write a list of arguments to stderr. Print cyclical terms correctly, but don't use the pretty printer indentation.

Definition at line 3135 of file built_ins.c.

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

3136 {
3137  indent=FALSE;
3143  return generic_write();
3144 }
static long generic_write()
generic_write
Definition: built_ins.c:3115
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

c_writeq

C_WRITEQ Write a list of arguments in a form that allows them to be read in again. Print cyclical terms correctly, but don't use the pretty printer indentation.

Definition at line 3194 of file built_ins.c.

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

3195 {
3196  indent=FALSE;
3197  const_quote=TRUE;
3202  return generic_write();
3203 }
static long generic_write()
generic_write
Definition: built_ins.c:3115
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

c_writeq_err

C_WRITEQ_ERR Write a list of arguments to stderr in a form that allows them to be read in again. Print cyclical terms correctly, but don't use the pretty printer indentation.

Definition at line 3155 of file built_ins.c.

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

3156 {
3157  indent=FALSE;
3158  const_quote=TRUE;
3163  return generic_write();
3164 }
static long generic_write()
generic_write
Definition: built_ins.c:3115
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

c_xor

C_XOR Logical exclusive or. This function does all possible local propagations.

Definition at line 1081 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().

1082 {
1083  long success=TRUE;
1084  ptr_psi_term funct,arg1,arg2,arg3;
1085  long sm1, sm2, sm3;
1086  long a1comp, a2comp, a3comp;
1087  long a1, a2, a3;
1088 
1089  funct=aim->aaaa_1;
1090  deref_ptr(funct);
1091  get_two_args(funct->attr_list,&arg1,&arg2);
1092  if (arg1 && arg2) {
1093  deref(arg1);
1094  deref(arg2);
1095  deref_args(funct,set_1_2);
1096  arg3=aim->bbbb_1;
1097  deref(arg3);
1098 
1099  a1comp = matches(arg1->type,boolean,&sm1);
1100  a2comp = matches(arg2->type,boolean,&sm2);
1101  a3comp = matches(arg3->type,boolean,&sm3);
1102  if (a1comp && a2comp && a3comp) {
1103  a1 = get_bool(arg1->type);
1104  a2 = get_bool(arg2->type);
1105  a3 = get_bool(arg3->type);
1106  if ((a1==TRUE || a1==FALSE) && (a2==TRUE || a2==FALSE)) {
1107  unify_bool_result(arg3, a1^a2);
1108  } else if ((a1==TRUE || a1==FALSE) && (a3==TRUE || a3==FALSE)) {
1109  unify_bool_result(arg2, a1^a3);
1110  } else if ((a3==TRUE || a3==FALSE) && (a2==TRUE || a2==FALSE)) {
1111  unify_bool_result(arg1, a3^a2);
1112 
1113  } else if (a1==TRUE && arg3==arg2) {
1114  success=FALSE;
1115  } else if (a2==TRUE && arg3==arg2) {
1116  success=FALSE;
1117  } else if (a3==TRUE && arg1==arg2) {
1118  success=FALSE;
1119 
1120  } else if (a1==FALSE) {
1121  push_goal(unify,arg2,arg3,(GENERIC)NULL);
1122  } else if (a2==FALSE) {
1123  push_goal(unify,arg1,arg3,(GENERIC)NULL);
1124  } else if (a3==FALSE) {
1125  push_goal(unify,arg1,arg2,(GENERIC)NULL);
1126 
1127  } else if (arg1==arg2) {
1128  unify_bool_result(arg3,FALSE);
1129  } else if (arg1==arg3) {
1130  unify_bool_result(arg2,FALSE);
1131  } else if (arg3==arg2) {
1132  unify_bool_result(arg1,FALSE);
1133  } else {
1134  if (a1==UNDEF) residuate(arg1);
1135  if (a2==UNDEF) residuate(arg2);
1136  if (a3==UNDEF) residuate(arg3);
1137  }
1138  if (!sm1) unify_bool(arg1);
1139  if (!sm2) unify_bool(arg2);
1140  if (!sm3) unify_bool(arg3);
1141  }
1142  else {
1143  success=FALSE;
1144  Errorline("Non-boolean argument or result in '%P'.\n",funct);
1145  }
1146  }
1147  else
1148  curry();
1149 
1150  return success;
1151 }
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)
get_two_args
Definition: login.c:47
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
static void unify_bool(ptr_psi_term arg)
unify_bool
Definition: built_ins.c:912
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
void curry()
curry
Definition: lefun.c:174
#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)
get_bool
Definition: built_ins.c:899
#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 
)

check_real

Parameters
ptr_psi_termt
REAL*v
long*n

CHECK_REAL(t,v,n) Like get_real_value, but does not force the type of T to be real.

Definition at line 232 of file built_ins.c.

References FALSE, matches(), REAL, real, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

233 {
234  long success=FALSE;
235  long smaller;
236 
237  if (t) {
238  success=matches(t->type,real,&smaller);
239  if (success) {
240  *n=FALSE;
241  if (smaller && t->value_3) {
242  *v= *(REAL *)t->value_3;
243  *n=TRUE;
244  }
245  }
246  }
247  return success;
248 }
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)

collect_symbols

Parameters
longsel

Collect properties of the symbols in the symbol table, and make a psi-term list of them. This routine is parameterized (by sel) to collect three properties:

  1. All symbols that are types with no parents.
  2. All symbols that are of 'undef' type.
  3. The operator triples of all operators.

Note the similarity between this routine and a tree-to-list routine in Prolog. The pointer manipulations are simpler in Prolog, though.

If the number of symbols is very large, this routine may run out of space before garbage collection.

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

3697 {
3698  ptr_psi_term new;
3699  ptr_definition def;
3700  long botflag;
3701  ptr_psi_term result;
3702 
3703 
3704  result=stack_nil();
3705 
3706  for(def=first_definition;def;def=def->next) {
3707 
3708  if (sel==least_sel || sel==greatest_sel) {
3709  botflag=(sel==least_sel);
3710 
3711  /* Insert the node if it's a good one */
3712  if (((botflag?def->children:def->parents)==NULL &&
3713  def!=top && def!=nothing &&
3714  def->type_def==(def_type)type_it ||
3715  def->type_def==(def_type)undef)
3716  && !hidden_type(def)) {
3717  /* Create the node that will be inserted */
3718  new=stack_psi_term(4);
3719  new->type=def;
3720  result=stack_cons((ptr_psi_term)new,(ptr_psi_term)result);
3721  }
3722  }
3723  else if (sel==op_sel) {
3724  ptr_operator_data od=def->op_data;
3725 
3726  while (od) {
3727  ptr_psi_term name_loc,type;
3728 
3729  new=stack_psi_term(4);
3730  new->type=opsym;
3731  result=stack_cons((ptr_psi_term)new,(ptr_psi_term)result);
3732 
3734 
3735  type=stack_psi_term(4);
3736  switch (od->type) {
3737  case xf:
3738  type->type=xf_sym;
3739  break;
3740  case yf:
3741  type->type=yf_sym;
3742  break;
3743  case fx:
3744  type->type=fx_sym;
3745  break;
3746  case fy:
3747  type->type=fy_sym;
3748  break;
3749  case xfx:
3750  type->type=xfx_sym;
3751  break;
3752  case xfy:
3753  type->type=xfy_sym;
3754  break;
3755  case yfx:
3756  type->type=yfx_sym;
3757  break;
3758  }
3759  stack_add_psi_attr(new,two,type);
3760 
3761  name_loc=stack_psi_term(4);
3762  name_loc->type=def;
3763  stack_add_psi_attr(new,three,name_loc);
3764 
3765  od=od->next;
3766  }
3767  }
3768  }
3769 
3770  return result;
3771 }
#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)
stack_cons
Definition: built_ins.c:46
#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)
stack_psi_term
Definition: lefun.c:21
ptr_psi_term stack_nil()
stack_nil
Definition: built_ins.c:26
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)
hidden_type
Definition: built_ins.c:3669
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

copy_attr_list

PVR 23.2.94 – Added this to fix c_strip and c_copy_pointer Make a copy of an attr_list structure, keeping the same leaf pointers

Definition at line 3802 of file built_ins.c.

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

3803 {
3804  ptr_node m;
3805 
3806  if (n==NULL) return NULL;
3807 
3808  m = STACK_ALLOC(node);
3809  m->key = n->key;
3810  m->data = n->data;
3811  m->left = copy_attr_list(n->left);
3812  m->right = copy_attr_list(n->right);
3813  return m;
3814 }
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)
copy_attr_list
Definition: built_ins.c:3802
ptr_node right
Definition: def_struct.h:184
long declare_operator ( ptr_psi_term  t)

declare_operator

Parameters
ptr_psi_termt

DECLARE_OPERATOR(t) Declare a new operator or change a pre-existing one.

For example: 'op'(3,xfx,+)? T is the OP declaration.

Definition at line 5432 of file built_ins.c.

References wl_psi_term::attr_list, 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.

5433 {
5434  ptr_psi_term prec,type,atom;
5435  ptr_node n;
5436  char *s;
5437  long p;
5438  operator kind=nop;
5439  long success=FALSE;
5440 
5441  deref_ptr(t);
5442  n=t->attr_list;
5443  get_two_args(n,&prec,&type);
5444  n=find(FEATCMP,three,n);
5445  if (n && prec && type) {
5446  atom=(ptr_psi_term )n->data;
5447  deref_ptr(prec);
5448  deref_ptr(type);
5449  deref_ptr(atom);
5450  if (!atom->value_3) {
5451  s=atom->type->keyword->symbol;
5452  if (sub_type(prec->type,integer) && prec->value_3) { /* 10.8 */
5453  p = * (REAL *)prec->value_3;
5454  if (p>0 && p<=MAX_PRECEDENCE) {
5455 
5456  if (type->type == xf_sym) kind=xf;
5457  else if (type->type == yf_sym) kind=yf;
5458  else if (type->type == fx_sym) kind=fx;
5459  else if (type->type == fy_sym) kind=fy;
5460  else if (type->type == xfx_sym) kind=xfx;
5461  else if (type->type == xfy_sym) kind=xfy;
5462  else if (type->type == yfx_sym) kind=yfx;
5463  else
5464  Errorline("bad operator kind '%s'.\n",type->type->keyword->symbol);
5465 
5466  if (kind!=nop) {
5467  op_declare(p,kind,s);
5468  success=TRUE;
5469  }
5470  }
5471  else
5472  Errorline("precedence must range from 1 to 1200 in %P.\n",t);
5473  }
5474  else
5475  Errorline("precedence must be a positive integer in %P.\n",t);
5476  }
5477  else
5478  Errorline("numbers or strings may not be operators in %P.\n",t);
5479  }
5480  else
5481  Errorline("argument missing in %P.\n",t);
5482 
5483  return success;
5484 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
#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)
op_declare
Definition: built_ins.c:5400
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)

exit_life

Parameters
longnl_flag

Definition at line 2220 of file built_ins.c.

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

2221 {
2222  (void)open_input_file("stdin");
2223  (void)times(&life_end);
2224  if (NOTQUIET) { /* 21.1 */
2225  if (nl_flag) printf("\n");
2226  printf("*** Exiting Wild_Life ");
2227  printf("[%1.3fs cpu, %1.3fs gc (%2.1f%%)]\n",
2228  (life_end.tms_utime-life_start.tms_utime)/60.0,
2229  garbage_time,
2230  garbage_time*100 / ((life_end.tms_utime-life_start.tms_utime)/60.0)
2231  );
2232  }
2233 
2234 #ifdef ARITY /* RM: Mar 29 1993 */
2235  arity_end();
2236 #endif
2237 
2238  exit(EXIT_SUCCESS);
2239 }
#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)

file_exists

Parameters
char*s

Definition at line 1712 of file built_ins.c.

References expand_file_name(), FALSE, and TRUE.

1713 {
1714  FILE *f;
1715  char *e;
1716  long success=FALSE;
1717 
1718  e=expand_file_name(s);
1719  if ((f=fopen(e,"r"))) {
1720  (void)fclose(f);
1721  success=TRUE;
1722  }
1723  return success;
1724 }
#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

generic_write

GENERIC_WRITE Implements write, writeq, pretty_write, pretty_writeq.

Definition at line 3115 of file built_ins.c.

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

3116 {
3117  ptr_psi_term g;
3118 
3119  g=aim->aaaa_1;
3120  /* deref_rec(g); */
3121  deref_args(g,set_empty);
3122  pred_write(g->attr_list);
3123  /* fflush(output_stream); */
3124  return TRUE;
3125 }
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

get_bool

Parameters
ptr_definitiontyp

Definition at line 899 of file built_ins.c.

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

900 {
901  if (sub_type(typ,lf_true)) return TRUE;
902  else if (sub_type(typ,lf_false)) return FALSE;
903  else return UNDEF;
904 }
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

get_bool_value

Parameters
ptr_psi_termt
REAL*v
long*n

GET_BOOL_VALUE(t,v,n) This is identical in nature to GET_REAL_VALUE. The values handled here have to be booleans. Check if psi_term T is a boolean. V <- TRUE or FALSE value of T.

Definition at line 301 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(), wl_psi_term::status, TRUE, and wl_psi_term::type.

302 {
303  long success=FALSE;
304  long smaller;
305 
306  if(t) {
307  success=matches(t->type,boolean,&smaller);
308  if(success) {
309  *n=FALSE;
310  if(smaller) {
311  if(matches(t->type,lf_false,&smaller) && smaller) {
312  *v= 0;
313  *n=TRUE;
314  }
315  else
316  if(matches(t->type,lf_true,&smaller) && smaller) {
317  *v= 1;
318  *n=TRUE;
319  }
320  }
321  else {
322  if((GENERIC)t<heap_pointer) { /* RM: Jun 8 1993 */
325  t->type=boolean;
326  t->status=0;
327  (void)i_check_out(t);
328  }
329  }
330  }
331  }
332 
333  return success;
334 }
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
#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)
i_check_out
Definition: lefun.c:1033
#define int_ptr
Definition: def_const.h:172
long get_real_value ( ptr_psi_term  t,
REAL v,
long *  n 
)

get_real_value

Parameters
ptr_psi_termt
REAL*v
long*n

GET_REAL_VALUE(t,v,n) Check if psi_term T is a real number. Return N=TRUE iff T <| REAL. If T has a real value then set V to that value. Also force the type of T to REAL if REAL <| T. This is used in all the arithmetic built-in functions to get their arguments.

Definition at line 262 of file built_ins.c.

References def_ptr, FALSE, heap_pointer, i_check_out(), int_ptr, matches(), push_ptr_value(), REAL, real, wl_psi_term::status, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

263 {
264  long success=FALSE;
265  long smaller;
266  if (t) {
267  success=matches(t->type,real,&smaller);
268  if (success) {
269  *n=FALSE;
270  if (smaller) {
271  if (t->value_3) {
272  *v= *(REAL *)t->value_3;
273  *n=TRUE;
274  }
275  }
276  else {
277  if((GENERIC)t<heap_pointer) { /* RM: Jun 8 1993 */
280  t->type=real;
281  t->status=0;
282  (void)i_check_out(t);
283  }
284  }
285  }
286  }
287  return success;
288 }
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
#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)
i_check_out
Definition: lefun.c:1033
#define int_ptr
Definition: def_const.h:172
void global_error_check ( ptr_node  n,
int *  error,
int *  eval_2 
)

global_error_check

Parameters
ptr_noden
int* error
int* eval_2

Definition at line 2592 of file built_ins.c.

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

2593 {
2594  if (n) {
2595  ptr_psi_term t,a1,a2;
2596  int bad_init=FALSE;
2597  global_error_check(n->left, error, eval_2);
2598 
2599  t=(ptr_psi_term)n->data;
2600  deref_ptr(t);
2601  if (t->type==leftarrowsym) {
2602  get_two_args(t->attr_list,&a1,&a2);
2603  if (a1==NULL || a2==NULL) {
2604  Errorline("%P is an incorrect global variable declaration (%E).\n",t);
2605  *error=TRUE;
2606  bad_init=TRUE;
2607  } else {
2608  deref_ptr(a1);
2609  deref_ptr(a2);
2610  t=a1;
2611  if (deref_eval(a2)) *eval_2=TRUE;
2612  }
2613  }
2614  if (!bad_init && t->type->type_def!=(def_type)undef && t->type->type_def!=(def_type)global) {
2615  Errorline("%T %P cannot be redeclared as a global variable (%E).\n",
2616  t->type->type_def,
2617  t);
2618  t->type=error_psi_term->type;
2619  t->value_3=NULL; /* RM: Mar 23 1993 */
2620  *error=TRUE;
2621  }
2622 
2623  global_error_check(n->right, error, eval_2);
2624  }
2625 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
#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)
global_error_check
Definition: built_ins.c:2592
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)
deref_eval
Definition: lefun.c:1180
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)

global_one

Definition at line 2651 of file built_ins.c.

References wl_psi_term::attr_list, clear_copy(), deref_ptr, get_two_args(), global, HEAP, wl_definition::init_value, leftarrowsym, quote_copy(), stack_psi_term(), wl_psi_term::type, and wl_definition::type_def.

2652 {
2653  ptr_psi_term u; // ,val;
2654 
2655  if (t->type==leftarrowsym) {
2656  get_two_args(t->attr_list,&t,&u);
2657  deref_ptr(t);
2658  deref_ptr(u);
2659  }
2660  else
2661  u=stack_psi_term(4);
2662 
2663  clear_copy();
2665  t->type->init_value=quote_copy(u,HEAP); /* RM: Mar 23 1993 */
2666 
2667  /* eval_global_var(t); RM: Feb 4 1994 */
2668 
2669  /* RM: Nov 10 1993
2670  val=t->type->global_value;
2671  if (val && (GENERIC)val<heap_pointer) {
2672  deref_ptr(val);
2673  push_psi_ptr_value(val,&(val->coref));
2674  val->coref=u;
2675  } else
2676  t->type->global_value=u;
2677  */
2678 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
ptr_psi_term init_value
Definition: def_struct.h:142
#define HEAP
Definition: def_const.h:147
void clear_copy()
clear_copy
Definition: copy.c:53
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)
quote_copy
Definition: copy.c:186
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
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)

global_tree

Parameters
ptr_noden

Definition at line 2632 of file built_ins.c.

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

2633 {
2634  if (n) {
2635  ptr_psi_term t;
2636  global_tree(n->left);
2637 
2638  t=(ptr_psi_term)n->data;
2639  deref_ptr(t);
2640  global_one(t);
2641 
2642  global_tree(n->right);
2643  }
2644 }
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)
global_tree
Definition: built_ins.c:2632
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void global_one(ptr_psi_term t)
global_one
Definition: built_ins.c:2651
ptr_node right
Definition: def_struct.h:184
long has_rules ( ptr_pair_list  r)

has_rules

Parameters
ptr_pair_listr

Return TRUE iff there are some rules r This is true for a user-defined function or predicate with a definition, and for a type with constraints.

Definition at line 5097 of file built_ins.c.

References wl_pair_list::aaaa_2, FALSE, wl_pair_list::next, NULL, and TRUE.

5098 {
5099  if (r==NULL) return FALSE;
5100  while (r) {
5101  if (r->aaaa_2!=NULL) return TRUE;
5102  r=r->next;
5103  }
5104  return FALSE;
5105 }
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)

hidden_type

Parameters
ptr_definitiont

Return TRUE iff T is a type that should not show up as part of the type hierarchy, i.e. it is an internal hidden type.

Definition at line 3669 of file built_ins.c.

References comment, constant, functor, and variable.

3670 {
3671  return (/* (t==conjunction) || 19.8 */
3672  /* (t==disjunction) || RM: Dec 9 1992 */
3673  (t==constant) || (t==variable) ||
3674  (t==comment) || (t==functor));
3675 }
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 ( )

init_built_in_types

INIT_BUILT_IN_TYPES Initialise the symbol tree with the built-in types. Declare all built-in predicates and functions. Initialise system type variables. Declare all standard operators.

Called by life.c

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

6151 {
6152  ptr_definition t;
6153 
6154  /* symbol_table=NULL; RM: Feb 3 1993 */
6155 
6156 
6157 
6158  /* RM: Jan 13 1993 */
6159  /* Initialize the minimum syntactic symbols */
6160  (void)set_current_module(syntax_module); /* RM: Feb 3 1993 */
6162  (void)update_symbol(syntax_module,"[");
6163  (void)update_symbol(syntax_module,"]");
6164  (void)update_symbol(syntax_module,"(");
6165  (void)update_symbol(syntax_module,")");
6166  (void)update_symbol(syntax_module,"{");
6167  (void)update_symbol(syntax_module,"}");
6168  (void)update_symbol(syntax_module,".");
6169  (void)update_symbol(syntax_module,"?");
6170 
6171 
6176  eof =update_symbol(syntax_module,"end_of_file");
6180  life_or =update_symbol(syntax_module,";");/* RM: Apr 6 1993 */
6181  minus_symbol =update_symbol(syntax_module,"-");/* RM: Jun 21 1993 */
6187 
6188  /* RM: Jul 7 1993 */
6191 
6192 
6193 
6194  /* RM: Feb 3 1993 */
6196  error_psi_term=heap_psi_term(4); /* 8.10 */
6197  error_psi_term->type=update_symbol(bi_module,"*** ERROR ***");
6199 
6200  apply =update_symbol(bi_module,"apply");
6201  boolean =update_symbol(bi_module,"bool");
6202  boolpredsym =update_symbol(bi_module,"bool_pred");
6203  built_in =update_symbol(bi_module,"built_in");
6204  calloncesym =update_symbol(bi_module,"call_once");
6205  /* colon sym */
6206  /* comma sym */
6207  comment =update_symbol(bi_module,"comment");
6208 
6209 
6210  /* RM: Dec 11 1992 conjunctions have been totally scrapped it seems */
6211  /* conjunction=update_symbol("*conjunction*"); 19.8 */
6212 
6213  constant =update_symbol(bi_module,"*constant*");
6214  disjunction =update_symbol(bi_module,"disj");/*RM:9 Dec 92*/
6215  lf_false =update_symbol(bi_module,"false");
6216  functor =update_symbol(bi_module,"functor");
6217  iff =update_symbol(bi_module,"cond");
6219  alist =update_symbol(bi_module,"cons");/*RM:9 Dec 92*/
6220  nothing =update_symbol(bi_module,"bottom");
6221  nil =update_symbol(bi_module,"nil");/*RM:9 Dec 92*/
6223  real =update_symbol(bi_module,"real");
6224  stream =update_symbol(bi_module,"stream");
6225  succeed =update_symbol(bi_module,"succeed");
6226  lf_true =update_symbol(bi_module,"true");
6227  timesym =update_symbol(bi_module,"time");
6228  variable =update_symbol(bi_module,"*variable*");
6229  opsym =update_symbol(bi_module,"op");
6230  loadsym =update_symbol(bi_module,"load");
6231  dynamicsym =update_symbol(bi_module,"dynamic");
6232  staticsym =update_symbol(bi_module,"static");
6233  encodesym =update_symbol(bi_module,"encode");
6234  listingsym =update_symbol(bi_module,"c_listing");
6235  /* provesym =update_symbol(bi_module,"prove"); */
6236  delay_checksym =update_symbol(bi_module,"delay_check");
6237  eval_argsym =update_symbol(bi_module,"non_strict");
6238  inputfilesym =update_symbol(bi_module,"input_file");
6239  call_handlersym =update_symbol(bi_module,"call_handler");
6247  nullsym =update_symbol(bi_module,"<NULL PSI TERM>");
6250 
6251 
6252  (void)set_current_module(no_module); /* RM: Feb 3 1993 */
6253  t=update_symbol(no_module,"1");
6254  one=t->keyword->symbol;
6255  t=update_symbol(no_module,"2");
6256  two=t->keyword->symbol;
6257  t=update_symbol(no_module,"3");
6258  three=t->keyword->symbol;
6259  (void)set_current_module(bi_module); /* RM: Feb 3 1993 */
6260  t=update_symbol(bi_module,"year");
6261  year_attr=t->keyword->symbol;
6262  t=update_symbol(bi_module,"month");
6264  t=update_symbol(bi_module,"day");
6265  day_attr=t->keyword->symbol;
6266  t=update_symbol(bi_module,"hour");
6267  hour_attr=t->keyword->symbol;
6268  t=update_symbol(bi_module,"minute");
6270  t=update_symbol(bi_module,"second");
6272  t=update_symbol(bi_module,"weekday");
6274 
6277 
6278  /* Built-in routines */
6279  // bi_list = fopen("bi_list.txt","w");
6280 
6281  /* Program database */
6291 
6292  /* File I/O */
6304 
6305  /* Term I/O */
6317  new_built_in(bi_module,"c_op",(def_type)predicate,c_op); /* RM: Jan 13 1993 */
6321 
6322  /* Type checks */
6328 
6333 
6334  /* RM: Dec 16 1992 So the symbol can be changed easily */
6335 
6336 
6337  /* Arithmetic */
6339 
6340  /* Comparison */
6352 
6353  /* RM: Nov 22 1993 */
6355 
6356  /* Psi-term navigation */
6358  new_built_in(bi_module,"feature_values",(def_type)function_it,c_feature_values); /* RM: Mar 3 1994 */
6359 
6360  /* RM: Jul 20 1993 */
6361 
6362  new_built_in(syntax_module,".",(def_type)function_it,c_project);/* RM: Jul 7 1993 */
6365  new_built_in(bi_module,"copy_pointer",(def_type)function_it,c_copy_pointer); /* PVR: Dec 17 1992 */
6366  new_built_in(bi_module,"has_feature",(def_type)function_it,c_exist_feature); /* PVR: Dec 17 1992 */
6367 
6368  /* Unification and assignment */
6370  /* new_built_in(syntax_module,"<<-",(def_type)predicate,c_assign); RM: Feb 24 1993 */
6371 
6372  /* RM: Feb 24 1993 */
6374  /* new_built_in(syntax_module,"<<<-",(def_type)predicate,c_global_assign); */
6375 
6376  /* RM: Feb 8 1993 */
6377  new_built_in(syntax_module,"{}",(def_type)function_it,c_fail); /* RM: Feb 16 1993 */
6381  /* UNI new_built_in(syntax_module,":",(def_type)function_it,c_unify_func); */
6382 
6383  /* Type hierarchy navigation */
6385 
6386  /* String and character utilities */
6392 
6393  /* Control */
6399  /* new_built_in(bi_module,"quote",(def_type)function_it,c_quote); */
6400  /*new_built_in(bi_module,"call_once",(def_type)function_it,c_call_once);*/ /* DENYS: Jan 25 1995 */
6401  /* new_built_in(bi_module,"call",(def_type)function_it,c_call); */
6402  /* new_built_in(bi_module,"undefined",(def_type)function_it,c_fail); */ /* RM: Jan 13 1993 */
6409 
6412  /* new_built_in(syntax_module,"::",(def_type)predicate,c_declaration); */
6423  /* new_built_in(bi_module,"freeze",(def_type)predicate,c_freeze); PVR 16.9.93 */
6428 
6429  /* System */
6431 
6438 
6439  /* RM: Jan 8 1993 */
6450  /* new_built_in(bi_module,"#",(def_type)function_it,c_module_access); */
6451 
6452  /* Hack so '.set_up' doesn't issue a Warning message */
6453  /* RM: Feb 3 1993 */
6454  hash_lookup(bi_module->symbol_table,"set_module")->public=TRUE;
6456 
6457  /* RM: Jan 29 1993 */
6458  abortsym=update_symbol(bi_module,"abort"); /* 26.1 */
6459  aborthooksym=update_symbol(bi_module,"aborthook"); /* 26.1 */
6460  tracesym=update_symbol(bi_module,"trace"); /* 26.1 */
6461 
6462 
6463  /* RM: Feb 9 1993 */
6468 
6469  /* RM: Mar 11 1993 */
6471  add_module1=update_symbol(bi_module,"features");
6472  add_module2=update_symbol(bi_module,"str2psi");
6473  add_module3=update_symbol(bi_module,"feature_values"); /* RM: Mar 3 1994 */
6474 
6475  /* RM: Jun 29 1993 */
6478 
6479  /* RM: Jul 15 1993 */
6481 
6482 
6483  /* RM: Sep 20 1993 */
6485 
6486  /* RM: Jan 28 1994 */
6488 
6489 #ifdef CLIFE
6490  life_reals();
6491 #endif /* CLIFE */
6492 
6494  // fclose(bi_list);
6495 }
static long c_diff()
c_diff
Definition: built_ins.c:1309
ptr_definition encodesym
Definition: def_glob.h:116
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
new_built_in
Definition: built_ins.c:5371
static long c_get()
c_get
Definition: built_ins.c:2989
static long c_listing()
c_listing
Definition: built_ins.c:5168
static long c_char()
c_char
Definition: built_ins.c:4727
ptr_definition such_that
Definition: def_glob.h:105
ptr_definition boolpredsym
Definition: def_glob.h:74
void insert_math_builtins()
insert math builtins into table
Definition: bi_math.c:1346
static long c_is_sort()
c_is_sort
Definition: built_ins.c:1571
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
long c_initrandom()
c_initrandom
Definition: built_ins.c:6028
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()
c_exists
Definition: built_ins.c:1733
static long c_combined_name()
c_combined_name
Definition: built_ins.c:5689
static long c_exists_choice()
c_exists_choice
Definition: built_ins.c:1911
static long c_static()
c_static
Definition: built_ins.c:1643
ptr_definition xfy_sym
Definition: def_glob.h:127
ptr_definition staticsym
Definition: def_glob.h:115
static long c_write()
c_write
Definition: built_ins.c:3174
static long c_pwriteq()
c_pwriteq
Definition: built_ins.c:3250
static long c_unify_func()
c_unify_func
Definition: built_ins.c:4421
static long c_clause()
c_clause
Definition: built_ins.c:2520
struct wl_definition * def_type
Definition: def_struct.h:32
static long c_declaration()
c_declaration
Definition: built_ins.c:2314
long c_random()
c_random
Definition: built_ins.c:5962
void insert_type_builtins()
void insert_type_builtins
Definition: bi_type.c:820
long c_public()
Definition: modules.c:671
static long c_pwrite()
c_pwrite
Definition: built_ins.c:3232
ptr_definition loadsym
Definition: def_glob.h:113
static long c_ascii()
c_ascii
Definition: built_ins.c:4777
static long c_retract()
c_retract
Definition: built_ins.c:2539
long c_display_modules()
Definition: modules.c:723
static long c_features()
c_features
Definition: built_ins.c:3561
static long c_delay_check()
static long c_delay_check()
Definition: built_ins.c:1662
static long c_fail()
c_fail
Definition: built_ins.c:1389
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()
c_exist_feature
Definition: built_ins.c:3496
static long c_rootsort()
c_rootsort
Definition: built_ins.c:3352
ptr_definition stream
Definition: def_glob.h:103
static long c_persistent()
c_persistent
Definition: built_ins.c:2687
long c_deref_length()
c_deref_length
Definition: built_ins.c:6083
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()
c_project
Definition: built_ins.c:1208
ptr_definition commasym
Definition: def_glob.h:79
static long c_int2string()
c_int2string
Definition: built_ins.c:4939
ptr_psi_term heap_psi_term(long stat)
heap_psi_term
Definition: lefun.c:75
static long c_same_address()
c_same_address
Definition: built_ins.c:3853
static long c_xor()
c_xor
Definition: built_ins.c:1081
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()
c_unify_pred
Definition: built_ins.c:4450
static long c_cond()
c_cond
Definition: built_ins.c:3419
long c_set_module()
Definition: modules.c:483
long c_append_file()
c_append_file
Definition: built_ins.c:5886
ptr_definition fy_sym
Definition: def_glob.h:125
static long c_string2psi()
c_string2psi
Definition: built_ins.c:4827
static long c_read_psi()
c_read_psi
Definition: built_ins.c:2098
static long c_lt()
c_lt C_LT Less than.
Definition: built_ins.c:634
long c_abort()
c_abort
Definition: built_ins.c:2248
ptr_definition aborthooksym
Definition: def_glob.h:65
static long c_boolpred()
c_boolpred
Definition: built_ins.c:839
static long c_diff_address()
c_diff_address
Definition: built_ins.c:3897
static long c_open_out()
c_open_out
Definition: built_ins.c:2816
ptr_definition constant
Definition: def_glob.h:82
static long c_print_codes()
c_print_codes
Definition: built_ins.c:5281
long c_args()
c_args
Definition: built_ins.c:6118
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()
c_string_address
Definition: built_ins.c:4095
ptr_definition quote
Definition: def_glob.h:100
static long c_op()
c_op
Definition: built_ins.c:1698
static long c_ltoe()
c_ltoe
Definition: built_ins.c:770
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()
c_parse
Definition: built_ins.c:2013
void insert_system_builtins()
insert_system_builtins
Definition: bi_sys.c:744
static long c_page_width()
c_page_width
Definition: built_ins.c:3268
static long c_gtoe()
c_gtoe
Definition: built_ins.c:702
ptr_definition minus_symbol
Definition: def_glob.h:96
static long c_psi2string()
c_psi2string
Definition: built_ins.c:4894
ptr_definition xfx_sym
Definition: def_glob.h:126
static long c_repeat()
c_repeat
Definition: built_ins.c:1417
#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()
c_global_assign
Definition: built_ins.c:4379
static long c_split_double()
c_split_double
Definition: built_ins.c:4030
ptr_definition yf_sym
Definition: def_glob.h:124
ptr_definition disj_nil
Definition: def_glob.h:85
static long c_write_err()
c_write_err
Definition: built_ins.c:3135
static long c_apply()
c_apply
Definition: built_ins.c:1161
ptr_definition nullsym
Definition: def_glob.h:129
ptr_definition real
Definition: def_glob.h:102
static long c_writeq_err()
c_writeq_err
Definition: built_ins.c:3155
static long c_global()
c_global
Definition: built_ins.c:2562
static long c_get_choice()
c_get_choice
Definition: built_ins.c:1815
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()
c_writeq
Definition: built_ins.c:3194
ptr_definition eof
Definition: def_glob.h:86
long c_sub_string()
c_sub_string
Definition: built_ins.c:5777
#define TRUE
Definition: def_const.h:127
long all_public_symbols()
Definition: modules.c:1349
static long c_open_in()
c_open_in
Definition: built_ins.c:2770
static long c_dynamic()
c_dynamic
Definition: built_ins.c:1626
ptr_psi_term error_psi_term
Definition: def_glob.h:23
long c_string_length()
c_string_length
Definition: built_ins.c:5722
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()
c_non_strict
Definition: built_ins.c:1681
static long c_copy_term()
c_copy_term
Definition: built_ins.c:4510
static long c_undo()
c_undo
Definition: built_ins.c:4548
static long c_eval()
c_eval
Definition: built_ins.c:3941
static long c_nonvar()
c_nonvar
Definition: built_ins.c:1468
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_definition succeed
Definition: def_glob.h:104
long c_halt()
c_halt
Definition: built_ins.c:2209
static long c_disj()
c_disj
Definition: built_ins.c:3388
static long c_eval_disjunction()
c_eval_disjunction
Definition: built_ins.c:590
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()
c_succeed
Definition: built_ins.c:1401
static long c_and()
c_and
Definition: built_ins.c:1001
static long c_implies()
c_implies
Definition: built_ins.c:4714
char * weekday_attr
Definition: def_glob.h:259
ptr_definition disjunction
Definition: def_glob.h:84
static long c_strip()
c_strip
Definition: built_ins.c:3824
char * one
Definition: def_glob.h:250
static long c_put_err()
c_put_err
Definition: built_ins.c:3062
long c_private_feature()
Definition: modules.c:1288
static long c_or()
c_or
Definition: built_ins.c:1014
static long c_assert_last()
c_assert_last
Definition: built_ins.c:2417
ptr_definition add_module2
Definition: def_glob.h:68
ptr_definition life_or
Definition: def_glob.h:95
static long c_close()
c_close
Definition: built_ins.c:2933
static long c_read_token()
c_read_token
Definition: built_ins.c:2108
static long c_not()
c_not
Definition: built_ins.c:1027
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()
c_is_predicate
Definition: built_ins.c:1537
static long c_var()
static long c_var()
Definition: built_ins.c:1434
long c_alias()
Definition: modules.c:1164
long c_concatenate()
c_concatenate
Definition: built_ins.c:5573
static long c_is_function()
c_is_function
Definition: built_ins.c:1502
ptr_definition add_module1
Definition: def_glob.h:67
ptr_definition tracesym
Definition: def_glob.h:109
static long c_put()
c_put
Definition: built_ins.c:3046
static long c_eval_inplace()
c_eval_inplace
Definition: built_ins.c:3973
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()
c_not_implemented
Definition: built_ins.c:2297
long c_replace()
Definition: modules.c:917
static long c_chdir()
c_chdir
Definition: built_ins.c:4148
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()
c_bk_assign
Definition: built_ins.c:4283
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()
c_ops
Definition: built_ins.c:3781
int public
Definition: def_struct.h:94
static long c_set_input()
c_set_input
Definition: built_ins.c:2865
static long c_equal()
static long c_equal()
Definition: built_ins.c:508
ptr_definition type
Definition: def_struct.h:165
char * hour_attr
Definition: def_glob.h:256
static long c_setq()
c_setq
Definition: built_ins.c:2337
static long c_module_name()
c_module_name
Definition: built_ins.c:5656
ptr_definition xf_sym
Definition: def_glob.h:122
static long c_write_canonical()
c_write_canonical
Definition: built_ins.c:3214
static long c_gt()
c_gt
Definition: built_ins.c:440
static long c_load()
c_load
Definition: built_ins.c:1775
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()
c_print_depth
Definition: built_ins.c:3308
static long c_copy_pointer()
c_copy_pointer
Definition: built_ins.c:4478
static long c_feature_values()
c_feature_values
Definition: built_ins.c:3615
ptr_module set_current_module(ptr_module module)
Definition: modules.c:95
static long c_assert_first()
c_assert_first
Definition: built_ins.c:2387
static long c_print_variables()
c_print_variables
Definition: built_ins.c:1968
static long c_set_choice()
c_set_choice
Definition: built_ins.c:1854
ptr_definition call_handlersym
Definition: def_glob.h:121
static long c_set_output()
c_set_output
Definition: built_ins.c:2902
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()
c_such_that
Definition: built_ins.c:5007
ptr_definition typesym
Definition: def_glob.h:110
long is_built_in ( ptr_pair_list  r)

is_built_in

Parameters
ptr_pair_listr

Return TRUE if rules r are for a built-in

Definition at line 5114 of file built_ins.c.

References MAX_BUILT_INS.

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

list_special

Parameters
ptr_psi_termt

List the characteristics (delay_check, dynamic/static, non_strict) in such a way that they can be immediately read in.

Definition at line 5127 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, wl_definition::rule, TRUE, wl_psi_term::type, wl_definition::type_def, and type_it.

5128 {
5129  ptr_definition d = t->type;
5130  ptr_pair_list r = t->type->rule;
5131  long prflag=FALSE;
5132 
5133  if (t->type->type_def==(def_type)type_it) {
5134  if (!d->always_check) {
5135  if (is_built_in(r)) fprintf(output_stream,"%% ");
5136  fprintf(output_stream,"delay_check(");
5137  display_psi_stream(t);
5138  fprintf(output_stream,")?\n");
5139  prflag=TRUE;
5140  }
5141  } else {
5142  if (!d->protected) {
5143  if (is_built_in(r)) fprintf(output_stream,"%% ");
5144  fprintf(output_stream,"%s(",(d->protected?"static":"dynamic"));
5145  display_psi_stream(t);
5146  fprintf(output_stream,")?\n");
5147  prflag=TRUE;
5148  }
5149  }
5150  if (!d->evaluate_args) {
5151  if (is_built_in(r)) fprintf(output_stream,"%% ");
5152  fprintf(output_stream,"non_strict(");
5153  display_psi_stream(t);
5154  fprintf(output_stream,")?\n");
5155  prflag=TRUE;
5156  }
5157  /* if (prflag) fprintf(output_stream,"\n"); */
5158 }
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)
is_built_in
Definition: built_ins.c:5114
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 
)

make_feature_list

Parameters
ptr_nodetree
ptr_psi_termtail
ptr_modulemodule
intval

Definition at line 176 of file built_ins.c.

References wl_node::data, heap_alloc(), integer, wl_node::key, wl_node::left, make_feature_list(), REAL, real, wl_node::right, stack_cons(), stack_psi_term(), str_to_int(), and update_feature().

177 {
178  ptr_psi_term new;
179  ptr_definition def;
180  double d; // strtod();
181 
182 
183  if(tree) {
184  if(tree->right)
185  tail=make_feature_list(tree->right,tail,module,val);
186 
187  /* Insert the feature name into the list */
188 
189  d=str_to_int(tree->key);
190  if (d== -1) { /* Feature is not a number */
191  def=update_feature(module,tree->key); /* Extract module RM: Feb 3 1993 */
192  if(def) {
193  if(val) /* RM: Mar 3 1994 Distinguish between features & values */
194  tail=stack_cons((ptr_psi_term)tree->data,(ptr_psi_term)tail);
195  else {
196  new=stack_psi_term(4);
197  new->type=def;
198  tail=stack_cons((ptr_psi_term)new,(ptr_psi_term)tail);
199  }
200  }
201  }
202  else { /* Feature is a number */
203  if(val) /* RM: Mar 3 1994 Distinguish between features & values */
204  tail=stack_cons((ptr_psi_term)tree->data,(ptr_psi_term)tail);
205  else {
206  new=stack_psi_term(4);
207  new->type=(d==floor(d))?integer:real;
208  new->value_3=heap_alloc(sizeof(REAL));
209  *(REAL *)new->value_3=(REAL)d;
210  tail=stack_cons((ptr_psi_term)new,(ptr_psi_term)tail);
211  }
212  }
213 
214  if(tree->left)
215  tail=make_feature_list(tree->left,tail,module,val);
216  }
217 
218  return tail;
219 }
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
stack_cons
Definition: built_ins.c:46
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)
stack_psi_term
Definition: lefun.c:21
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)
make_feature_list
Definition: built_ins.c:176
ptr_definition update_feature(ptr_module module, char *feature)
Definition: modules.c:1315
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
ptr_node right
Definition: def_struct.h:184
void new_built_in ( ptr_module  m,
char *  s,
def_type  t,
long(*)()  r 
)

new_built_in

Parameters
ptr_modulem
char*s
def_typet
long(*r)()

NEW_BUILT_IN(m,s,t,r) Add a new built-in predicate or function. Used also in x_pred.c

M=module. S=string. T=type (function or predicate). R=address of C routine to call.

Definition at line 5371 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().

5372 {
5373  ptr_definition d;
5374  if (built_in_index >= MAX_BUILT_INS) {
5375  fprintf(stderr,"Too many primitives, increase MAX_BUILT_INS in extern.h\n");
5376  exit(EXIT_FAILURE);
5377  }
5378 
5379  if(m!=current_module) /* RM: Jan 13 1993 */
5380  (void)set_current_module(m);
5381 
5382  d=update_symbol(m,s); /* RM: Jan 8 1993 */
5383  d->type_def=t;
5384  built_in_index++;
5387 }
static long built_in_index
Definition: built_ins.c:16
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 
)

new_psi_term

Parameters
longnumargs
ptr_definitiontyp
ptr_psi_term**a1
ptr_psi_term**a2

Return a psi term with one or two args, and the addresses of the args

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

5061 {
5062  ptr_psi_term t;
5063  ptr_node n1, n2;
5064 
5065  if (numargs==2) {
5066  n2 = STACK_ALLOC(node);
5067  n2->key = two;
5068  *a2 = (ptr_psi_term *) &(n2->data);
5069  n2->left = NULL;
5070  n2->right = NULL;
5071  }
5072  else
5073  n2=NULL;
5074 
5075  n1 = STACK_ALLOC(node);
5076  n1->key = one;
5077  *a1 = (ptr_psi_term *) &(n1->data);
5078  n1->left = NULL;
5079  n1->right = n2;
5080 
5081  t=stack_psi_term(4);
5082  t->type = typ;
5083  t->attr_list = n1;
5084 
5085  return t;
5086 }
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)
stack_psi_term
Definition: lefun.c:21
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 ( )

one_attr

Return an attr_list with one argument

Definition at line 5038 of file built_ins.c.

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

5039 {
5040  ptr_node n;
5041 
5042  n = STACK_ALLOC(node);
5043  n->key = one;
5044  n->data = NULL; /* To be filled in later */
5045  n->left = NULL;
5046  n->right = NULL;
5047 
5048  return n;
5049 }
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 
)

only_arg1

Parameters
ptr_psi_termt
ptr_psi_term* arg1

Return TRUE iff t has only argument "1", and return the argument.

Definition at line 1606 of file built_ins.c.

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

1607 {
1608  ptr_node n=t->attr_list;
1609 
1610  if (n && n->left==NULL && n->right==NULL && !featcmp(n->key,one)) {
1611  *arg1=(ptr_psi_term)n->data;
1612  return TRUE;
1613  }
1614  else
1615  return FALSE;
1616 }
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

op_declare

Parameters
longp
operatort
char*s

OP_DECLARE(p,t,s) Declare that string S is an operator of precedence P and of type T where T=xf, fx, yf, fy, xfx etc...

Definition at line 5400 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().

5401 {
5402  ptr_definition d;
5403  ptr_operator_data od;
5404 
5405  if (p>MAX_PRECEDENCE || p<0) {
5406  Errorline("operator precedence must be in the range 0..%d.\n",
5407  MAX_PRECEDENCE);
5408  return;
5409  }
5410  d=update_symbol(NULL,s);
5411 
5412  od= (ptr_operator_data) heap_alloc (sizeof(operator_data));
5413  /* od= (ptr_operator_data) malloc (sizeof(operator_data)); 12.6 */
5414 
5415  od->precedence=p;
5416  od->type=t;
5417  od->next=d->op_data;
5418  d->op_data=od;
5419 }
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)
heap_alloc
Definition: memory.c:1616
void persistent_error_check ( ptr_node  n,
int *  error 
)

persistent_error_check

Definition at line 2712 of file built_ins.c.

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

2713 {
2714  if (n) {
2715  ptr_psi_term t;
2716  persistent_error_check(n->left, error);
2717 
2718  t=(ptr_psi_term)n->data;
2719  deref_ptr(t);
2720  if (t->type->type_def!=(def_type)undef && t->type->type_def!=(def_type)global) {
2721  Errorline("%T %P cannot be redeclared persistent (%E).\n",
2722  t->type->type_def,
2723  t);
2724  t->type=error_psi_term->type;
2725  *error=TRUE;
2726  }
2727 
2728  persistent_error_check(n->right, error);
2729  }
2730 }
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)
persistent_error_check
Definition: built_ins.c:2712
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)

persistent_one

Definition at line 2756 of file built_ins.c.

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

2757 {
2761 }
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)
heap_psi_term
Definition: lefun.c:75
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)

persistent_tree

Definition at line 2737 of file built_ins.c.

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

2738 {
2739  if (n) {
2740  ptr_psi_term t;
2741  persistent_tree(n->left);
2742 
2743  t=(ptr_psi_term)n->data;
2744  deref_ptr(t);
2745  persistent_one(t);
2746 
2747  persistent_tree(n->right);
2748  }
2749 }
void persistent_tree(ptr_node n)
persistent_tree
Definition: built_ins.c:2737
void persistent_one(ptr_psi_term t)
persistent_one
Definition: built_ins.c:2756
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 
)

pred_clause

Parameters
ptr_psi_termt
longr
ptr_psi_termg

PRED_CLAUSE(ptr_psi_term t,long r,ptr_psi_term g) Set about finding a clause that unifies with psi_term T. This routine is used both for CLAUSE and RETRACT. If R==TRUE then delete the first clause which unifies with T.

Definition at line 2452 of file built_ins.c.

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

2453 {
2454  long success=FALSE;
2455  ptr_psi_term head,body;
2456 
2457  bk_mark_quote(g); /* RM: Apr 7 1993 */
2458  if (t) {
2459  deref_ptr(t);
2460 
2461  if (!strcmp(t->type->keyword->symbol,"->")) {
2462  get_two_args(t->attr_list,&head,&body);
2463  if (head) {
2464  deref_ptr(head);
2465  if (head && body &&
2466  (head->type->type_def==(def_type)function_it || head->type->type_def==(def_type)undef))
2467  success=TRUE;
2468  }
2469  }
2470  else if (!strcmp(t->type->keyword->symbol,":-")) {
2471  get_two_args(t->attr_list,&head,&body);
2472  if (head) {
2473  deref_ptr(head);
2474  if (head &&
2475  (head->type->type_def==(def_type)predicate || head->type->type_def==(def_type)undef)) {
2476  success=TRUE;
2477  if (!body) {
2478  body=stack_psi_term(4);
2479  body->type=succeed;
2480  }
2481  }
2482  }
2483  }
2484  /* There is no body, so t is a fact */
2485  else if (t->type->type_def==(def_type)predicate || t->type->type_def==(def_type)undef) {
2486  head=t;
2487  body=stack_psi_term(4);
2488  body->type=succeed;
2489  success=TRUE;
2490  }
2491  }
2492 
2493  if (success) {
2494  if (r) {
2495  if (redefine(head))
2496  push_goal(del_clause,head,body,(GENERIC)&(head->type->rule));
2497  else
2498  success=FALSE;
2499  }
2500  else
2501  push_goal(clause,head,body,(GENERIC)&(head->type->rule));
2502  }
2503  else
2504  Errorline("bad argument in %s.\n", (r?"retract":"clause"));
2505 
2506  return success;
2507 }
#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)
get_two_args
Definition: login.c:47
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#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)
bk_mark_quote
Definition: copy.c:709
#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)
stack_psi_term
Definition: lefun.c:21
#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 
)

psi_to_string

Parameters
ptr_psi_termt
char** fn

PSI_TO_STRING(t,fn) Get the value of a Life string, or the name of a non-string psi-term. Return TRUE iff a valid string is found.

Definition at line 146 of file built_ins.c.

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

147 {
148  if (equal_types(t->type,quoted_string)) {
149  if (t->value_3) {
150  *fn = (char *) t->value_3;
151  return TRUE;
152  }
153  else {
154  *fn = quoted_string->keyword->symbol;
155  return TRUE;
156  }
157  }
158  else {
159  *fn = t->type->keyword->symbol;
160  return TRUE;
161  }
162 }
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

set_parse_queryflag

Parameters
ptr_nodethelist
longsort

Definition at line 1984 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().

1985 {
1986  ptr_node n; /* node pointing to argument 2 */
1987  ptr_psi_term arg; /* argumenrt 2 psi-term */
1988  ptr_psi_term queryflag; /* query term created by this function */
1989 
1990  n=find(FEATCMP,two,thelist);
1991  if (n) {
1992  /* there was a second argument */
1993  arg=(ptr_psi_term)n->data;
1994  queryflag=stack_psi_term(4);
1995  queryflag->type =
1997  ((sort==QUERY)?"query":
1998  ((sort==FACT)?"declaration":"error")));
1999  push_goal(unify,queryflag,arg,NULL);
2000  }
2001 }
#define FEATCMP
Definition: def_const.h:257
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
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)
stack_psi_term
Definition: lefun.c:21
#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 
)

stack_bytes

Parameters
char*s
intn

STACK_BYTES(s,n) create a STRING object given a sequence of bytes

Definition at line 128 of file built_ins.c.

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

129 {
131  t->type = quoted_string;
133  return t;
134 }
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)
stack_psi_term
Definition: lefun.c:21
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 
)

stack_cons

Parameters
ptr_psi_termhead
ptr_psi_termtail

STACK_CONS(head,tail) Create a CONS object.

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

47 {
49 
50  cons=stack_psi_term(4);
51  cons->type=alist;
52  if(head)
53  (void)stack_insert(FEATCMP,one,&(cons->attr_list),(GENERIC)head);
54  if(tail)
55  (void)stack_insert(FEATCMP,two,&(cons->attr_list),(GENERIC)tail);
56 
57  return cons;
58 }
#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)
stack_psi_term
Definition: lefun.c:21
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)

stack_int

Parameters
longn

STACK_INT(n) create an INT object

Definition at line 91 of file built_ins.c.

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

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

stack_nil

Create the NIL object on the stack.

Definition at line 26 of file built_ins.c.

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

28 {
29  ptr_psi_term empty;
30 
31  empty=stack_psi_term(4);
32  empty->type=nil;
33 
34  return empty;
35 }
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
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 
)

stack_pair

Parameters
ptr_psi_termleft
ptr_psi_termright

STACK_PAIR(left,right) create a PAIR object.

Definition at line 69 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)
stack_psi_term
Definition: lefun.c:21
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)

stack_string

Parameters
char*s

STACK_STRING(s) create a STRING object

Definition at line 109 of file built_ins.c.

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

110 {
112  t->type = quoted_string;
114  return t;
115 }
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)
stack_psi_term
Definition: lefun.c:21
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 
)

str_conc

Parameters
char*s1
char*s2

Definition at line 5492 of file built_ins.c.

References heap_alloc().

5493 {
5494  char *result;
5495 
5496  result=(char *)heap_alloc(strlen(s1)+strlen(s2)+1);
5497  sprintf(result,"%s%s",s1,s2);
5498 
5499  return result;
5500 }
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
char * sub_str ( char *  s,
long  p,
long  n 
)

sub_str

Parameters
char*s
longp
longn

Definition at line 5510 of file built_ins.c.

References heap_alloc().

5511 {
5512  char *result;
5513  long i;
5514  long l;
5515 
5516  l=strlen(s);
5517  if(p>l || p<0 || n<0)
5518  n=0;
5519  else
5520  if(p+n-1>l)
5521  n=l-p+1;
5522 
5523  result=(char *)heap_alloc(n+1);
5524  for(i=0;i<n;i++)
5525  *(result+i)= *(s+p+i-1);
5526 
5527  *(result+n)=0;
5528 
5529  return result;
5530 }
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
static void unify_bool ( ptr_psi_term  arg)
static

unify_bool

Parameters
ptr_psi_termarg

Definition at line 912 of file built_ins.c.

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

913 {
914  ptr_psi_term tmp;
915 
916  tmp=stack_psi_term(4);
917  tmp->type=boolean;
918  push_goal(unify,tmp,arg,(GENERIC)NULL);
919 }
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define NULL
Definition: def_const.h:203
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
#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 
)

unify_bool_result

Parameters
ptr_psi_termt
longv

UNIFY_BOOL_RESULT(t,v) Unify psi_term T to the boolean value V = TRUE or FALSE. This is used by built-in logical functions to return their result.

Definition at line 345 of file built_ins.c.

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

346 {
347  ptr_psi_term u;
348 
349  u=stack_psi_term(4);
350  u->type=v?lf_true:lf_false;
351  push_goal(unify,t,u,NULL);
352 
353  /* Completely commented out by Richard on Nov 25th 1993
354  What's *your* Birthday? Maybe you'd like a Birthday-Bug-Card!
355  tried restoring 2.07 DJD no effect on test suite - removed again 2.14 DJD
356 
357  if((GENERIC)t<heap_pointer) {
358  push_ptr_value(def_ptr,&(t->type));
359  if (v) {
360  t->type=lf_true;
361  t->status=0;
362  }
363  else {
364  t->type=lf_false;
365  t->status=0;
366  }
367 
368  i_check_out(t);
369  if (t->resid)
370  release_resid(t);
371  }
372  else {
373  warningline("the persistent term '%P' appears in a boolean constraint and cannot be refined\n",t);
374  }
375  / */
376 }
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define NULL
Definition: def_const.h:203
ptr_definition lf_true
Definition: def_glob.h:107
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
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 
)

unify_real_result

Parameters
ptr_psi_termt
REALv

UNIFY_REAL_RESULT(t,v) Unify psi_term T to the real value V. This is used by built-in arithmetic functions to return their result.

Definition at line 387 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(), wl_psi_term::resid, wl_psi_term::status, TRUE, wl_psi_term::type, wl_psi_term::value_3, and warningline().

388 {
389  long smaller;
390  long success=TRUE;
391 
392 #ifdef prlDEBUG
393  if (t->value_3) {
394  printf("*** BUG: value already present in UNIFY_REAL_RESULT\n");
395  }
396 #endif
397 
398  if((GENERIC)t<heap_pointer) { /* RM: Jun 8 1993 */
399  deref_ptr(t);
400  assert(t->value_3==NULL); /* 10.6 */
402  t->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
403  *(REAL *)t->value_3 = v;
404 
405  (void)matches(t->type,integer,&smaller);
406 
407  if (v==floor(v)){
408  if (!smaller) {
410  t->type=integer;
411  t->status=0;
412  }
413  }
414  else
415  if (smaller)
416  success=FALSE;
417 
418  if (success) {
419  (void)i_check_out(t);
420  if (t->resid)
421  release_resid(t);
422  }
423  }
424  else {
425  warningline("the persistent term '%P' appears in an arithmetic constraint and cannot be refined\n",t);
426  }
427 
428  return success;
429 }
ptr_residuation resid
Definition: def_struct.h:173
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
#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)
release_resid
Definition: lefun.c:445
#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)
i_check_out
Definition: lefun.c:1033
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
#define assert(N)
Definition: memory.c:113
#define int_ptr
Definition: def_const.h:172

Variable Documentation

long built_in_index =0
static

Definition at line 16 of file built_ins.c.