Wild Life  2.29
 All Data Structures Files Functions Variables Typedefs Macros
Functions
def_proto.h File Reference

Go to the source code of this file.

Functions

void insert_math_builtins ()
 insert math builtins into table More...
 
long c_trace ()
 trace More...
 
long c_tprove ()
 UNSURE. More...
 
long c_quiet ()
 
void setUnitList (GENERIC x)
 set static unitListElement More...
 
ptr_psi_term unitListValue ()
 make psi term from unitListElement More...
 
GENERIC unitListNext ()
 set unitListElement to NULL & return NULL More...
 
ptr_psi_term intListValue (ptr_int_list p)
 make psi term from ptr_int_list [->value_1] More...
 
GENERIC intListNext (ptr_int_list p)
 return p->next More...
 
ptr_psi_term quotedStackCopy (psi_term p)
 make psi term from unitListElement More...
 
ptr_psi_term residListGoalQuote (ptr_residuation p)
 
GENERIC residListNext (ptr_residuation p)
 
ptr_psi_term makePsiTerm (ptr_definition x)
 
ptr_psi_term makePsiList (GENERIC head, ptr_psi_term(*valueFunc)(), GENERIC(*nextFunc)())
 makePsiList More...
 
ptr_goal makeGoal (ptr_psi_term p)
 makeGoal More...
 
void insert_system_builtins ()
 insert_system_builtins More...
 
long c_isa_subsort ()
 long c_isa_subsort More...
 
long isValue (ptr_psi_term p)
 isValue(p) More...
 
long c_glb ()
 long c_glb More...
 
long c_lub ()
 long c_lub More...
 
void insert_type_builtins ()
 void insert_type_builtins More...
 
int isSubTypeValue (ptr_psi_term arg1, ptr_psi_term arg2)
 isSubTypeValue More...
 
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...
 
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...
 
long only_arg1 (ptr_psi_term t, ptr_psi_term *arg1)
 only_arg1 More...
 
long file_exists (char *s)
 file_exists 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...
 
long pred_clause (ptr_psi_term t, long r, ptr_psi_term g)
 pred_clause More...
 
void global_error_check (ptr_node n, int *error, int *eval2)
 global_error_check More...
 
void global_tree (ptr_node n)
 global_tree More...
 
void global_one (ptr_psi_term t)
 global_one 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...
 
long hidden_type (ptr_definition t)
 hidden_type More...
 
ptr_psi_term collect_symbols (long sel)
 collect_symbols 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...
 
void new_built_in (ptr_module m, char *s, def_type t, long(*r)())
 new_built_in 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...
 
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...
 
void init_copy ()
 init_copy More...
 
void clear_copy ()
 clear_copy More...
 
void insert_translation (ptr_psi_term a, ptr_psi_term b, long info)
 insert_translation More...
 
ptr_psi_term translate (ptr_psi_term a, long **infoptr)
 translate More...
 
ptr_psi_term exact_copy (ptr_psi_term t, long heap_flag)
 exact_copy More...
 
ptr_psi_term quote_copy (ptr_psi_term t, long heap_flag)
 quote_copy More...
 
ptr_psi_term eval_copy (ptr_psi_term t, long heap_flag)
 eval_copy More...
 
ptr_psi_term inc_heap_copy (ptr_psi_term t)
 inc_heap_copy More...
 
ptr_psi_term copy (ptr_psi_term t, long copy_flag, long heap_flag)
 copy More...
 
ptr_node distinct_tree (ptr_node t)
 distinct_tree More...
 
ptr_psi_term distinct_copy (ptr_psi_term t)
 distinct_copy More...
 
void mark_quote_c (ptr_psi_term t, long heap_flag)
 mark_quote_c More...
 
void mark_quote_tree_c (ptr_node n, long heap_flag)
 mark_quote_tree_c More...
 
void mark_eval (ptr_psi_term t)
 mark_eval More...
 
void mark_nonstrict (ptr_psi_term t)
 mark_nonstrict More...
 
void mark_quote_new2 (ptr_psi_term t)
 mark_quote_new2 More...
 
void mark_eval_new (ptr_psi_term t)
 mark_eval_new More...
 
void mark_eval_tree_new (ptr_node n)
 mark_eval_tree_new More...
 
void mark_quote_new (ptr_psi_term t)
 mark_quote_new More...
 
void mark_quote_tree_new (ptr_node n)
 mark_quote_tree_new More...
 
void mark_quote (ptr_psi_term t)
 mark_quote More...
 
void mark_quote_tree (ptr_node t)
 mark_quote_tree More...
 
void bk_mark_quote (ptr_psi_term t)
 bk_mark_quote More...
 
void bk_mark_quote_tree (ptr_node t)
 bk_mark_quote_tree More...
 
void stack_info (FILE *outfile)
 
void outputline (char *format,...)
 
void traceline (char *format,...)
 
void infoline (char *format,...)
 
void warningline (char *format,...)
 
void Errorline (char *format,...)
 
void Syntaxerrorline (char *format,...)
 
void vinfoline (char *format, FILE *outfile,...)
 
void init_trace ()
 
void reset_step ()
 
void tracing ()
 
void new_trace (long newtrace)
 
void new_step (long newstep)
 
void set_trace_to_prove ()
 
void toggle_trace ()
 
void toggle_step ()
 
void perr (char *str)
 
void perr_s (char *s1, char *s2)
 
void perr_s2 (char *s1, char *s2, char *s3)
 
void perr_i (char *str, long i)
 
long warning ()
 
long warningx ()
 
void report_error_main (ptr_psi_term g, char *s, char *s2)
 
void report_error (ptr_psi_term g, char *s)
 
long reportAndAbort (ptr_psi_term g, char *s)
 
void report_warning (ptr_psi_term g, char *s)
 
void report_error2_main (ptr_psi_term g, char *s, char *s2)
 
void report_error2 (ptr_psi_term g, char *s)
 
void report_warning2 (ptr_psi_term g, char *s)
 
void nonnum_warning (ptr_psi_term t, ptr_psi_term arg1, ptr_psi_term arg2)
 
long nonint_warning (ptr_psi_term arg, REAL val, char *msg)
 
long bit_and_warning (ptr_psi_term arg, REAL val)
 
long bit_or_warning (ptr_psi_term arg, REAL val)
 
long bit_not_warning (ptr_psi_term arg, REAL val)
 
long int_div_warning (ptr_psi_term arg, REAL val)
 
long mod_warning (ptr_psi_term arg, REAL val, int zero)
 
long shift_warning (long dir, ptr_psi_term arg, REAL val)
 
ptr_hash_table hash_create (int size)
 HASH_CREATE. More...
 
void hash_expand (ptr_hash_table table, int new_size)
 HASH_EXPAND. More...
 
int hash_code (ptr_hash_table table, char *symbol)
 HASH_CODE. More...
 
int hash_find (ptr_hash_table table, char *symbol)
 hash_find More...
 
ptr_keyword hash_lookup (ptr_hash_table table, char *symbol)
 HASH_LOOKUP. More...
 
void hash_insert (ptr_hash_table table, char *symbol, ptr_keyword keyword)
 HASH_INSERT. More...
 
void hash_display (ptr_hash_table table)
 HASH_DISPLAY. More...
 
void title ()
 TITLE. More...
 
void interrupt ()
 INTERRUPT() More...
 
void init_interrupt ()
 INIT_INTERRUPT. More...
 
void handle_interrupt ()
 HANDLE_INTERRUPT. More...
 
ptr_psi_term stack_psi_term (long stat)
 stack_psi_term More...
 
ptr_psi_term real_stack_psi_term (long stat, REAL thereal)
 real_stack_psi_term More...
 
ptr_psi_term heap_psi_term (long stat)
 heap_psi_term More...
 
void residuate_double (ptr_psi_term t, ptr_psi_term u)
 residuate_double More...
 
void residuate (ptr_psi_term t)
 residuate More...
 
void residuate2 (ptr_psi_term u, ptr_psi_term v)
 residuate2 More...
 
void residuate3 (ptr_psi_term u, ptr_psi_term v, ptr_psi_term w)
 residuate3 More...
 
void curry ()
 curry More...
 
long residuateGoalOnVar (ptr_goal g, ptr_psi_term var, ptr_psi_term othervar)
 residuateGoalOnVar More...
 
long do_residuation_user ()
 do_residuation_user() More...
 
long do_residuation ()
 do_residuation More...
 
void do_currying ()
 do_currying More...
 
void release_resid_main (ptr_psi_term t, long trailflag)
 release_resid_main More...
 
void release_resid (ptr_psi_term t)
 release_resid More...
 
void release_resid_notrail (ptr_psi_term t)
 release_resid_notrail More...
 
void append_resid (ptr_psi_term u, ptr_psi_term v)
 append_resid More...
 
long eval_aim ()
 eval_aim More...
 
void match_attr1 (ptr_node *u, ptr_node v, ptr_resid_block rb)
 void match_attr1 More...
 
void match_attr2 (ptr_node *u, ptr_node v, ptr_resid_block rb)
 match_attr2 More...
 
void match_attr3 (ptr_node *u, ptr_node v, ptr_resid_block rb)
 match_attr3 More...
 
void match_attr (ptr_node *u, ptr_node v, ptr_resid_block rb)
 match_attr More...
 
long match_aim ()
 match_aim More...
 
long i_eval_args (ptr_node n)
 i_eval_args More...
 
long eval_args (ptr_node n)
 eval_args More...
 
void check_disj (ptr_psi_term t)
 check_disj More...
 
void check_func (ptr_psi_term t)
 check_func More...
 
long check_type (ptr_psi_term t)
 check_type More...
 
long i_check_out (ptr_psi_term t)
 i_check_out More...
 
long f_check_out (ptr_psi_term t)
 f_check_out More...
 
long check_out (ptr_psi_term t)
 
long deref_eval (ptr_psi_term t)
 deref_eval More...
 
long deref_rec_eval (ptr_psi_term t)
 deref_rec_eval More...
 
void deref_rec_body (ptr_psi_term t)
 deref_rec_body More...
 
void deref_rec_args (ptr_node n)
 deref_rec_args More...
 
long deref_args_eval (ptr_psi_term t, long set)
 deref_args_eval More...
 
long in_set (char *str, long set)
 in_set More...
 
void deref_rec_args_exc (ptr_node n, long set)
 deref_rec_args_exc More...
 
void deref2_eval (ptr_psi_term t)
 deref2_eval More...
 
void deref2_rec_eval (ptr_psi_term t)
 deref2_rec_eval More...
 
void save_resid (ptr_resid_block rb, ptr_psi_term match_date)
 save_resid More...
 
void restore_resid (ptr_resid_block rb, ptr_psi_term *match_date)
 restore_resid More...
 
void eval_global_var (ptr_psi_term t)
 eval_global_var More...
 
void init_global_vars ()
 init_global_vars More...
 
char ** group_features (char **f, ptr_node n)
 group_features More...
 
void exit_if_true (long exitflag)
 exit_if_true More...
 
void init_io ()
 void init_io More...
 
void init_system ()
 init_system More...
 
void WFInit (long argc, char **argv)
 
int WFInput (char *query)
 WFInput. More...
 
PsiTerm WFGetVar (char *name)
 WFGetVar. More...
 
int WFfeature_count_loop (ptr_node n)
 WFfeature_count_loop. More...
 
int WFFeatureCount (ptr_psi_term psi)
 WFFeatureCount. More...
 
char * WFType (ptr_psi_term psi)
 WFType. More...
 
char ** WFFeatures (ptr_psi_term psi)
 WFFeatures. More...
 
double WFGetDouble (ptr_psi_term psi, int *ok)
 WFGetDouble. More...
 
char * WFGetString (ptr_psi_term psi, int *ok)
 WFGetString. More...
 
PsiTerm WFGetFeature (ptr_psi_term ps, char *feature)
 WFGetFeature. More...
 
int main (int argc, char *argv[])
 main More...
 
void List_SetLinkProc (RefListHeader header, RefListGetLinksProc getLinks)
 List_SetLinkProc. More...
 
void List_InsertAhead (RefListHeader header, Ref atom)
 List_InsertAhead. More...
 
void List_Append (RefListHeader header, Ref atom)
 void List_Append More...
 
void List_InsertBefore (RefListHeader header, Ref atom, Ref mark)
 List_InsertBefore. More...
 
void List_InsertAfter (RefListHeader header, Ref atom, Ref mark)
 List_InsertAfter. More...
 
void List_Swap (RefListHeader header, Ref first, Ref second)
 List_Swap. More...
 
void List_Reverse (RefListHeader header)
 List_Reverse. More...
 
void List_Remove (RefListHeader header, Ref atom)
 List_Remove. More...
 
void List_Concat (RefListHeader header1, RefListHeader header2)
 List_Concat. More...
 
long List_EnumFrom (RefListHeader header, Ref atom, RefListEnumProc proc, Ref closure)
 List_EnumFrom. More...
 
long List_Enum (RefListHeader header, RefListEnumProc proc, Ref closure)
 List_Enum. More...
 
long List_EnumBackFrom (RefListHeader header, Ref atom, RefListEnumProc proc, Ref closure)
 List_EnumBackFrom. More...
 
long List_EnumBack (RefListHeader header, RefListEnumProc proc, Ref closure)
 List_EnumBack. More...
 
long List_Card (RefListHeader header)
 List_Card. More...
 
long List_IsUnlink (RefListLinks links)
 List_IsUnlink. More...
 
void List_Cut (RefListHeader header, Ref atom, RefListHeader newHeader)
 List_Cut. More...
 
void get_two_args (ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
 get_two_args More...
 
void get_one_arg (ptr_node t, ptr_psi_term *a)
 get_one_arg More...
 
void get_one_arg_addr (ptr_node t, ptr_psi_term **a)
 get_one_arg_addr More...
 
void add_rule (ptr_psi_term head, ptr_psi_term body, def_type typ)
 add_rule More...
 
void assert_rule (psi_term t, def_type typ)
 assert_rule More...
 
void assert_clause (ptr_psi_term t)
 assert_clause More...
 
void start_chrono ()
 start_chrono More...
 
void push_ptr_value (type_ptr t, GENERIC *p)
 push_ptr_value More...
 
void push_def_ptr_value (ptr_psi_term q, GENERIC *p)
 push_def_ptr_value More...
 
void push_psi_ptr_value (ptr_psi_term q, GENERIC *p)
 push_psi_ptr_value More...
 
void push_ptr_value_global (type_ptr t, GENERIC *p)
 push_ptr_value_global More...
 
void push_window (long type, long disp, long wind)
 push_window More...
 
void push2_ptr_value (type_ptr t, GENERIC *p, GENERIC v)
 push2_ptr_value More...
 
void push_goal (goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
 push_goal More...
 
void push_choice_point (goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
 push_choice_point More...
 
void undo (ptr_stack limit)
 undo More...
 
void undo_actions ()
 undo_actions More...
 
void backtrack ()
 backtrack More...
 
void clean_undo_window (long disp, long wind)
 clean_undo_window More...
 
void merge1 (ptr_node *u, ptr_node v)
 merge1 More...
 
void merge2 (ptr_node *u, ptr_node v)
 merge2 More...
 
void merge3 (ptr_node *u, ptr_node v)
 merge3 More...
 
void merge (ptr_node *u, ptr_node v)
 merge More...
 
void merge_unify (ptr_node *u, ptr_node v)
 
void show_count ()
 show_count More...
 
void fetch_def (ptr_psi_term u, long allflag)
 fetch_def More...
 
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 More...
 
long unify_aim_noeval ()
 unify_aim_noeval More...
 
long unify_aim ()
 unify_aim More...
 
long unify_body (long eval_flag)
 unify_body More...
 
long disjunct_aim ()
 disjunct_aim More...
 
long prove_aim ()
 prove_aim More...
 
void type_disj_aim ()
 type_disj_aim More...
 
long clause_aim (long r)
 clause_aim More...
 
long no_choices ()
 no_choices More...
 
long num_choices ()
 num_choices More...
 
long num_vars (ptr_node vt)
 num_vars More...
 
long what_next_cut ()
 what_next_cut More...
 
ptr_choice_point topmost_what_next ()
 topmost_what_next More...
 
void reset_stacks ()
 reset_stacks More...
 
long what_next_aim ()
 what_next_aim More...
 
long load_aim ()
 load_aim More...
 
void main_prove ()
 main_prove More...
 
int dummy_printf (char *f, char *s, char *t)
 dummy_printf More...
 
long trail_condition (psi_term *Q)
 trail_condition More...
 
ptr_int_list appendIntList (ptr_int_list tail, ptr_int_list more)
 appendIntList More...
 
void mark_ancestors (ptr_definition def, long *flags)
 mark_ancestors More...
 
ptr_int_list lub (ptr_psi_term a, ptr_psi_term b, ptr_psi_term *pp)
 
char * GetStrOption (char *name, char *def)
 GetStrOption. More...
 
int GetBoolOption (char *name)
 GetBoolOption. More...
 
int GetIntOption (char *name, int def)
 GetIntOption. More...
 
void pchoices ()
 pchoices More...
 
void print_undo_stack ()
 print_undo_stack More...
 
long bounds_undo_stack ()
 bounds_undo_stack More...
 
void fail_all ()
 fail_all More...
 
void check_hash_table (ptr_hash_table table)
 check_hash_table More...
 
void check_definition (ptr_definition *d)
 check_definition More...
 
void check_definition_list ()
 check_definition_list More...
 
void check_resid_block (ptr_resid_block *rb)
 check_resid_block More...
 
void check_psi_term (ptr_psi_term *t)
 check_psi_term More...
 
void check_attr (ptr_node *n)
 check_attr More...
 
void check_gamma_code ()
 check_gamma_code More...
 
void print_gc_info (long timeflag)
 print_gc_info More...
 
void garbage ()
 garbage More...
 
GENERIC heap_alloc (long s)
 heap_alloc More...
 
GENERIC stack_alloc (long s)
 stack_alloc More...
 
void init_memory ()
 init_memory () More...
 
long memory_check ()
 memory_check More...
 
void init_modules ()
 init_modules More...
 
ptr_module find_module (char *module)
 find_module More...
 
ptr_module create_module (char *module)
 ptr_module create_module(char *module) More...
 
ptr_module set_current_module (ptr_module module)
 set_current_module More...
 
ptr_module extract_module_from_name (char *str)
 extract_module_from_name More...
 
char * strip_module_name (char *str)
 strip_module_name More...
 
char * string_val (ptr_psi_term term)
 string_val More...
 
char * make_module_token (ptr_module module, char *str)
 make_module_token More...
 
ptr_definition new_definition (ptr_keyword key)
 new_definition More...
 
ptr_definition update_symbol (ptr_module module, char *symbol)
 update_symbol More...
 
char * print_symbol (ptr_keyword k)
 print_symbol More...
 
void pretty_symbol (ptr_keyword k)
 pretty_symbol More...
 
void pretty_quote_symbol (ptr_keyword k)
 pretty_quote_symbol More...
 
long c_set_module ()
 c_set_module More...
 
long c_open_module ()
 c_open_module More...
 
void open_module_tree (ptr_node n, int *onefailed)
 open_module_tree More...
 
void open_module_one (ptr_psi_term t, int *onefailed)
 open_module_one More...
 
long make_public (ptr_psi_term term, long bool)
 make_public More...
 
void traverse_tree (ptr_node n, int flag)
 traverse_tree More...
 
long c_public ()
 c_public More...
 
long c_private ()
 c_private More...
 
long c_display_modules ()
 c_display_modules More...
 
long c_display_persistent ()
 c_display_persistent More...
 
long c_trace_input ()
 c_trace_input More...
 
void replace (ptr_definition old, ptr_definition new, ptr_psi_term term)
 replace More...
 
void rec_replace (ptr_definition old, ptr_definition new, ptr_psi_term term)
 rec_replace More...
 
void replace_attr (ptr_node old_attr, ptr_psi_term term, ptr_definition old, ptr_definition new)
 replace_attr More...
 
long c_replace ()
 c_replace More...
 
long c_current_module ()
 c_current_module More...
 
long c_module_access ()
 c_module_access More...
 
int global_unify (ptr_psi_term u, ptr_psi_term v)
 global_unify More...
 
int global_unify_attr (ptr_node u, ptr_node v)
 global_unify_attr More...
 
long c_alias ()
 c_alias More...
 
int get_module (ptr_psi_term psi, ptr_module *module)
 get_module More...
 
int make_feature_private (ptr_psi_term term)
 make_feature_private More...
 
long c_private_feature ()
 c_private_feature More...
 
ptr_definition update_feature (ptr_module module, char *feature)
 update_feature More...
 
long all_public_symbols ()
 all_public_symbols More...
 
int bad_psi_term (ptr_psi_term t)
 bad_psi_term More...
 
void show (long limit)
 show More...
 
void push (psi_term tok, long prec, long op)
 push More...
 
long pop (ptr_psi_term tok, long *op)
 pop More...
 
long look ()
 look More...
 
long precedence (psi_term tok, long typ)
 precedence More...
 
ptr_psi_term stack_copy_psi_term (psi_term t)
 stack_copy_psi_term More...
 
ptr_psi_term heap_copy_psi_term (psi_term t)
 heap_copy_psi_term More...
 
void feature_insert (char *keystr, ptr_node *tree, ptr_psi_term psi)
 feature_insert More...
 
psi_term list_nil (ptr_definition type)
 list_nil More...
 
psi_term parse_list (ptr_definition typ, char e, char s)
 parse_list More...
 
psi_term read_psi_term ()
 read_psi_term More...
 
psi_term make_life_form (ptr_psi_term tok, ptr_psi_term arg1, ptr_psi_term arg2)
 make_life_form More...
 
void crunch (long prec, long limit)
 crunch More...
 
psi_term read_life_form (char ch1, char ch2)
 read_life_form More...
 
psi_term parse (long *q)
 parse More...
 
void init_print ()
 init_print More...
 
char * heap_nice_name ()
 heap_nice_name More...
 
GENERIC unique_name ()
 unique_name More...
 
long str_to_int (char *s)
 str_to_int More...
 
void print_bin (long b)
 print_bin More...
 
void print_code (FILE *s, ptr_int_list c)
 print_code More...
 
void print_operator_kind (FILE *s, long kind)
 print_operator_kind More...
 
void check_pointer (ptr_psi_term p)
 check_pointer More...
 
void go_through_tree (ptr_node t)
 go_through_tree More...
 
void go_through (ptr_psi_term t)
 go_through More...
 
void insert_variables (ptr_node vars, long force)
 insert_variables More...
 
void forbid_variables (ptr_node n)
 
void prettyf_inner (char *s, long q, char c)
 prettyf_inner More...
 
long starts_nonlower (char *s)
 starts_nonlower More...
 
long has_non_alpha (char *s)
 has_non_alpha More...
 
long all_symbol (char *s)
 all_symbol More...
 
long is_integer (char *s)
 is_integer More...
 
long no_quote (char *s)
 no_quote More...
 
void prettyf (char *s)
 prettyf More...
 
void prettyf_quoted_string (char *s)
 prettyf_quoted_string More...
 
void prettyf_quote (char *s)
 prettyf_quote More...
 
void end_tab ()
 end_tab More...
 
void mark_tab (ptr_tab_brk t)
 mark_tab More...
 
void new_tab (ptr_tab_brk *t)
 new_tab More...
 
long strpos (long pos, char *str)
 strpos More...
 
void work_out_length ()
 work_out_length More...
 
long count_features (ptr_node t)
 count_features More...
 
long check_legal_cons (ptr_psi_term t, ptr_definition t_type)
 check_legal_cons More...
 
void pretty_list (ptr_psi_term t, long depth)
 pretty_list More...
 
void pretty_tag_or_psi_term (ptr_psi_term p, long sprec, long depth)
 pretty_tag_or_psi_term More...
 
long check_opargs (ptr_node n)
 check_opargs More...
 
long opcheck (ptr_psi_term t, long *prec, long *type)
 opcheck More...
 
long pretty_psi_with_ops (ptr_psi_term t, long sprec, long depth)
 pretty_psi_with_ops More...
 
void pretty_psi_term (ptr_psi_term t, long sprec, long depth)
 pretty_psi_term More...
 
void do_pretty_attr (ptr_node t, ptr_tab_brk tab, long *cnt, long two, long depth)
 do_pretty_attr More...
 
long two_or_more (ptr_node t)
 two_or_more More...
 
void pretty_attr (ptr_node t, long depth)
 pretty_attr More...
 
void pretty_output ()
 pretty_output More...
 
void pretty_variables (ptr_node n, ptr_tab_brk tab)
 pretty_variables More...
 
long print_variables (long printflag)
 print_variables More...
 
void write_attributes (ptr_node n, ptr_tab_brk tab)
 write_attributes More...
 
void listing_pred_write (ptr_node n, long fflag)
 listing_pred_write More...
 
void pred_write (ptr_node n)
 pred_write More...
 
void main_pred_write (ptr_node n)
 main_pred_write More...
 
void display_psi_stdout (ptr_psi_term t)
 display_psi_stdout More...
 
void display_psi_stderr (ptr_psi_term t)
 display_psi_stderr More...
 
void display_psi_stream (ptr_psi_term t)
 display_psi_stream More...
 
void display_psi (FILE *s, ptr_psi_term t)
 display_psi More...
 
void main_display_psi_term (ptr_psi_term t)
 main_display_psi_term More...
 
void display_couple (ptr_psi_term u, char *s, ptr_psi_term v)
 display_couple More...
 
void print_resid_message (ptr_psi_term t, ptr_resid_list r)
 print_resid_message More...
 
long c_begin_raw ()
 c_begin_raw More...
 
long c_get_raw ()
 c_get_raw More...
 
long c_put_raw ()
 c_put_raw More...
 
long c_end_raw ()
 c_end_raw More...
 
long c_in_raw ()
 
long c_window_flag ()
 c_window_flag More...
 
long c_reset_window_flag ()
 c_reset_window_flag More...
 
void raw_setup_builtins ()
 raw_setup_builtins More...
 
long call_primitive (long(*fun)(), int num, psi_arg argi[], GENERIC info)
 call_primitive More...
 
ptr_psi_term fileptr2stream (FILE *fp, ptr_definition typ)
 fileptr2stream More...
 
int text_buffer_next (struct text_buffer *buf, int idx, char c, struct text_buffer **rbuf, int *ridx)
 text_buffer_next More...
 
char * text_buffer_cmp (struct text_buffer *buf, int idx, char *str)
 text_buffer_cmp More...
 
void text_buffer_push (struct text_buffer **buf, char c)
 text_buffer_push More...
 
void text_buffer_free (struct text_buffer *buf)
 text_buffer_free More...
 
int is_ipaddr (char *s)
 is_ipaddr More...
 
void make_sys_type_links ()
 make_sys_type_links More...
 
void check_sys_definitions ()
 check_sys_definitions More...
 
void insert_sys_builtins ()
 insert_sys_builtins More...
 
void insert_dbm_builtins ()
 
long get_arg (ptr_psi_term g, ptr_psi_term *arg, char *number)
 get_arg More...
 
void TOKEN_ERROR (ptr_psi_term p)
 TOKEN_ERROR. More...
 
void stdin_cleareof ()
 stdin_cleareof More...
 
void heap_add_int_attr (ptr_psi_term t, char *attrname, long value)
 heap_add_int_attr More...
 
void stack_add_int_attr (ptr_psi_term t, char *attrname, long value)
 stack_add_int_attr More...
 
void heap_mod_int_attr (ptr_psi_term t, char *attrname, long value)
 heap_mod_int_attr More...
 
void heap_add_str_attr (ptr_psi_term t, char *attrname, char *str)
 heap_add_str_attr More...
 
void stack_add_str_attr (ptr_psi_term t, char *attrname, char *str)
 stack_add_str_attr More...
 
void heap_mod_str_attr (ptr_psi_term t, char *attrname, char *str)
 heap_mod_str_attr More...
 
void heap_add_psi_attr (ptr_psi_term t, char *attrname, ptr_psi_term g)
 heap_add_psi_attr More...
 
void stack_add_psi_attr (ptr_psi_term t, char *attrname, ptr_psi_term g)
 stack_add_psi_attr More...
 
void bk_stack_add_psi_attr (ptr_psi_term t, char *attrname, ptr_psi_term g)
 bk_stack_add_psi_attr More...
 
GENERIC get_attr (ptr_psi_term t, char *attrname)
 get_attr More...
 
FILE * get_stream (ptr_psi_term t)
 get_stream More...
 
void save_state (ptr_psi_term t)
 save_state More...
 
void restore_state (ptr_psi_term t)
 restore_state More...
 
void new_state (ptr_psi_term *t)
 new_state More...
 
void save_parse_state (ptr_parse_block pb)
 save_parse_state More...
 
void restore_parse_state (ptr_parse_block pb)
 restore_parse_state More...
 
void init_parse_state ()
 init_parse_state More...
 
void begin_terminal_io ()
 begin_terminal_io More...
 
void end_terminal_io ()
 end_terminal_io More...
 
char * expand_file_name (char *s)
 expand_file_name More...
 
long open_input_file (char *file)
 open_input_file More...
 
long open_output_file (char *file)
 
long read_char ()
 read_char More...
 
void put_back_char (long c)
 put_back_char More...
 
void put_back_token (psi_term t)
 put_back_token More...
 
void psi_term_error ()
 psi_term_error More...
 
void read_comment (ptr_psi_term tok)
 read_comment More...
 
void read_string_error (int n)
 read_string_error More...
 
int base2int (int n)
 base2int More...
 
void read_string (ptr_psi_term tok, long e)
 read_string More...
 
long symbolic (long c)
 symbolic More...
 
long legal_in_name (long c)
 legal_in_name More...
 
void read_name (ptr_psi_term tok, long ch, long(*f)(), ptr_definition typ)
 
void read_number (ptr_psi_term tok, long c)
 read_number More...
 
void read_token (ptr_psi_term tok)
 read_token More...
 
void read_token_b (ptr_psi_term tok)
 read_token_b More...
 
void read_token_main (ptr_psi_term tok, long for_parser)
 read_token_main More...
 
long intcmp (long a, long b)
 intcmp More...
 
long is_int (char **s, long *len, long *sgn)
 is_int More...
 
long featcmp (char *str1, char *str2)
 featcmp More...
 
char * heap_ncopy_string (char *s, int n)
 heap_ncopy_string More...
 
char * heap_copy_string (char *s)
 heap_copy_string More...
 
char * stack_copy_string (char *s)
 stack_copy_string More...
 
ptr_node general_insert (long comp, char *keystr, ptr_node *tree, GENERIC info, long heapflag, long copystr, long bkflag)
 ptr_node general_insert More...
 
void heap_insert_copystr (char *keystr, ptr_node *tree, GENERIC info)
 heap_insert_copystr More...
 
void stack_insert_copystr (char *keystr, ptr_node *tree, GENERIC info)
 stack_insert_copystr More...
 
ptr_node heap_insert (long comp, char *keystr, ptr_node *tree, GENERIC info)
 heap_insert More...
 
ptr_node stack_insert (long comp, char *keystr, ptr_node *tree, GENERIC info)
 stack_insert More...
 
ptr_node bk_stack_insert (long comp, char *keystr, ptr_node *tree, GENERIC info)
 bk_stack_insert More...
 
ptr_node bk2_stack_insert (long comp, char *keystr, ptr_node *tree, GENERIC info)
 bk2_stack_insert More...
 
ptr_node find (long comp, char *keystr, ptr_node tree)
 find More...
 
ptr_node find_data (GENERIC p, ptr_node t)
 find_data More...
 
void delete_attr (char *s, ptr_node *n)
 delete_attr More...
 
void print_def_type (def_type t)
 print_def_type More...
 
long yes_or_no ()
 yes_or_no More...
 
void remove_cycles (ptr_definition d, ptr_int_list *dl)
 remove_cycles More...
 
long redefine (ptr_psi_term t)
 redefine More...
 
ptr_int_list cons (GENERIC v, ptr_int_list l)
 cons More...
 
long assert_less (ptr_psi_term t1, ptr_psi_term t2)
 assert_less More...
 
void assert_protected (ptr_node n, long prot)
 assert_protected More...
 
void assert_args_not_eval (ptr_node n)
 assert_args_not_eval More...
 
void assert_delay_check (ptr_node n)
 assert_delay_check More...
 
void clear_already_loaded (ptr_node n)
 clear_already_loaded More...
 
void assert_type (ptr_psi_term t)
 assert_type More...
 
void assert_complicated_type (ptr_psi_term t)
 assert_complicated_type More...
 
void assert_attributes (ptr_psi_term t)
 assert_attributes More...
 
void find_adults ()
 find_adults More...
 
void insert_own_prop (ptr_definition d)
 insert_own_prop More...
 
void insert_prop (ptr_definition d, ptr_triple_list prop)
 insert_prop More...
 
void propagate_definitions ()
 propagate_definitions More...
 
long count_sorts (long c0)
 count_sorts More...
 
void clear_coding ()
 clear_coding More...
 
void least_sorts ()
 void least_sorts() More...
 
void all_sorts ()
 all_sorts More...
 
ptr_int_list two_to_the (long p)
 two_to_the More...
 
ptr_int_list copyTypeCode (ptr_int_list u)
 copyTypeCode More...
 
void or_codes (ptr_int_list u, ptr_int_list v)
 or_codes More...
 
void equalize_codes (int len)
 equalize_codes More...
 
void make_type_link (ptr_definition t1, ptr_definition t2)
 make_type_link More...
 
long type_member (ptr_definition t, ptr_int_list tlst)
 type_member More...
 
void perr_sort (ptr_definition d)
 perr_sort More...
 
void perr_sort_list (ptr_int_list anc)
 perr_sort_list More...
 
void perr_sort_cycle (ptr_int_list anc)
 perr_sort_cycle More...
 
long type_cyclicity (ptr_definition d, ptr_int_list anc)
 type_cyclicity More...
 
void propagate_always_check (ptr_definition d, long *ch)
 propagate_always_check More...
 
void one_pass_always_check (long *ch)
 one_pass_always_check More...
 
void inherit_always_check ()
 inherit_always_check More...
 
void encode_types ()
 encode_types More...
 
void print_codes ()
 print_codes More...
 
long glb_value (long result, long f, GENERIC c, GENERIC value1, GENERIC value2, GENERIC *value)
 glb_value More...
 
long glb_code (long f1, GENERIC c1, long f2, GENERIC c2, long *f3, GENERIC *c3)
 glb_code More...
 
long glb (ptr_definition t1, ptr_definition t2, ptr_definition *t3, ptr_int_list *c3)
 glb More...
 
long overlap_type (ptr_definition t1, ptr_definition t2)
 overlap_type More...
 
long sub_CodeType (ptr_int_list c1, ptr_int_list c2)
 sub_CodeType More...
 
long sub_type (ptr_definition t1, ptr_definition t2)
 sub_type More...
 
long matches (ptr_definition t1, ptr_definition t2, long *smaller)
 matches More...
 
long strict_matches (ptr_psi_term t1, ptr_psi_term t2, long *smaller)
 strict_matches More...
 
long bit_length (ptr_int_list c)
 bit_length More...
 
ptr_int_list decode (ptr_int_list c)
 decode More...
 
ptr_goal GoalFromPsiTerm (ptr_psi_term psiTerm)
 

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()
stdin_cleareof
Definition: token.c:51
unsigned long * GENERIC
Definition: def_struct.h:17
void add_rule ( ptr_psi_term  head,
ptr_psi_term  body,
def_type  typ 
)

add_rule

Parameters
ptr_psi_termhead
ptr_psi_termbody
def_typetyp

ADD_RULE(head,body,typ) The TYP argument is either 'predicate', 'function', or 'type'. For predicates or functions, insert the clause 'HEAD :- BODY' or the rule 'HEAD -> BODY' into the definition of HEAD. For types, insert HEAD as a term of type attributes and BODY as a type constraint. The global flag ASSERT_FIRST indicates whether to do the insertion at the head or the tail of the existing list.

Definition at line 167 of file login.c.

References wl_pair_list::aaaa_2, assert_first, assert_ok, wl_psi_term::attr_list, wl_pair_list::bbbb_2, clear_copy(), wl_keyword::combined_name, wl_psi_term::coref, current_module, deref_ptr, Errorline(), HEAP, HEAP_ALLOC, wl_definition::keyword, MAX_BUILT_INS, wl_module::module_name, wl_pair_list::next, NULL, predicate, quote_copy(), redefine(), wl_psi_term::resid, wl_definition::rule, succeed, wl_keyword::symbol, TRUE, wl_psi_term::type, wl_definition::type_def, undef, and wl_psi_term::value_3.

168 {
169  psi_term succ;
170  ptr_psi_term head2;
171  ptr_definition def;
172  ptr_pair_list p, *p2;
173 
174  if (!body && typ==(def_type)predicate) {
175  succ.type=succeed;
176  succ.value_3=NULL;
177  succ.coref=NULL;
178  succ.resid=NULL;
179  succ.attr_list=NULL;
180  body= ≻
181  }
182 
183  deref_ptr(head);
184  head2=head;
185 
186  /* assert(head->resid==NULL); 10.8 */
187  /* assert(body->resid==NULL); 10.8 */
188 
189  if (redefine(head)) {
190 
191  def=head->type;
192 
193  if (def->type_def==(def_type)undef || def->type_def==typ)
194 
195  /* RM: Jan 27 1993 */
196  if(TRUE
197  /* def->type==undef ||
198  def->keyword->module==current_module */
199  /* RM: Feb 2 1993 Commented out */
200  ) {
201  if (def->rule && (unsigned long)def->rule<=MAX_BUILT_INS) {
202  Errorline("the built-in %T '%s' may not be redefined.\n",
203  def->type_def, def->keyword->symbol);
204  }
205  else {
206  def->type_def=typ;
207 
208  /* PVR single allocation in source */
210  clear_copy();
211  /* p->aaaa_3=exact_copy(head2,HEAP); 24.8 25.8 */
212  /* p->bbbb_3=exact_copy(body,HEAP); 24.8 25.8 */
213 
214  p->aaaa_2=quote_copy(head2,HEAP); /* 24.8 25.8 */
215  p->bbbb_2=quote_copy(body,HEAP); /* 24.8 25.8 */
216 
217  if (assert_first) {
218  p->next=def->rule;
219  def->rule=p;
220  }
221  else {
222  p->next=NULL;
223  p2= &(def->rule);
224  while (*p2) {
225  p2= &((*p2)->next);
226  }
227  *p2=p;
228  }
229  assert_ok=TRUE;
230  }
231  }
232  else { /* RM: Jan 27 1993 */
233  Errorline("the %T '%s' may not be redefined from within module %s.\n",
234  def->type_def,
235  def->keyword->combined_name,
237  }
238  else {
239  Errorline("the %T '%s' may not be redefined as a %T.\n",
240  def->type_def, def->keyword->symbol, typ);
241  }
242  }
243 }
ptr_psi_term aaaa_2
Definition: def_struct.h:189
ptr_residuation resid
Definition: def_struct.h:173
#define predicate
Definition: def_const.h:361
#define HEAP
Definition: def_const.h:147
long assert_first
Definition: def_glob.h:58
void clear_copy()
clear_copy
Definition: copy.c:53
char * combined_name
Definition: def_struct.h:92
ptr_module current_module
Definition: def_glob.h:161
ptr_pair_list next
Definition: def_struct.h:191
#define undef
Definition: def_const.h:360
long redefine(ptr_psi_term t)
redefine
Definition: types.c:104
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
long assert_ok
Definition: def_glob.h:59
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
ptr_definition succeed
Definition: def_glob.h:104
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term bbbb_2
Definition: def_struct.h:190
char * module_name
Definition: def_struct.h:75
ptr_psi_term coref
Definition: def_struct.h:172
#define MAX_BUILT_INS
Definition: def_const.h:82
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
long all_public_symbols ( )

all_public_symbols

ALL_PUBLIC_SYMBOLS Returns all public symbols from all modules or a specific module.

Definition at line 1363 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, deref_ptr, first_definition, get_module(), get_two_args(), wl_definition::keyword, wl_keyword::module, wl_definition::next, NULL, wl_keyword::public, push_goal(), stack_cons(), stack_nil(), stack_psi_term(), TRUE, wl_psi_term::type, and unify.

1364 {
1365  ptr_psi_term arg1,arg2,funct,result;
1366  ptr_psi_term list;
1367  ptr_psi_term car;
1368  ptr_module module=NULL;
1369  ptr_definition d;
1370 
1371  funct=aim->aaaa_1;
1372  deref_ptr(funct);
1373  result=aim->bbbb_1;
1374  get_two_args(funct->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
1375 
1376  if(arg1) {
1377  deref_ptr(arg1);
1378  (void)get_module(arg1,&module);
1379  }
1380  else
1381  module=NULL;
1382 
1383  list=stack_nil();
1384 
1385  for(d=first_definition;d;d=d->next)
1386  if(d->keyword->public && (!module || d->keyword->module==module)) {
1387  car=stack_psi_term(4);
1388  car->type=d;
1389  list=stack_cons(car,list);
1390  }
1391 
1392  push_goal(unify,result,list,NULL);
1393 
1394  return TRUE;
1395 }
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)
get_module
Definition: modules.c:1226
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_node attr_list
Definition: def_struct.h:171
all_sorts ( )

all_sorts

ALL_SORTS() Build a list of all sorts (except nothing) in nothing->parents.

Definition at line 759 of file types.c.

References cons(), first_definition, wl_definition::next, nothing, wl_definition::parents, wl_definition::type_def, and type_it.

760 {
761  ptr_definition d;
762 
763  for(d=first_definition;d;d=d->next)
764  if (d->type_def==(def_type)type_it && d!=nothing)
766 }
def_type type_def
Definition: def_struct.h:133
ptr_int_list cons(GENERIC v, ptr_int_list l)
cons
Definition: types.c:179
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_definition nothing
Definition: def_glob.h:98
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list parents
Definition: def_struct.h:130
long all_symbol ( char *  s)

all_symbol

Parameters
char*s

Return TRUE iff s contains only SYMBOL characters.

Definition at line 434 of file print.c.

References FALSE, SYMBOL, and TRUE.

435 {
436  while (*s) {
437  if (!SYMBOL(*s)) return FALSE;
438  s++;
439  }
440  return TRUE;
441 }
#define SYMBOL(C)
Definition: def_macro.h:52
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
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
void append_resid ( ptr_psi_term  u,
ptr_psi_term  v 
)

append_resid

Parameters
ptr_psi_termu
ptr_psi_termv

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

Definition at line 474 of file lefun.c.

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

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

appendIntList

Parameters
ptr_int_listtail
ptr_int_listmore

attach copies of more to tail

Definition at line 40 of file lub.c.

References wl_int_list::next, NULL, STACK_ALLOC, and wl_int_list::value_1.

41 {
42  while (more)
43  {
44  tail->next = STACK_ALLOC(int_list);
45  tail= tail->next;
46  tail->value_1 = more->value_1;
47  tail->next = NULL;
48  more = more->next;
49  }
50  return tail;
51 }
#define NULL
Definition: def_const.h:203
#define STACK_ALLOC(A)
Definition: def_macro.h:16
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
void assert_args_not_eval ( ptr_node  n)

assert_args_not_eval

Parameters
ptr_noden

ASSERT_ARGS_NOT_EVAL(n) Mark all the nodes in the attribute tree N as having unevaluated arguments, if they are functions or predicates.

Definition at line 294 of file types.c.

References wl_node::data, deref_ptr, wl_definition::evaluate_args, FALSE, wl_definition::keyword, wl_node::left, wl_node::right, wl_keyword::symbol, wl_psi_term::type, wl_definition::type_def, type_it, and warningline().

295 {
296  ptr_psi_term t;
297 
298  if (n) {
300 
301  t=(ptr_psi_term)n->data;
302  deref_ptr(t);
303  if (t->type) {
304  if (t->type->type_def==(def_type)type_it) {
305  warningline("'%s' is a sort--only functions and predicates\
306  can have unevaluated arguments.\n",t->type->keyword->symbol);
307  }
308  else
310  }
311 
313  }
314 }
char evaluate_args
Definition: def_struct.h:136
void assert_args_not_eval(ptr_node n)
assert_args_not_eval
Definition: types.c:294
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
char * symbol
Definition: def_struct.h:91
ptr_node left
Definition: def_struct.h:183
#define type_it
Definition: def_const.h:363
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
ptr_node right
Definition: def_struct.h:184
void assert_attributes ( ptr_psi_term  t)

assert_attributes

Parameters
ptr_psi_termt

ASSERT_ATTRIBUTES(t) T is of the form ':: type(attributes) | pred', the attributes must be appended to T's definition, and will be propagated after ENCODING to T's subtypes.

Definition at line 500 of file types.c.

References add_rule(), wl_psi_term::attr_list, deref_ptr, Errorline(), function_it, get_two_args(), wl_definition::keyword, NULL, predicate, wl_keyword::symbol, TRUE, wl_psi_term::type, wl_definition::type_def, type_it, types_modified, and wl_const_3.

501 {
502  ptr_psi_term arg1,arg2,pred=NULL,typ;
503  ptr_definition d;
504 
505  get_two_args(t->attr_list,&arg1,&arg2);
506 
507  if (arg1) {
508  typ=arg1;
509  deref_ptr(arg1);
510  if (!strcmp(arg1->type->keyword->symbol,"|")) {
511  get_two_args(arg1->attr_list,&arg1,&pred);
512  if (arg1) {
513  typ=arg1;
514  deref_ptr(arg1);
515  }
516  }
517 
518  if (arg1 && wl_const_3(*arg1)) {
519  /* if (!redefine(arg1)) return; RM: Feb 19 1993 */
520  d=arg1->type;
522  Errorline("the %T '%s' may not be redefined as a sort.\n",
523  d->type_def, d->keyword->symbol);
524  }
525  else {
528  add_rule(typ,pred,(def_type)type_it);
529  }
530  }
531  else {
532  Errorline("bad argument in sort declaration '%P' (%E).\n",t);
533  }
534  }
535  else {
536  Errorline("argument missing in sort declaration (%E).\n");
537  }
538 }
#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
struct wl_definition * def_type
Definition: def_struct.h:32
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
long types_modified
Definition: def_glob.h:47
#define type_it
Definition: def_const.h:363
void Errorline(char *format,...)
Definition: error.c:414
#define wl_const_3(S)
Definition: def_macro.h:104
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
void add_rule(ptr_psi_term head, ptr_psi_term body, def_type typ)
add_rule
Definition: login.c:167
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
void assert_clause ( ptr_psi_term  t)

assert_clause

Parameters
ptr_psi_termt

ASSERT_CLAUSE(t) Assert the clause T. Cope with various syntaxes for predicates.

ASSERT_FIRST is a flag indicating the position: 1= insert before existing rules (asserta), 0= insert after existing rules (assert),

Definition at line 287 of file login.c.

References add_rule(), assert_attributes(), assert_complicated_type(), assert_ok, assert_rule(), deref_ptr, equ_tok, FALSE, function_it, NULL, and predicate.

288 {
289  assert_ok=FALSE;
290  deref_ptr(t);
291 
292  /* RM: Feb 22 1993 defined c_alias in modules.c
293  if (equ_tok((*t),"alias")) {
294  get_two_args(t->attr_list,&arg1,&arg2);
295  if (arg1 && arg2) {
296  warningline("'%s' has taken the meaning of '%s'.\n",
297  arg2->type->keyword->symbol, arg1->type->keyword->symbol);
298  str=arg2->type->keyword->symbol;
299  assert_ok=TRUE;
300  deref_ptr(arg1);
301  deref_ptr(arg2);
302  *(arg2->type)= *(arg1->type);
303  arg2->type->keyword->symbol=str;
304  }
305  else
306  Errorline("arguments missing in %P.\n",t);
307  }
308  else
309  */
310 
311  if (equ_tok((*t),":-"))
313  else
314  if (equ_tok((*t),"->"))
316  else
317  if (equ_tok((*t),"::"))
319  else
320 
321 #ifdef CLIFE
322  if (equ_tok((*t),"block_struct"))
323  define_block(t);
324  else
325 #endif /* CLIFE */
326  /* if (equ_tok((*t),"<<<-")) { RM: Feb 10 1993
327  declare T as global. To do... maybe.
328  }
329  else
330  */
331 
332  if (equ_tok((*t),"<|") || equ_tok((*t),":="))
334  else
336 
337  /* if (!assert_ok && warning()) perr("the declaration is ignored.\n"); */
338 }
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
void assert_rule(psi_term t, def_type typ)
assert_rule
Definition: login.c:257
void assert_complicated_type(ptr_psi_term t)
assert_complicated_type
Definition: types.c:405
#define NULL
Definition: def_const.h:203
long assert_ok
Definition: def_glob.h:59
#define deref_ptr(P)
Definition: def_macro.h:95
void assert_attributes(ptr_psi_term t)
assert_attributes
Definition: types.c:500
void add_rule(ptr_psi_term head, ptr_psi_term body, def_type typ)
add_rule
Definition: login.c:167
#define FALSE
Definition: def_const.h:128
#define equ_tok(A, B)
Definition: def_macro.h:62
void assert_complicated_type ( ptr_psi_term  t)

assert_complicated_type

Parameters
ptr_psi_termt

ASSERT_COMPLICATED_TYPE This deals with all the type declarations of the form:

a(attr) <| b. % (a<|b) a(attr) <| b | pred.

a(attr) <| {b;c;d}. % (a<|b, a<|c, a<|d) a(attr) <| {b;c;d} | pred.

a := b(attr). % (a<|b) a := b(attr) | pred.

a := {b(attr1);c(attr2);d(attr3)}. % (b<|a,c<|a,d<|a) a := {b(attr1);c(attr2);d(attr3)} | pred.

Definition at line 405 of file types.c.

References add_rule(), assert_less(), assert_ok, wl_psi_term::attr_list, deref_ptr, disjunction, equ_tok, Errorline(), FALSE, get_two_args(), wl_definition::keyword, nil, NULL, wl_keyword::symbol, TRUE, wl_psi_term::type, type_it, and warningline().

406 {
407  ptr_psi_term arg2,typ1,typ2,pred=NULL;
408  // ptr_list lst;
409  long eqflag = equ_tok((*t),":=");
410  long ok, any_ok=FALSE;
411 
412  get_two_args(t->attr_list,&typ1,&arg2);
413 
414  if (typ1 && arg2) {
415  deref_ptr(typ1);
416  deref_ptr(arg2);
417  typ2=arg2;
418  if (!strcmp(arg2->type->keyword->symbol,"|")) {
419  typ2=NULL;
420  get_two_args(arg2->attr_list,&arg2,&pred);
421  if (arg2) {
422  deref_ptr(arg2);
423  typ2=arg2;
424  }
425  }
426  if (typ2) {
427  if (typ2->type==disjunction) {
428 
429  if (typ1->attr_list && eqflag) {
430  warningline("attributes ignored left of ':=' declaration (%E).\n");
431  }
432  while(typ2 && typ2->type!=nil) {
433  get_two_args(typ2->attr_list,&arg2,&typ2); /* RM: Dec 14 1992 */
434  if(typ2)
435  deref_ptr(typ2);
436  if (arg2) {
437  deref_ptr(arg2);
438  if (eqflag) {
439  ok=assert_less(arg2,typ1);
440  if (ok) any_ok=TRUE;
441  if (ok && (arg2->attr_list || pred!=NULL)) {
442  add_rule(arg2,pred,(def_type)type_it);
443  }
444  }
445  else {
446  ok=assert_less(typ1,arg2);
447  if (ok) any_ok=TRUE;
448  if (ok && arg2->attr_list) {
449  warningline("attributes ignored in sort declaration (%E).\n");
450  }
451  }
452  }
453  }
454  assert_ok=TRUE;
455  }
456  else if (eqflag) {
457  if (typ1->attr_list) {
458  warningline("attributes ignored left of ':=' declaration (%E).\n");
459  }
460  ok=assert_less(typ1,typ2);
461  if (ok) any_ok=TRUE;
462  typ2->type=typ1->type;
463  if (ok && (typ2->attr_list || pred!=NULL))
464  add_rule(typ2,pred,(def_type)type_it);
465  else
466  assert_ok=TRUE;
467  }
468  else {
469  if (typ2->attr_list) {
470  warningline("attributes ignored right of '<|' declaration (%E).\n");
471  }
472  ok=assert_less(typ1,typ2);
473  if (ok) any_ok=TRUE;
474  if (ok && (typ1->attr_list || pred!=NULL))
475  add_rule(typ1,pred,(def_type)type_it);
476  else
477  assert_ok=TRUE;
478  }
479  }
480  else {
481  Errorline("argument missing in sort declaration (%E).\n");
482  }
483  }
484  else {
485  Errorline("argument missing in sort declaration (%E).\n");
486  }
487  if (!any_ok) assert_ok=FALSE;
488 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
long assert_less(ptr_psi_term t1, ptr_psi_term t2)
assert_less
Definition: types.c:200
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
long assert_ok
Definition: def_glob.h:59
#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
#define FALSE
Definition: def_const.h:128
ptr_definition disjunction
Definition: def_glob.h:84
ptr_definition nil
Definition: def_glob.h:97
#define equ_tok(A, B)
Definition: def_macro.h:62
void add_rule(ptr_psi_term head, ptr_psi_term body, def_type typ)
add_rule
Definition: login.c:167
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
void assert_delay_check ( ptr_node  n)

assert_delay_check

Parameters
ptr_noden

ASSERT_DELAY_CHECK(n) Assert that the types in the attribute tree N will have their properties checked only when they have attributes. If they have no attributes, then no properties are checked.

Definition at line 326 of file types.c.

References wl_definition::always_check, wl_node::data, deref_ptr, FALSE, wl_node::left, wl_node::right, and wl_psi_term::type.

327 {
328  if (n) {
329  ptr_psi_term t;
331 
332  t=(ptr_psi_term)n->data;
333  deref_ptr(t);
334  if (t->type) {
335  t->type->always_check=FALSE;
336  }
337 
339  }
340 }
GENERIC data
Definition: def_struct.h:185
char always_check
Definition: def_struct.h:134
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
void assert_delay_check(ptr_node n)
assert_delay_check
Definition: types.c:326
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
long assert_less ( ptr_psi_term  t1,
ptr_psi_term  t2 
)

assert_less

Parameters
ptr_psi_termt1
ptr_psi_termt2

ASSERT_LESS(t1,t2) Assert that T1 <| T2. Return false if some sort of error occurred.

Definition at line 200 of file types.c.

References deref_ptr, Errorline(), FALSE, function_it, wl_definition::keyword, make_type_link(), predicate, redefine(), wl_keyword::symbol, top, TRUE, wl_psi_term::type, wl_definition::type_def, type_it, types_modified, and wl_psi_term::value_3.

201 {
202  ptr_definition d1,d2;
203  long ok=FALSE;
204  deref_ptr(t1);
205  deref_ptr(t2);
206 
207  if (t1->type==top) {
208  Errorline("the top sort '@' may not be a subsort.\n");
209  return FALSE;
210  }
211  if (t1->value_3 || t2->value_3) {
212  Errorline("the declaration '%P <| %P' is illegal.\n",t1,t2);
213  return FALSE;
214  }
215  /* Note: A *full* cyclicity check of the hierarchy is done in encode_types. */
216  if (t1->type==t2->type) {
217  Errorline("cyclic sort declarations are not allowed.\n");
218  return FALSE;
219  }
220 
221  if (!redefine(t1)) return FALSE;
222  if (!redefine(t2)) return FALSE;
223  d1=t1->type;
224  d2=t2->type;
226  Errorline("the %T '%s' may not be redefined as a sort.\n",
227  d1->type_def, d1->keyword->symbol);
228  }
229  else if (d2->type_def==(def_type)predicate || d2->type_def==(def_type)function_it) {
230  Errorline("the %T '%s' may not be redefined as a sort.\n",
231  d2->type_def, d2->keyword->symbol);
232  }
233  else {
237  make_type_link(d1, d2); /* 1.7 */
238  /* d1->parents=cons(d2,d1->parents); */
239  /* d2->children=cons(d1,d2->children); */
240  ok=TRUE;
241  }
242 
243  return ok;
244 }
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
struct wl_definition * def_type
Definition: def_struct.h:32
long redefine(ptr_psi_term t)
redefine
Definition: types.c:104
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
ptr_definition top
Definition: def_glob.h:106
char * symbol
Definition: def_struct.h:91
long types_modified
Definition: def_glob.h:47
#define type_it
Definition: def_const.h:363
void make_type_link(ptr_definition t1, ptr_definition t2)
make_type_link
Definition: types.c:901
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
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
void assert_protected ( ptr_node  n,
long  prot 
)

assert_protected

Parameters
ptr_noden
longprot

ASSERT_PROTECTED(n,prot) Mark all the nodes in the attribute tree N with protect flag prot.

Definition at line 255 of file types.c.

References wl_node::data, wl_definition::date, deref_ptr, wl_definition::keyword, wl_node::left, MAX_BUILT_INS, wl_definition::protected, wl_node::right, wl_definition::rule, wl_keyword::symbol, wl_psi_term::type, wl_definition::type_def, type_it, and warningline().

256 {
257  ptr_psi_term t;
258 
259  if (n) {
260  assert_protected(n->left,prot);
261 
262  t=(ptr_psi_term)n->data;
263  deref_ptr(t);
264  if (t->type) {
265  if (t->type->type_def==(def_type)type_it) {
266  warningline("'%s' is a sort. It can be extended without a declaration.\n",
267  t->type->keyword->symbol);
268  }
269  else if ((unsigned long)t->type->rule<MAX_BUILT_INS &&
270  (unsigned long)t->type->rule>0) {
271  if (!prot)
272  warningline("'%s' is a built-in--it has not been made dynamic.\n",
273  t->type->keyword->symbol);
274  }
275  else {
276  t->type->protected=prot;
277  if (prot) t->type->date&=(~1); else t->type->date|=1;
278  }
279  }
280 
281  assert_protected(n->right,prot);
282  }
283 }
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
void assert_protected(ptr_node n, long prot)
assert_protected
Definition: types.c:255
GENERIC data
Definition: def_struct.h:185
char * symbol
Definition: def_struct.h:91
ptr_node left
Definition: def_struct.h:183
#define type_it
Definition: def_const.h:363
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_pair_list rule
Definition: def_struct.h:126
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
#define MAX_BUILT_INS
Definition: def_const.h:82
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
ptr_node right
Definition: def_struct.h:184
void assert_rule ( psi_term  t,
def_type  typ 
)

assert_rule

Parameters
psi_termt
def_typetyp

ASSERT_RULE(t,typ) Add a rule to the rule tree. It may be either a predicate or a function. The psi_term T is of the form 'H :- B' or 'H -> B', but it may be incorrect (report errors). TYP is the type, function or predicate.

Definition at line 257 of file login.c.

References add_rule(), wl_psi_term::attr_list, get_two_args(), and Syntaxerrorline().

258 {
259  ptr_psi_term head;
260  ptr_psi_term body;
261 
262  get_two_args(t.attr_list,&head,&body);
263  if (head)
264  if (body)
265  add_rule(head,body,typ);
266  else {
267  Syntaxerrorline("body missing in definition of %T '%P'.\n", typ, head);
268  }
269  else {
270  Syntaxerrorline("head missing in definition of %T.\n",typ);
271  }
272 }
void Syntaxerrorline(char *format,...)
Definition: error.c:498
void add_rule(ptr_psi_term head, ptr_psi_term body, def_type typ)
add_rule
Definition: login.c:167
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
ptr_node attr_list
Definition: def_struct.h:171
void assert_type ( ptr_psi_term  t)

assert_type

Parameters
ptr_psi_termt

ASSERT_TYPE(t) T is the psi_term <|(type1,type2). Add that to the type-definitions.

Definition at line 372 of file types.c.

References assert_less(), assert_ok, wl_psi_term::attr_list, Errorline(), get_two_args(), and NULL.

373 {
374  ptr_psi_term arg1,arg2;
375 
376  get_two_args(t->attr_list,&arg1,&arg2);
377  if(arg1==NULL || arg2==NULL) {
378  Errorline("bad sort declaration '%P' (%E).\n",t);
379  }
380  else
381  assert_ok=assert_less(arg1,arg2);
382 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
long assert_less(ptr_psi_term t1, ptr_psi_term t2)
assert_less
Definition: types.c:200
#define NULL
Definition: def_const.h:203
long assert_ok
Definition: def_glob.h:59
void Errorline(char *format,...)
Definition: error.c:414
ptr_node attr_list
Definition: def_struct.h:171
void backtrack ( )

backtrack

BACKTRACK() Undo everything back to the previous choice-point and take the alternative decision. This routine would have to be modified, along with UNDO to cope with goals to be proved on backtracking.

Definition at line 772 of file login.c.

References choice_stack, goal_stack, wl_choice_point::goal_stack, wl_choice_point::next, NULL, resid_aim, stack_pointer, wl_choice_point::stack_top, undo(), and wl_choice_point::undo_point.

773 {
774  // long gts;
775 
778 #ifdef TS
779  /* global_time_stamp=choice_stack->time_stamp; */ /* 9.6 */
780 #endif
783  resid_aim=NULL;
784 
785 
786  /* assert((unsigned long)stack_pointer>=(unsigned long)cut_point); 13.6 */
787  /* This situation occurs frequently in some benchmarks (e.g comb) */
788  /* printf("*** Possible GC error: cut_point is dangling\n"); */
789  /* fflush(stdout); */
790 
791  /* assert((unsigned long)stack_pointer>=(unsigned long)match_date); 13.6 */
792 }
ptr_goal goal_stack
Definition: def_glob.h:50
void undo(ptr_stack limit)
undo
Definition: login.c:691
ptr_stack undo_point
Definition: def_struct.h:233
GENERIC stack_top
Definition: def_struct.h:236
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_choice_point next
Definition: def_struct.h:235
ptr_goal goal_stack
Definition: def_struct.h:234
GENERIC stack_pointer
Definition: def_glob.h:14
ptr_choice_point choice_stack
Definition: def_glob.h:51
int bad_psi_term ( ptr_psi_term  t)

bad_psi_term

Parameters
ptr_psi_termt

BAD_PSI_TERM(t) This returns true if T is a psi_term which is not allowed to be considered as a constant by the parser.

Example: "A=)+6." would otherwise be parsed as: "=(A,+(')',6))", this was going a bit far.

Definition at line 31 of file parser.c.

References final_dot, final_question, wl_definition::keyword, wl_keyword::symbol, TRUE, and wl_psi_term::type.

32 {
33  char *s,c;
34  long r;
35 
36  if(t->type==final_dot || t->type==final_question) /* RM: Jul 9 1993 */
37  return TRUE;
38 
39  s=t->type->keyword->symbol;
40  c=s[0];
41  r=(s[1]==0 &&
42  (c=='(' ||
43  c==')' ||
44  c=='[' ||
45  c==']' ||
46  c=='{' ||
47  c=='}'
48  /* || c=='.' || c=='?' RM: Jul 7 1993 */
49  )
50  );
51 
52  return r;
53 }
ptr_keyword keyword
Definition: def_struct.h:124
char * symbol
Definition: def_struct.h:91
#define TRUE
Definition: def_const.h:127
ptr_definition final_dot
Definition: def_glob.h:137
ptr_definition final_question
Definition: def_glob.h:138
ptr_definition type
Definition: def_struct.h:165
int base2int ( int  n)

base2int

Parameters
intn

Definition at line 816 of file token.c.

817 {
818  switch (n) {
819  case '0': return 0;
820  case '1': return 1;
821  case '2': return 2;
822  case '3': return 3;
823  case '4': return 4;
824  case '5': return 5;
825  case '6': return 6;
826  case '7': return 7;
827  case '8': return 8;
828  case '9': return 9;
829  case 'a':
830  case 'A': return 10;
831  case 'b':
832  case 'B': return 11;
833  case 'c':
834  case 'C': return 12;
835  case 'd':
836  case 'D': return 13;
837  case 'e':
838  case 'E': return 14;
839  case 'f':
840  case 'F': return 15;
841  default:
842  fprintf(stderr,"base2int('%c'): illegal argument\n",n);
843  exit(EXIT_FAILURE);
844  }
845 }
void begin_terminal_io ( )

begin_terminal_io

BEGIN_TERMINAL_IO() These two routines must bracket any I/O directed to the terminal. This is to avoid mix-ups between terminal and file I/O since the program's input and output streams may be different from stdin stdout. See the routine what_next_aim(), which uses them to isolate the user interface I/O from the program's own I/O.

Definition at line 493 of file token.c.

References inchange, input_state, input_stream, open_input_file(), out, outchange, and output_stream.

494 {
495  inchange = (input_stream!=stdin);
496  outchange = (output_stream!=stdout);
497 
498  if (outchange) {
500  output_stream=stdout;
501  }
502 
503  if (inchange) {
505  (void)open_input_file("stdin");
506  }
507 }
ptr_psi_term input_state
Definition: def_glob.h:199
ptr_psi_term old_state
Definition: token.c:480
static long outchange
Definition: token.c:478
FILE * input_stream
Definition: def_glob.h:38
static long inchange
Definition: token.c:478
static FILE * out
Definition: token.c:479
FILE * output_stream
Definition: def_glob.h:41
long open_input_file(char *file)
open_input_file
Definition: token.c:594
long bit_and_warning ( ptr_psi_term  arg,
REAL  val 
)

Definition at line 824 of file error.c.

References nonint_warning().

827 {
828  return nonint_warning(arg,val,"of bitwise 'and' operation is not an integer");
829 }
long nonint_warning(ptr_psi_term arg, REAL val, char *msg)
Definition: error.c:810
long bit_length ( ptr_int_list  c)

bit_length

Parameters
ptr_int_listc

BIT_LENGTH(c) Returns the number of bits needed to code C. That is the rank of the first non NULL bit of C.

Examples: C= 1001001000 result=7 C= 10000 result=1 C= 0000000 result=0

Definition at line 1753 of file types.c.

References INT_SIZE, wl_int_list::next, and wl_int_list::value_1.

1754 {
1755  unsigned long p=0,dp=0,v=0,dv=0;
1756 
1757  while (c) {
1758  v=(unsigned long)c->value_1;
1759  if(v) {
1760  dp=p;
1761  dv=v;
1762  }
1763  c=c->next;
1764  p=p+INT_SIZE;
1765  }
1766 
1767  while (dv) {
1768  dp++;
1769  dv=dv>>1;
1770  }
1771 
1772  return dp;
1773 }
#define INT_SIZE
Definition: def_const.h:144
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
long bit_not_warning ( ptr_psi_term  arg,
REAL  val 
)

Definition at line 838 of file error.c.

References nonint_warning().

841 {
842  return nonint_warning(arg,val,"of bitwise 'not' operation is not an integer");
843 }
long nonint_warning(ptr_psi_term arg, REAL val, char *msg)
Definition: error.c:810
long bit_or_warning ( ptr_psi_term  arg,
REAL  val 
)

Definition at line 831 of file error.c.

References nonint_warning().

834 {
835  return nonint_warning(arg,val,"of bitwise 'or' operation is not an integer");
836 }
long nonint_warning(ptr_psi_term arg, REAL val, char *msg)
Definition: error.c:810
ptr_node bk2_stack_insert ( long  comp,
char *  keystr,
ptr_node tree,
GENERIC  info 
)

bk2_stack_insert

Parameters
longcomp
char*keystr
ptr_node*tree
GENERICinfo

BK2_STACK_INSERT(comp,keystr,tree,info) Insert the pointer INFO under the reference string KEYSTR of length len in the binary tree TREE. Return the pointer to the permanent storage place of KEY. This is used by C_APPLY_LABEL Always trail the change.

Definition at line 377 of file trees.c.

References FALSE, general_insert(), and STACK.

378 {
379 
380  return general_insert(comp,keystr,tree,info,STACK,FALSE,2L);
381 }
#define FALSE
Definition: def_const.h:128
ptr_node general_insert(long comp, char *keystr, ptr_node *tree, GENERIC info, long heapflag, long copystr, long bkflag)
ptr_node general_insert
Definition: trees.c:224
#define STACK
Definition: def_const.h:148
void bk_mark_quote ( ptr_psi_term  t)

bk_mark_quote

Parameters
ptr_psi_termt

Back-trackably mark a psi-term as completely evaluated.

Definition at line 709 of file copy.c.

References wl_psi_term::attr_list, bk_mark_quote(), bk_mark_quote_tree(), wl_psi_term::coref, wl_psi_term::flags, heap_pointer, int_ptr, push_ptr_value(), QUOTED_TRUE, RMASK, and wl_psi_term::status.

710 {
711  if (t && !(t->status&RMASK)) {
712  if(t->status!=4 && (GENERIC)t<heap_pointer)/* RM: Jul 16 1993 */
714  t->status = 4;
715  t->flags=QUOTED_TRUE; /* 14.9 */
716  t->status |= RMASK;
717  bk_mark_quote(t->coref);
719  t->status &= ~RMASK;
720  }
721 }
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
void bk_mark_quote_tree(ptr_node t)
bk_mark_quote_tree
Definition: copy.c:729
void bk_mark_quote(ptr_psi_term t)
bk_mark_quote
Definition: copy.c:709
#define RMASK
Definition: def_const.h:159
ptr_psi_term coref
Definition: def_struct.h:172
GENERIC heap_pointer
Definition: def_glob.h:12
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
#define int_ptr
Definition: def_const.h:172
void bk_mark_quote_tree ( ptr_node  t)

bk_mark_quote_tree

Parameters
ptr_nodet

Definition at line 729 of file copy.c.

References bk_mark_quote(), bk_mark_quote_tree(), wl_node::data, wl_node::left, and wl_node::right.

730 {
731  if (t) {
735  }
736 }
void bk_mark_quote_tree(ptr_node t)
bk_mark_quote_tree
Definition: copy.c:729
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
void bk_mark_quote(ptr_psi_term t)
bk_mark_quote
Definition: copy.c:709
ptr_node right
Definition: def_struct.h:184
void bk_stack_add_psi_attr ( ptr_psi_term  t,
char *  attrname,
ptr_psi_term  g 
)

bk_stack_add_psi_attr

Parameters
ptr_psi_termt
char*attrname
ptr_psi_termg

Definition at line 252 of file token.c.

References wl_psi_term::attr_list, bk_stack_insert(), FEATCMP, and heap_copy_string().

253 {
254  (void)bk_stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)g);
255 }
#define FEATCMP
Definition: def_const.h:257
ptr_node bk_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
bk_stack_insert
Definition: trees.c:357
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
ptr_node bk_stack_insert ( long  comp,
char *  keystr,
ptr_node tree,
GENERIC  info 
)

bk_stack_insert

Parameters
longcomp
char*keystr
ptr_node*tree
GENERICinfo

BK_STACK_INSERT(comp,keystr,tree,info) Insert the pointer INFO under the reference string KEYSTR of length len in the binary tree TREE. Return the pointer to the permanent storage place of KEY. This is used by C_APPLY_LABEL Trail the change with a trail check.

Definition at line 357 of file trees.c.

References FALSE, general_insert(), and STACK.

358 {
359 
360  return general_insert(comp,keystr,tree,info,STACK,FALSE,1L);
361 }
#define FALSE
Definition: def_const.h:128
ptr_node general_insert(long comp, char *keystr, ptr_node *tree, GENERIC info, long heapflag, long copystr, long bkflag)
ptr_node general_insert
Definition: trees.c:224
#define STACK
Definition: def_const.h:148
long bounds_undo_stack ( )

bounds_undo_stack

Address field in undo_stack is within range The only valid address outside this range is that of xevent_state

Definition at line 142 of file memory.c.

References wl_stack::aaaa_3, FALSE, mem_base, mem_limit, wl_stack::next, TRUE, wl_stack::type, undo_action, undo_stack, and VALID_ADDRESS.

143 {
145 
146  while (u) {
147  if ( (GENERIC)u<mem_base
148  || (GENERIC)u>mem_limit
149  || (!VALID_ADDRESS(u->aaaa_3) && !(u->type & undo_action))
150  ) {
151  if ((GENERIC)u<mem_base || (GENERIC)u>mem_limit) {
152  printf("\nUNDO: u=%lx\n",(long)u);
153  }
154  else {
155  printf("\nUNDO: u:%lx type:%ld a:%lx b:%lx next:%lx\n",
156  (unsigned long)u,(unsigned long)u->type,(unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3,(unsigned long)u->next);
157  }
158  (void)fflush(stdout);
159  return FALSE;
160  }
161  u=u->next;
162  }
163 
164  return TRUE;
165 }
#define VALID_ADDRESS(A)
Definition: def_macro.h:132
GENERIC mem_limit
Definition: def_glob.h:13
ptr_stack undo_stack
Definition: def_glob.h:53
type_ptr type
Definition: def_struct.h:216
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC mem_base
Definition: def_glob.h:11
GENERIC * aaaa_3
Definition: def_struct.h:217
#define undo_action
Definition: def_const.h:188
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
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
long c_alias ( )

c_alias

C_ALIAS Alias one keyword to another.

Definition at line 1180 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_keyword::combined_name, wl_keyword::definition, deref_ptr, Errorline(), FALSE, get_two_args(), hash_lookup(), wl_definition::keyword, wl_module::module_name, wl_keyword::symbol, wl_module::symbol_table, TRUE, wl_psi_term::type, and warningline().

1181 {
1182  long success=TRUE;
1183  ptr_psi_term arg1,arg2,g;
1184  ptr_keyword key;
1185 
1186  g=aim->aaaa_1;
1187 
1188  deref_ptr(g);
1189  get_two_args(g->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
1190  if (arg1 && arg2) {
1191  deref_ptr(arg1);
1192  deref_ptr(arg2);
1193 
1195  if(key) {
1196  if(key->definition!=arg2->type) {
1197  warningline("alias: '%s' has now been overwritten by '%s'\n",
1198  key->combined_name,
1199  arg2->type->keyword->combined_name);
1200 
1201  key->definition=arg2->type;
1202  }
1203  }
1204  else
1205  Errorline("module violation: cannot alias '%s' from module \"%s\"\n",
1206  key->combined_name,
1208  }
1209  else {
1210  success=FALSE;
1211  Errorline("argument(s) missing in '%P'\n",g);
1212  }
1213 
1214  return success;
1215 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
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
ptr_definition definition
Definition: def_struct.h:96
ptr_hash_table symbol_table
Definition: def_struct.h:79
ptr_keyword keyword
Definition: def_struct.h:124
ptr_module current_module
Definition: modules.c:15
char * symbol
Definition: def_struct.h:91
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
char * module_name
Definition: def_struct.h:75
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
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)
overlap_type
Definition: types.c:1579
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)
find
Definition: trees.c:394
#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
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)
heap_copy_string
Definition: trees.c:172
#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
long c_begin_raw ( )

c_begin_raw

Definition at line 39 of file raw.c.

References bufbuf, Errorline(), FALSE, mode_raw, param_input, stdin_fileno, TANDEM, and TRUE.

40 {
41  struct sgttyb param;
42  struct termio argio;
43 
44  if (mode_raw)
45  {
46  Errorline ("in begin_raw: already in mode raw\n");
47  return FALSE;
48  }
49 
50  if (ioctl (stdin_fileno, TIOCGETP, &param_input) == -1)
51  Errorline ("in begin_raw: cannot get the input parameters\n");
52 
53  bcopy ((char*)&param_input, (char*)&param, sizeof (param));
54 
55 #if 0
56  /* with RAW, we catch everything (eg: ^C is 3) */
57  param.sg_flags |= CBREAK | TANDEM | RAW;
58 #else
59  param.sg_flags |= CBREAK | TANDEM;
60 #endif
61 
62  param.sg_flags &= ~ECHO;
63 
64  if (ioctl (stdin_fileno, TIOCSETN, &param) == -1)
65  Errorline ("in begin_raw: cannot set the input parameters\n");
66 
67  if (ioctl (stdin_fileno, TCGETA, &argio) == -1)
68  Errorline ("in begin_raw: cannot get the terminal\n");
69 
70  /* do not strip the characters (the 8th bit is used for the key Compose) */
71 #if 1
72  /* catch every character */
73  argio.c_lflag &= ~(ICANON|ISIG);
74  argio.c_cc[VMIN] = 1;
75  argio.c_cc[VTIME] = 0;
76 
77  /* with IXON, do not interpret ctrl-S and ctrl-Q */
78  argio.c_iflag &= ~(ISTRIP|IXON);
79 
80  /* map LF to CR-LF */
81  argio.c_oflag |= OPOST|ONLCR;
82 #else
83  argio.c_iflag &= ~(ISTRIP);
84 #endif
85 
86  if (ioctl (stdin_fileno, TCSETA, &argio) == -1)
87  Errorline ("in begin_raw: cannot set the terminal\n");
88 
89  (void)setvbuf (stdin, bufbuf, _IOFBF, BUFSIZ);
90 
91  bzero (bufbuf, BUFSIZ+1);
92 
93  mode_raw = TRUE;
94  return TRUE;
95 }
#define stdin_fileno
Definition: def_const.h:343
static long mode_raw
Definition: raw.c:19
void Errorline(char *format,...)
Definition: error.c:414
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
static char bufbuf[BUFSIZ+1]
Definition: raw.c:20
static struct sgttyb param_input
Definition: raw.c:18
#define TANDEM
Definition: defs.h:26
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)
overlap_type
Definition: types.c:1579
#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)
find
Definition: trees.c:394
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
long c_current_module ( )

c_current_module

C_CURRENT_MODULE Return the current module.

Definition at line 974 of file modules.c.

References wl_goal::aaaa_1, aim, wl_goal::bbbb_1, deref_ptr, heap_copy_string(), wl_module::module_name, NULL, push_goal(), quoted_string, resid_aim, stack_psi_term(), TRUE, wl_psi_term::type, unify, and wl_psi_term::value_3.

975 {
976  long success=TRUE;
977  ptr_psi_term result,g,other;
978 
979  g=aim->aaaa_1;
980  deref_ptr(g);
981  result=aim->bbbb_1;
982  deref_ptr(result);
983 
984  other=stack_psi_term(4);
985  /* PVR 24.1.94 */
986  other->type=quoted_string;
988  /*
989  update_symbol(current_module,
990  current_module->module_name)
991  ->keyword->symbol
992  );
993 */ /* RM: 2/15/1994 */
994  /* other->type=update_symbol(current_module,current_module->module_name); */
995  resid_aim=NULL;
996  push_goal(unify,result,other,NULL);
997 
998  return success;
999 }
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 NULL
Definition: def_const.h:203
ptr_module current_module
Definition: modules.c:15
ptr_goal resid_aim
Definition: def_glob.h:220
#define deref_ptr(P)
Definition: def_macro.h:95
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
#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_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
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)
find
Definition: trees.c:394
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
long c_display_modules ( )

c_display_modules

C_DISPLAY_MODULES(); Set the display modules switch.

Definition at line 739 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, display_modules, Errorline(), FALSE, get_two_args(), lf_false, lf_true, TRUE, and wl_psi_term::type.

740 {
741  ptr_psi_term arg1,arg2;
742  ptr_psi_term call;
743  int success=TRUE;
744 
745 
746  call=aim->aaaa_1;
747  deref_ptr(call);
748  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
749 
750  if(arg1) {
751  deref_ptr(arg1);
752  if(arg1->type==lf_true)
754  else
755  if(arg1->type==lf_false)
757  else {
758  Errorline("argument should be boolean in '%P'\n",call);
759  success=FALSE;
760  }
761  }
762  else /* No argument: toggle */
764 
765  return success;
766 }
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 display_modules
Definition: modules.c:25
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_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
long c_display_persistent ( )

c_display_persistent

C_DISPLAY_PERSISTENT(); Set the display persistent switch.

Definition at line 775 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, display_persistent, Errorline(), FALSE, get_two_args(), lf_false, lf_true, TRUE, and wl_psi_term::type.

776 {
777  ptr_psi_term arg1,arg2;
778  ptr_psi_term call;
779  int success=TRUE;
780 
781  call=aim->aaaa_1;
782  deref_ptr(call);
783  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
784 
785  if(arg1) {
786  deref_ptr(arg1);
787  if(arg1->type==lf_true)
789  else
790  if(arg1->type==lf_false)
792  else {
793  Errorline("argument should be boolean in '%P'\n",call);
794  success=FALSE;
795  }
796  }
797  else /* No argument: toggle */
799 
800  return success;
801 }
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 display_persistent
Definition: def_glob.h:165
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_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
long c_end_raw ( )

c_end_raw

EndRaw end_raw () reset the keyboard in the previous state before xcInitModeRaw. this built-in should be used only by the life-shell of Kathleen.

Definition at line 230 of file raw.c.

References bufbuf, Errorline(), FALSE, mode_raw, param_input, stdin_fileno, and TRUE.

231 {
232  if (!mode_raw)
233  {
234  Errorline ("in c_end_raw: not in mode raw\n");
235  return FALSE;
236  }
237 
238  if (ioctl (stdin_fileno, TIOCSETN, &param_input) == -1)
239  Errorline ("in end_raw: cannot reset mode raw\n");
240 
241  (void)setvbuf (stdin, bufbuf, _IONBF, BUFSIZ);
242  bzero (bufbuf, BUFSIZ);
243 
244  mode_raw = FALSE;
245  return TRUE;
246 }
#define stdin_fileno
Definition: def_const.h:343
static long mode_raw
Definition: raw.c:19
void Errorline(char *format,...)
Definition: error.c:414
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
static char bufbuf[BUFSIZ+1]
Definition: raw.c:20
static struct sgttyb param_input
Definition: raw.c:18
long c_get_raw ( )

c_get_raw

GetRaw c_get_raw (-Char, -EventFlag) return the next key pressed in Char or if a X event has occured this built-in should be used only by the life-shell of Kathleen.

Definition at line 107 of file raw.c.

References aim, begin_builtin, boolean, bufbuf, Errorline(), exit_life(), FALSE, include_var_builtin, interrupt(), REAL, real, release_resid(), stdin_fileno, TRUE, unify_real_result(), and xevent_existing.

108 {
110  ptr_definition types[2];
111  long nfds;
112  fd_set readfd, writefd, exceptfd;
113  struct timeval timeout;
114  long char_flag = FALSE, event_flag = FALSE;
115  long c = 0;
116  // ptr_psi_term key_code;
117  long level;
118 
119  types[0] = real;
120  types[1] = boolean;
121 
122  begin_builtin (c_get_raw, 2, 0, types);
123 
124  if ((int)strlen (bufbuf) == 0)
125  {
126  level = (unsigned long) aim->c;
127 
128 
129  do
130  {
131  FD_ZERO(&readfd);
132  FD_SET(stdin_fileno, &readfd);
133  FD_ZERO(&writefd);
134  FD_ZERO(&exceptfd);
135  timeout.tv_sec = 0;
136  timeout.tv_usec = 100000;
137 
138  nfds = select (32, &readfd, &writefd, &exceptfd, &timeout);
139  if (nfds == -1)
140  {
141  if (errno != EINTR)
142  {
143  Errorline ("it is not possible to read characters or X events\n");
144  exit_life(TRUE);
145  }
146  else
147  interrupt ();
148  }
149  else
150  if (nfds == 0)
151  {
152 #ifdef X11
153  if (x_exist_event ())
154  {
155  event_flag = TRUE;
157  }
158 #endif
159  }
160  else
161  {
162  if (FD_ISSET(stdin_fileno, &readfd) != 0)
163  {
164  /* c cna be equal to 0 with the mouse's selection */
165  /* first the selection is inside the buffer bufbuf */
166  /* later fgetc returns zeros */
167  /* I don't understand - jch - Fri Aug 28 1992 */
168  if ((c = fgetc (stdin)) != 0)
169  {
170  (void)unify_real_result (args[0], (REAL) c);
171  char_flag = TRUE;
172  /* the shift is done below */
173  }
174  }
175  else
176  Errorline ("in select: unknown descriptor\n");
177  }
178  } while (!(char_flag || event_flag));
179  }
180  else
181  {
182  (void)unify_real_result (args[0], (REAL) bufbuf[0]);
183  char_flag = TRUE;
184  }
185 
186  /* shift */
187  if (char_flag)
188  bcopy (&bufbuf[1], bufbuf, BUFSIZ-1);
189 
190  /* return if an X event has occured */
191  unify_bool_result (args[1], event_flag);
192 
193  success = TRUE;
194  end_builtin ();
195 }
void interrupt()
INTERRUPT()
Definition: interrupt.c:21
void exit_life(long nl_flag)
exit_life
Definition: built_ins.c:2220
long c_get_raw()
c_get_raw
Definition: raw.c:107
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
#define stdin_fileno
Definition: def_const.h:343
#define REAL
Definition: def_const.h:72
#define begin_builtin(FUNCNAME, NBARGS, NBARGSIN, TYPES)
Definition: def_macro.h:198
void release_resid(ptr_psi_term t)
release_resid
Definition: lefun.c:445
void Errorline(char *format,...)
Definition: error.c:414
ptr_definition real
Definition: def_glob.h:102
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
static char bufbuf[BUFSIZ+1]
Definition: raw.c:20
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_definition boolean
Definition: def_glob.h:73
ptr_psi_term xevent_existing
Definition: def_glob.h:208
#define include_var_builtin(NBARGS)
Definition: def_macro.h:191
#define end_builtin()
Definition: def_macro.h:254
long c_glb ( )

long c_glb

greatest lower bound (djd)

C_GLB(A,B) Return glb(A,B). Continued calls will return each following type in the disjunction of the glb of A,B.

Definition at line 708 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, curry(), decode(), deref, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), glb(), isSubTypeValue(), isValue(), makePsiTerm(), wl_int_list::next, NULL, push_choice_point(), push_goal(), resid_aim, set_1_2, TRUE, wl_psi_term::type, type_disj, unify, wl_int_list::value_1, and wl_psi_term::value_3.

709 {
710  ptr_psi_term func,arg1,arg2, result, other;
711  ptr_definition ans;
712  ptr_int_list complexType;
713  ptr_int_list decodedType = NULL;
714  long ret;
715 
716  func=aim->aaaa_1;
717  deref_ptr(func);
718  get_two_args(func->attr_list,&arg1,&arg2);
719 
720  if ((!arg1) || (!arg2)) {
721  curry();
722  return TRUE;
723  }
724  result = aim->bbbb_1;
725  deref(result);
726  deref(arg1);
727  deref(arg2);
728  deref_args(func, set_1_2);
729 
730  if ((ret=glb(arg1->type, arg2->type, &ans, &complexType)) == 0)
731  return FALSE;
732 
733  if ((ret != 4)&&(isValue(arg1)||isValue(arg2))) {
734  /* glb is one of arg1->type or arg2->type AND at least one is a value */
735  if (!isSubTypeValue(arg1, arg2) && !isSubTypeValue(arg2, arg1))
736  return FALSE;
737  }
738  if (!ans) {
739  decodedType = decode(complexType);
740  ans = (ptr_definition)decodedType->value_1;
741  decodedType = decodedType->next;
742  }
743  other=makePsiTerm(ans);
744 
745  if (isValue(arg1)) other->value_3=arg1->value_3;
746  if (isValue(arg2)) other->value_3=arg2->value_3;
747 
748  if (isValue(arg1) || isValue(arg2)) {
749  if (decodedType) {
750  Errorline("glb of multiple-inheritance value sorts not yet implemented.\n");
751  return FALSE;
752  }
753  }
754 
755  if (decodedType)
756  push_choice_point(type_disj, result,(ptr_psi_term) decodedType,(GENERIC) NULL);
757 
758  resid_aim = NULL;
759  push_goal(unify,result,other,NULL);
760  return TRUE;
761 }
ptr_psi_term makePsiTerm(ptr_definition x)
Definition: bi_sys.c:572
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
int isSubTypeValue(ptr_psi_term arg1, ptr_psi_term arg2)
isSubTypeValue
Definition: bi_type.c:180
long glb(ptr_definition t1, ptr_definition t2, ptr_definition *t3, ptr_int_list *c3)
glb
Definition: types.c:1481
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_int_list decode(ptr_int_list c)
decode
Definition: types.c:1784
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 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
struct wl_definition * ptr_definition
Definition: def_struct.h:31
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 type_disj
Definition: def_const.h:284
long isValue(ptr_psi_term p)
isValue(p)
Definition: bi_type.c:691
ptr_definition type
Definition: def_struct.h:165
GENERIC value_1
Definition: def_struct.h:54
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
ptr_int_list next
Definition: def_struct.h:55
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
long c_in_raw ( )

InRaw in_raw() return TRUE if mode raw this built-in should be used only by the life-shell of Kathleen.

Definition at line 256 of file raw.c.

References aim, deref_ptr, mode_raw, TRUE, and unify_bool_result().

257 {
258  deref_ptr (aim->a);
260 
261  return TRUE;
262 }
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
static long mode_raw
Definition: raw.c:19
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_goal aim
Definition: def_glob.h:49
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)
overlap_type
Definition: types.c:1579
#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)
find
Definition: trees.c:394
#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
long c_isa_subsort ( )

long c_isa_subsort

C_ISA_SUBSORT(A,B) if A is a subsort of B => succeed and residuate on B else => fail

Definition at line 661 of file bi_type.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref, deref_args, deref_ptr, FALSE, get_two_args(), isa(), reportAndAbort(), residuate(), set_1_2, and TRUE.

662 {
663  ptr_psi_term pred,arg1,arg2;
664 
665  pred=aim->aaaa_1;
666  deref_ptr(pred);
667  get_two_args(pred->attr_list,&arg1,&arg2);
668 
669  if (!arg1) (void)reportAndAbort(pred,"no first argument");
670  deref(arg1);
671 
672  if (!arg2) (void)reportAndAbort(pred,"no second argument");
673  deref(arg2);
674 
675  deref_args(pred, set_1_2);
676 
677  if (isa(arg1, arg2))
678  {
679  residuate(arg2);
680  return TRUE;
681  }
682  return FALSE;
683 }
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
static long isa(ptr_psi_term arg1, ptr_psi_term arg2)
Definition: bi_type.c:217
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
long reportAndAbort(ptr_psi_term g, char *s)
Definition: error.c:732
#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 deref_args(P, S)
Definition: def_macro.h:145
ptr_node attr_list
Definition: def_struct.h:171
long c_lub ( )

long c_lub

least upper bound (djd)

C_LUB(A,B) Return lub(A,B). Continued calls will return each following type in the disjunction of the lub of A,B.

Definition at line 775 of file bi_type.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(), lub(), makePsiTerm(), wl_int_list::next, NULL, push_choice_point(), push_goal(), resid_aim, set_1_2, TRUE, type_disj, unify, and wl_int_list::value_1.

776 {
777  ptr_psi_term func,arg1,arg2, result, other;
778  ptr_definition ans=NULL;
779  ptr_int_list decodedType = NULL;
780 
781  func=aim->aaaa_1;
782  deref_ptr(func);
783  get_two_args(func->attr_list,&arg1,&arg2);
784 
785  if ((!arg1) || (!arg2))
786  {
787  curry();
788  return TRUE;
789  }
790  result = aim->bbbb_1;
791  deref(result);
792  deref(arg1);
793  deref(arg2);
794  deref_args(func, set_1_2);
795 
796  /* now lets find the list of types that is the lub */
797 
798  decodedType = lub(arg1, arg2, &other);
799 
800  if (decodedType) {
801  ans = (ptr_definition)decodedType->value_1;
802  decodedType = decodedType->next;
803  other = makePsiTerm(ans);
804  }
805 
806  if (decodedType)
807  push_choice_point(type_disj, result,(ptr_psi_term) decodedType,(GENERIC) NULL);
808 
809  resid_aim = NULL;
810  push_goal(unify,result,other,NULL);
811  return TRUE;
812 }
ptr_psi_term makePsiTerm(ptr_definition x)
Definition: bi_sys.c:572
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
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
#define deref(P)
Definition: def_macro.h:142
ptr_int_list lub(ptr_psi_term a, ptr_psi_term b, ptr_psi_term *pp)
Definition: lub.c:173
struct wl_definition * ptr_definition
Definition: def_struct.h:31
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 type_disj
Definition: def_const.h:284
GENERIC value_1
Definition: def_struct.h:54
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
ptr_int_list next
Definition: def_struct.h:55
long c_module_access ( )

c_module_access

C_MODULE_ACCESS Return the psi-term Module::Symbol

Definition at line 1008 of file modules.c.

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

1009 {
1010  long success=FALSE;
1011  // ptr_psi_term result,module,symbol,call,other;
1012  ptr_psi_term call;
1013 
1014 
1015  call=aim->aaaa_1;
1016  deref_ptr(call);
1017 
1018  /*
1019  result=aim->bbbb_1;
1020  deref_ptr(result);
1021  get_two_args(call,(ptr_psi_term *)&module,(ptr_psi_term *)&symbol);
1022 
1023  if(module && symbol) {
1024  other=stack_psi_term(4);
1025  other->type=update_symbol(module_access,module_access->module_name);
1026  resid_aim=NULL;
1027  push_goal(unify,result,other,NULL);
1028 
1029  }
1030  */
1031 
1032  warningline("%P not implemented yet...\n",call);
1033 
1034  return success;
1035 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
void warningline(char *format,...)
Definition: error.c:327
long c_open_module ( )

c_open_module

C_OPEN_MODULE() Open one or more modules, that is, alias all the public words in the current module to the definitions in the argument. An error message is printed for each module that is not successfully opened. If at least one module was not successfully opened, the routine fails.

Definition at line 519 of file modules.c.

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

520 {
521  ptr_psi_term call;
522  int onefailed=FALSE;
523  call=aim->aaaa_1;
524  deref_ptr(call);
525  if (call->attr_list) {
526  open_module_tree(call->attr_list, &onefailed);
527  }
528  else {
529  Errorline("argument missing in '%P'\n",call);
530  }
531 
532  return !onefailed;
533 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void open_module_tree(ptr_node n, int *onefailed)
open_module_tree
Definition: modules.c:542
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
long c_private ( )

c_private

C_PRIVATE() The argument is a single symbol or a list of symbols. Make them private in the current module if they belong to it.

Definition at line 714 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, MAKE_PRIVATE, traverse_tree(), and TRUE.

715 {
716  ptr_psi_term call;
717  int success;
718 
719  call=aim->aaaa_1;
720  deref_ptr(call);
721  if (call->attr_list) {
723  success=TRUE;
724  } else {
725  Errorline("argument missing in '%P'\n",call);
726  success=FALSE;
727  }
728 
729  return success;
730 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void traverse_tree(ptr_node n, int flag)
traverse_tree
Definition: modules.c:656
void Errorline(char *format,...)
Definition: error.c:414
#define MAKE_PRIVATE
Definition: modules.c:644
#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
long c_private_feature ( )

c_private_feature

C_PRIVATE_FEATURE() The argument is a single symbol or a list of symbols. Make this feature private to the current module.

Definition at line 1302 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, MAKE_FEATURE_PRIVATE, traverse_tree(), and TRUE.

1303 {
1304  // ptr_psi_term arg1,arg2;
1305  ptr_psi_term call;
1306  int success;
1307 
1308  call=aim->aaaa_1;
1309  deref_ptr(call);
1310  if (call->attr_list) {
1312  success=TRUE;
1313  } else {
1314  Errorline("argument missing in '%P'\n",call);
1315  success=FALSE;
1316  }
1317 
1318  return success;
1319 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void traverse_tree(ptr_node n, int flag)
traverse_tree
Definition: modules.c:656
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 MAKE_FEATURE_PRIVATE
Definition: modules.c:645
ptr_node attr_list
Definition: def_struct.h:171
long c_public ( )

c_public

C_PUBLIC() The argument(s) are symbols. Make them public in the current module if they belong to it.

Definition at line 687 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, MAKE_PUBLIC, traverse_tree(), and TRUE.

688 {
689  // ptr_psi_term arg1,arg2;
690  ptr_psi_term call;
691  int success;
692 
693  call=aim->aaaa_1;
694  deref_ptr(call);
695  if (call->attr_list) {
697  success=TRUE;
698  } else {
699  Errorline("argument missing in '%P'\n",call);
700  success=FALSE;
701  }
702 
703  return success;
704 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void traverse_tree(ptr_node n, int flag)
traverse_tree
Definition: modules.c:656
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 MAKE_PUBLIC
Definition: modules.c:643
ptr_node attr_list
Definition: def_struct.h:171
c_put_raw ( )

c_put_raw

PutRaw c_put_raw (+Char) write the specified char on the standard output this built-in should be used only by the life-shell of Kathleen.

Definition at line 206 of file raw.c.

References begin_builtin, end_builtin, include_var_builtin, real, and TRUE.

207 {
209  ptr_definition types[1];
210 
211  types[0] = real;
212 
213  begin_builtin (c_put_raw, 1, 0, types);
214 
215  (void)putchar ((char) val[0]);
216  (void)fflush (stdout);
217  success = TRUE;
218  end_builtin ();
219 }
#define begin_builtin(FUNCNAME, NBARGS, NBARGSIN, TYPES)
Definition: def_macro.h:198
long c_put_raw()
c_put_raw
Definition: raw.c:206
ptr_definition real
Definition: def_glob.h:102
#define TRUE
Definition: def_const.h:127
#define include_var_builtin(NBARGS)
Definition: def_macro.h:191
#define end_builtin()
Definition: def_macro.h:254
long c_quiet ( )

whether quiet

Return the value of not(NOTQUIET).

Definition at line 186 of file bi_sys.c.

References wl_goal::aaaa_1, aim, wl_goal::bbbb_1, deref_args, deref_ptr, lf_false, lf_true, NOTQUIET, NULL, push_goal(), set_empty, stack_psi_term(), TRUE, wl_psi_term::type, and unify.

187 {
188  ptr_psi_term t,result,ans;
189  long success=TRUE;
190 
191  t=aim->aaaa_1;
193  result=aim->bbbb_1;
194  deref_ptr(result);
195  ans=stack_psi_term(4);
196  ans->type = NOTQUIET ? lf_false : lf_true;
197  push_goal(unify,result,ans,NULL);
198  return success;
199 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#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
#define set_empty
Definition: def_const.h:193
#define NULL
Definition: def_const.h:203
#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
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
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)
overlap_type
Definition: types.c:1579
#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)
find
Definition: trees.c:394
#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
long c_replace ( )

c_replace

C_REPLACE() Replace all occurrences of type ARG1 with ARG2 in ARG3.

Definition at line 936 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_node::data, deref_ptr, Errorline(), FALSE, FEATCMP, find(), get_two_args(), NULL, replace(), three, TRUE, and wl_psi_term::type.

937 {
938  ptr_psi_term arg1=NULL;
939  ptr_psi_term arg2=NULL;
940  ptr_psi_term arg3=NULL;
941  ptr_psi_term call;
942  int success=FALSE;
943  ptr_node n;
944 
945  call=aim->aaaa_1;
946  deref_ptr(call);
947 
948  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
949  n=find(FEATCMP,three,call->attr_list);
950  if (n)
951  arg3=(ptr_psi_term)n->data;
952 
953  if(arg1 && arg2 && arg3) {
954  deref_ptr(arg1);
955  deref_ptr(arg2);
956  deref_ptr(arg3);
957  replace(arg1->type,arg2->type,arg3);
958  success=TRUE;
959  }
960  else {
961  Errorline("argument missing in '%P'\n",call);
962  }
963 
964  return success;
965 }
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
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
char * three
Definition: def_glob.h:252
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
void replace(ptr_definition old, ptr_definition new, ptr_psi_term term)
replace
Definition: modules.c:851
#define FALSE
Definition: def_const.h:128
ptr_goal aim
Definition: def_glob.h:49
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
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
long c_reset_window_flag ( )

c_reset_window_flag

ResetWindowFlag reset_window_flag () return the flag x_window_creation this built-in should be used only by the life-shell of Kathleen.

Definition at line 294 of file raw.c.

References aim, deref_ptr, FALSE, TRUE, and x_window_creation.

295 {
296  deref_ptr (aim->a);
297 #ifdef X11
299 #endif
300 
301  return TRUE;
302 }
long x_window_creation
Definition: def_glob.h:217
#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 c_set_module ( )

c_set_module

C_SET_MODULE() This routine retrieves the necessary psi-term to determine the current state of the module mechanism from the heap.

Definition at line 488 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, create_module(), deref_ptr, Errorline(), FALSE, get_two_args(), set_current_module(), string_val(), and TRUE.

489 {
490  ptr_psi_term arg1,arg2;
491  ptr_psi_term call;
492 
493  call=aim->aaaa_1;
494  deref_ptr(call);
495  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
496 
497  if(arg1) {
499  return TRUE;
500  }
501  else {
502  Errorline("argument missing in '%P'\n",call);
503  return FALSE;
504  }
505 }
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 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_module create_module(char *module)
ptr_module create_module(char *module)
Definition: modules.c:72
char * string_val(ptr_psi_term term)
string_val
Definition: modules.c:169
ptr_module set_current_module(ptr_module module)
set_current_module
Definition: modules.c:100
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)
overlap_type
Definition: types.c:1579
#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)
find
Definition: trees.c:394
#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
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)
overlap_type
Definition: types.c:1579
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)
find
Definition: trees.c:394
#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
long c_tprove ( )

UNSURE.

UNSURE

Definition at line 81 of file bi_sys.c.

References wl_goal::aaaa_1, aim, deref_args, set_empty, set_trace_to_prove(), and TRUE.

82 {
83  ptr_psi_term t;
84 
85  t=aim->aaaa_1;
88  return TRUE;
89 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define set_empty
Definition: def_const.h:193
void set_trace_to_prove()
Definition: error.c:639
#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
long c_trace ( )

trace

long c_trace() turn tracing on or off

Definition at line 30 of file bi_sys.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_args, deref_ptr, Errorline(), FALSE, get_two_args(), is_top, lf_false, lf_true, set_empty, stepflag, toggle_trace(), trace, TRUE, wl_psi_term::type, and unify_bool_result().

31 {
32  long success=TRUE;
33  ptr_psi_term t,arg1,arg2;
34 
35  t=aim->aaaa_1;
37  get_two_args(t->attr_list,&arg1,&arg2);
38  if (arg1) {
39  deref_ptr(arg1);
40  if (is_top(arg1)) {
42  trace=FALSE;
43  }
44  else if (arg1->type==lf_true)
45  trace=TRUE;
46  else if (arg1->type==lf_false)
47  trace=FALSE;
48  else {
49  Errorline("bad first argument in %P.\n",t);
50  /* report_error(t,"bad first argument"); */
51  success=FALSE;
52  }
53  }
54  if (arg2) {
55  deref_ptr(arg2);
56  if (is_top(arg2)) {
59  }
60  else if (arg2->type==lf_true)
61  stepflag=TRUE;
62  else if (arg2->type==lf_false)
64  else {
65  Errorline("bad second argument in %P.\n",t);
66  /* report_error(t,"bad second argument"); */
67  success=FALSE;
68  }
69  }
70  if (!arg1 && !arg2)
71  toggle_trace();
72  return success;
73 }
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 unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
#define set_empty
Definition: def_const.h:193
long trace
Definition: def_glob.h:272
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
void toggle_trace()
Definition: error.c:644
ptr_definition lf_false
Definition: def_glob.h:89
long stepflag
Definition: def_glob.h:150
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
ptr_node attr_list
Definition: def_struct.h:171
long c_trace_input ( )

c_trace_input

C_TRACE_INPUT(); Set the trace_input switch.

Definition at line 810 of file modules.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, deref_ptr, Errorline(), FALSE, get_two_args(), lf_false, lf_true, trace_input, TRUE, and wl_psi_term::type.

811 {
812  ptr_psi_term arg1,arg2;
813  ptr_psi_term call;
814  int success=TRUE;
815 
816  call=aim->aaaa_1;
817  deref_ptr(call);
818  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
819 
820  if(arg1) {
821  deref_ptr(arg1);
822  if(arg1->type==lf_true)
824  else
825  if(arg1->type==lf_false)
827  else {
828  Errorline("argument should be boolean in '%P'\n",call);
829  success=FALSE;
830  }
831  }
832  else /* No argument: toggle */
834 
835  return success;
836 }
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 trace_input
Definition: def_glob.h:167
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_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
long c_window_flag ( )

c_window_flag

WindowFlag window_flag () return TRUE if a window has been created this built-in should be used only by the life-shell of Kathleen.

Definition at line 273 of file raw.c.

References aim, deref_ptr, FALSE, TRUE, unify_bool_result(), and x_window_creation.

274 {
275  deref_ptr (aim->a);
276 #ifdef X11
278 #else
280 #endif
281 
282  return TRUE;
283 }
void unify_bool_result(ptr_psi_term t, long v)
unify_bool_result
Definition: built_ins.c:345
long x_window_creation
Definition: def_glob.h:217
#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 call_primitive ( long(*)()  fun,
int  num,
psi_arg  argi[],
GENERIC  info 
)

call_primitive

Parameters
(long(*fun)(),
intnum
psi_argargi[]
GENERICinfo

Definition at line 24 of file sys.c.

References wl_goal::aaaa_1, aim, ARGNN, wl_psi_term::attr_list, wl_goal::bbbb_1, c_abort(), curry(), wl_node::data, deref, deref_ptr, Errorline(), FALSE, FEATCMP, find(), JUSTFAIL, MANDATORY, NOVALUE, NULL, overlap_type(), POLYTYPE, REQUIRED, residuate(), sub_type(), TRUE, wl_psi_term::type, psi_arg::type, UNEVALED, and wl_psi_term::value_3.

25 {
26  ptr_psi_term funct,arg,result,argo[ARGNN]; /* no more than 10 arguments */
27  ptr_node n;
28  int allargs=1,allvalues=1,i;
29  funct=aim->aaaa_1;
30  deref_ptr(funct);
31  result=aim->bbbb_1;
32  for (i=0;i<num;i++) {
33  n=find(FEATCMP,argi[i].feature,funct->attr_list);
34  /* argument present */
35  if (n) {
36  arg = (ptr_psi_term) n->data;
37  /* in case we don't want to evaluate the argument
38  just follow the chain of corefs and don't do
39  any of the other checks: they'll have do be done
40  by fun; just go on to the next arg */
41  if (argi[i].options&UNEVALED) {
42  deref_ptr(arg);
43  argo[i]=arg;
44  continue; }
45  /* this arg should be evaled */
46  deref(arg);
47  argo[i]=arg;
48  /* arg of admissible type */
49  if (argi[i].options&POLYTYPE) {
50  ptr_definition *type = (ptr_definition *)argi[i].type;
51  while (*type != NULL)
52  if (overlap_type(arg->type,*type))
53  goto admissible;
54  else type++;
55  }
56  else {
57  if (overlap_type(arg->type,argi[i].type))
58  goto admissible;
59  }
60  /* not admissible */
61  if (argi[i].options&JUSTFAIL) return FALSE;
62  Errorline("Illegal argument in %P.\n",funct);
63  return (c_abort());
64  /* admissible */
65  admissible:
66  /* has value */
67  if (arg->value_3) {
68  ptr_definition *type = (ptr_definition *)argi[i].type;
69  /* paranoid check: really correct type */
70  if (argi[i].options&POLYTYPE) {
71  while (*type != NULL)
72  if (sub_type(arg->type,*type))
73  goto correct;
74  else type++;
75  }
76  else {
77  if (sub_type(arg->type,(ptr_definition)type)) goto correct;
78  }
79  /* type incorrect */
80  if (argi[i].options&JUSTFAIL) return FALSE;
81  Errorline("Illegal argument in %P.\n",funct);
82  return (c_abort());
83  /* correct */
84  correct:;
85  }
86  /* missing value - do we need it */
87  else if (!(argi[i].options&NOVALUE)) allvalues=0;
88  }
89  /* argument missing */
90  else {
91  argo[i]=NULL;
92  if (argi[i].options&MANDATORY) {
93  Errorline("Missing argument '%s' in %P.\n",argi[i].feature,funct);
94  return (c_abort());
95  }
96  else if (argi[i].options&REQUIRED) allargs=0;
97  }
98  }
99  if (allargs)
100  if (allvalues) {
101  return fun(argo,result,funct,info);
102  }
103  else {
104  for (i=0;i<num;i++) {
105  /* if arg present and should be evaled but has no value */
106  if (argo[i] && !(argi[i].options&UNEVALED) && !argo[i]->value_3)
107  residuate(argo[i]);
108  }
109  }
110  else curry();
111  return TRUE;
112 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define MANDATORY
Definition: def_const.h:219
#define FEATCMP
Definition: def_const.h:257
void residuate(ptr_psi_term t)
residuate
Definition: lefun.c:125
long c_abort()
c_abort
Definition: built_ins.c:2248
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)
overlap_type
Definition: types.c:1579
#define JUSTFAIL
Definition: def_const.h:217
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition type
Definition: def_struct.h:364
#define REQUIRED
Definition: def_const.h:215
#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
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
#define NOVALUE
Definition: def_const.h:220
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
#define ARGNN
Definition: def_const.h:347
#define POLYTYPE
Definition: def_const.h:218
#define UNEVALED
Definition: def_const.h:216
void check_attr ( ptr_node n)

check_attr

Parameters
ptr_node*n

CHECK_ATTR(attribute-tree) Check an attribute tree. (Could improve this by randomly picking left or right subtree for last call optimization. This would never overflow, even on very skewed attribute trees.)

Definition at line 1054 of file memory.c.

References check_psi_term(), check_string(), and unchecked().

1055 {
1056  while (unchecked((GENERIC *)n,sizeof(node))) { // added cast DJD 12/8/2016
1057  check_attr(&((*n)->left));
1058  check_string((GENERIC *)&((*n)->key)); // added cast DJD 12/8/2016
1059  check_psi_term((struct wl_psi_term **)&((*n)->data));
1060 
1061  n = &((*n)->right);
1062  /* check_attr(&((*n)->right)); 9.6 */
1063  }
1064 }
static void check_string(GENERIC *s)
check_string
Definition: memory.c:405
static long unchecked(GENERIC *p, long len)
unchecked
Definition: memory.c:338
void check_psi_term(ptr_psi_term *t)
check_psi_term
Definition: memory.c:987
unsigned long * GENERIC
Definition: def_struct.h:17
void check_attr(ptr_node *n)
check_attr
Definition: memory.c:1054
void check_definition ( ptr_definition d)

check_definition

Parameters
ptr_definition*d

CHECK_DEFINITION This goes through the type tree which contains the parents and children lists for all types, and the attributed code. The code field is not checked as this has been done separately by CHECK_GAMMA.

Definition at line 662 of file memory.c.

References check_code(), check_keyword(), check_kids(), check_operator_data(), check_pair_list(), check_psi_term(), check_triple_list(), wl_definition::keyword, wl_keyword::symbol, type_it, and unchecked().

663 {
664  if(unchecked((GENERIC *)d,sizeof(definition))) { // added cast DJD 12/8/2016
665 
666  check_keyword((ptr_keyword *)&((*d)->keyword)); /* RM: Jan 12 1993 */ // added cast DJD 12/8/2016
667 
668 #ifdef prlDEBUG
669  printf("%lx %20s %ld\n",*d,(*d)->keyword->symbol,amount_used);
670 #endif
671 
672  check_code((ptr_int_list *)&((*d)->code)); // added cast DJD 12/8/2016
673  check_pair_list((ptr_pair_list *)&((*d)->rule)); // added cast DJD 12/8/2016
674  check_triple_list(&((*d)->properties));
675 
676  if ((*d)->type_def==(def_type)type_it) {
677  check_kids(&((*d)->parents));
678  check_kids(&((*d)->children));
679  }
680 
681  check_psi_term(&((*d)->global_value)); /* RM: Feb 9 1993 */
682  check_psi_term(&((*d)->init_value)); /* RM: Mar 23 1993 */
683 
684  check_operator_data(&((*d)->op_data)); /* PVR 5.6 */
685 
686 #ifdef CLIFE
687  check_block_def(&((*d)->block_def)); /* RM: Jan 27 1993 */
688 #endif /* CLIFE */
689  }
690 }
static void check_operator_data(ptr_operator_data *op)
check_operator_data
Definition: memory.c:551
ptr_keyword keyword
Definition: def_struct.h:124
static void check_pair_list(ptr_pair_list *p)
check_pair_list
Definition: memory.c:500
char * symbol
Definition: def_struct.h:91
static long unchecked(GENERIC *p, long len)
unchecked
Definition: memory.c:338
#define type_it
Definition: def_const.h:363
static void check_kids(ptr_int_list *c)
check_kids
Definition: memory.c:535
static void check_triple_list(ptr_triple_list *p)
check_triple_list
Definition: memory.c:517
void check_psi_term(ptr_psi_term *t)
check_psi_term
Definition: memory.c:987
static void check_code(ptr_int_list *c)
check_code
Definition: memory.c:486
unsigned long * GENERIC
Definition: def_struct.h:17
static void check_keyword()
void check_definition_list ( )

check_definition_list

CHECK_DEFINITION_LIST This checks the entire list of definitions.

Definition at line 699 of file memory.c.

References check_definition(), and first_definition.

700 {
701  ptr_definition *d;
702 
703  d= &first_definition;
704 
705  while(*d) {
706  check_definition(d);
707  d= &((*d)->next);
708  }
709 }
void check_definition(ptr_definition *d)
check_definition
Definition: memory.c:662
ptr_definition first_definition
Definition: def_glob.h:3
void check_disj ( ptr_psi_term  t)

check_disj

Parameters
ptr_psi_termt

CHECK_DISJ(t) Deal with disjunctions.

Definition at line 910 of file lefun.c.

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

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

check_func

Parameters
ptr_psi_termt

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

Definition at line 928 of file lefun.c.

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

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

check_gamma_code

CHECK_GAMMA_CODE() Check and update the code reversing table. In this part, only the codes are checked in the definitions, this is vital because these codes are used later to distinguish between the various data types and to determine the type of the VALUE field in psi_terms. Misunderstanding this caused a lot of bugs in the GC.

Definition at line 1078 of file memory.c.

References check_def_code(), gamma_table, type_count, and unchecked().

1079 {
1080  long i;
1081 
1082  if (unchecked((GENERIC *)&gamma_table,type_count*sizeof(ptr_definition))) { // added cast DJD 12/8/2016
1083  for (i=0;i<type_count;i++)
1084  check_def_code(&(gamma_table[i]));
1085  }
1086 }
long type_count
Definition: def_glob.h:46
static long unchecked(GENERIC *p, long len)
unchecked
Definition: memory.c:338
static void check_def_code(ptr_definition *d)
check_def_code
Definition: memory.c:720
ptr_definition * gamma_table
Definition: def_glob.h:309
unsigned long * GENERIC
Definition: def_struct.h:17
void check_hash_table ( ptr_hash_table  table)

check_hash_table

Parameters
ptr_hash_tabletable

CHECK_HASH_TABLE(table) Check a hash table of keywords. The actual table is not stored within LIFE memory.

Definition at line 625 of file memory.c.

References check_keyword(), wl_hash_table::data, and wl_hash_table::size.

626 {
627  long i;
628 
629  for(i=0;i<table->size;i++)
630  if(table->data[i])
631  check_keyword((ptr_keyword *)&(table->data[i]));
632 }
ptr_keyword * data
Definition: def_struct.h:114
static void check_keyword()
long check_legal_cons ( ptr_psi_term  t,
ptr_definition  t_type 
)

check_legal_cons

Parameters
ptr_psi_termt
ptr_definitiont_type

CHECK_LEGAL_CONS(t,t_type) Check that T is of type T_TYPE, that it has exactly the attributes '1' and '2' and that the 2nd is either nil or also long check_legal_cons(t,t_type)

Definition at line 713 of file print.c.

References wl_psi_term::attr_list, count_features(), FEATCMP, find(), one, two, and wl_psi_term::type.

714 {
715  return (t->type==t_type &&
716  count_features(t->attr_list)==2 &&
717  find(FEATCMP,one,t->attr_list) &&
718  find(FEATCMP,two,t->attr_list));
719 }
#define FEATCMP
Definition: def_const.h:257
char * two
Definition: def_glob.h:251
char * one
Definition: def_glob.h:250
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
long check_opargs ( ptr_node  n)

check_opargs

Parameters
ptr_noden

Routines to handle printing of operators. The main routine is pretty_psi_with_ops, which is called in pretty_psi_term.

Check arguments of a potential operator. Returns existence of arguments 1 and 2 in low two bits of result. If only argument "1" exists, returns 1. If only arguments "1" and "2" exist, returns 3. Existence of any other arguments causes third bit to be set as well.

Definition at line 887 of file print.c.

References featcmp(), wl_node::key, wl_node::left, and wl_node::right.

888 {
889  if (n) {
890  long f=check_opargs(n->left) | check_opargs(n->right);
891  if (!featcmp(n->key,"1")) return 1 | f;
892  if (!featcmp(n->key,"2")) return 2 | f;
893  return 4 | f;
894  }
895  else
896  return 0;
897 }
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
ptr_node right
Definition: def_struct.h:184
long check_out ( ptr_psi_term  t)

Definition at line 1083 of file lefun.c.

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

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

check_pointer

Parameters
ptr_psi_termp

CHECK_POINTER(p) Count the number of times address P has been encountered in the current psi-term being printed. If it is more than once then a tag will have to be used. If P has not already been seen, then explore the psi_term it points to.

Definition at line 233 of file print.c.

References wl_node::data, deref_ptr, find(), go_through(), heap_insert(), INTCMP, no_name, NULL, and pointer_names.

234 {
235  ptr_node n;
236 
237  if (p) {
238  deref_ptr(p);
239  n=find(INTCMP,(char *)p,pointer_names);
240  if (n==NULL) {
241  (void)heap_insert(INTCMP,(char *)p,&pointer_names,(GENERIC)NULL);
242  go_through(p);
243  }
244  else
245  n->data=(GENERIC)no_name;
246  }
247 }
#define INTCMP
Definition: def_const.h:256
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
ptr_node pointer_names
Definition: def_glob.h:29
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
unsigned long * GENERIC
Definition: def_struct.h:17
void check_psi_term ( ptr_psi_term t)

check_psi_term

Parameters
ptr_psi_term*t

CHECK_PSI_TERM(t) Explore a psi_term.

Definition at line 987 of file memory.c.

References alist, assert, check_attr(), check_bytedata(), check_definition(), check_resid(), check_string(), choice_stack, cut, Errorline(), heap_pointer, LONELY, mem_limit, NULL, pass, quoted_string, REAL, real, stream, sub_type(), sys_bytedata, unchecked(), and variable.

988 {
989  ptr_list *l;
990 
991  while (unchecked((GENERIC *)t,sizeof(psi_term))) { // added cast DJD 12/8/2016
992 
993  /* A psi-term on the heap has no residuation list. */
994  if (pass==1 && (GENERIC)(*t)>=heap_pointer && (GENERIC)(*t)<mem_limit) {
995  assert((*t)->resid==NULL);
996  }
997  check_definition(&((*t)->type));
998  check_attr(&((*t)->attr_list));
999 
1000  if ((*t)->value_3) {
1001 
1002  if ((*t)->type==alist) { /* RM: Dec 15 1992 Should be removed */
1003  l=(ptr_list *) &((*t)->value_3);
1004  if (l)
1005  printf("Found an old list!\n");
1006  }
1007  else
1008 
1009  if (sub_type((*t)->type,real))
1010  (void)unchecked((GENERIC *)&((*t)->value_3),sizeof(REAL)); // added cast DJD 12/8/2016
1011  else if (sub_type((*t)->type,quoted_string))
1012  check_string((GENERIC *)&((*t)->value_3)); // added cast DJD 12/8/2016
1013  /* DENYS: BYTEDATA */
1014  else if (sub_type((*t)->type,sys_bytedata))
1015  check_bytedata(&((*t)->value_3));
1016 #ifdef CLIFE
1017  else if ((*t)->type->type==block) { /* RM: Jan 27 1993 */
1018  check_block_value(&((*t)->value_3));
1019  }
1020 #endif /* CLIFE */
1021  else if ((*t)->type==cut) { /* RM: Oct 28 1993 */
1022  /* assert((*t)->value_3 <= (GENERIC)choice_stack); 12.7 17.7 */
1023  if (pass==1 && (*t)->value_3>(GENERIC)choice_stack)
1024  (*t)->value_3=(GENERIC)choice_stack;
1025  (void)unchecked((GENERIC *)&((*t)->value_3),LONELY); // added cast DJD 12/8/2016
1026  }
1027  else if (sub_type((*t)->type,variable)) /* 8.8 */
1028  check_string((GENERIC *)&((*t)->value_3)); // added cast DJD 12/8/2016
1029  else if ((*t)->type!=stream)
1030  Errorline("non-NULL value field in garbage collector, type='%s', value=%d.\n",
1031  (*t)->type->keyword->combined_name,
1032  (*t)->value_3);
1033  }
1034 
1035  /* check_psi_term(&((*t)->coref)); 9.6 */
1036  if ((*t)->resid)
1037  check_resid((ptr_residuation *)&((*t)->resid)); // added cast DJD 12/8/2016
1038 
1039  t = &((*t)->coref);
1040  }
1041 }
static void check_bytedata(GENERIC *s)
check_bytedata
Definition: memory.c:450
static void check_resid(ptr_residuation *r)
check_resid
Definition: memory.c:914
GENERIC mem_limit
Definition: def_glob.h:13
ptr_definition stream
Definition: def_glob.h:103
static void check_string(GENERIC *s)
check_string
Definition: memory.c:405
static long pass
Definition: memory.c:21
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
static long unchecked(GENERIC *p, long len)
unchecked
Definition: memory.c:338
struct wl_list * ptr_list
Definition: def_struct.h:38
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
void check_definition(ptr_definition *d)
check_definition
Definition: memory.c:662
void Errorline(char *format,...)
Definition: error.c:414
ptr_definition real
Definition: def_glob.h:102
ptr_definition alist
Definition: def_glob.h:94
ptr_definition quoted_string
Definition: def_glob.h:101
GENERIC heap_pointer
Definition: def_glob.h:12
ptr_definition sys_bytedata
Definition: def_glob.h:336
ptr_definition cut
Definition: def_glob.h:83
#define LONELY
Definition: memory.c:24
unsigned long * GENERIC
Definition: def_struct.h:17
void check_attr(ptr_node *n)
check_attr
Definition: memory.c:1054
ptr_definition variable
Definition: def_glob.h:111
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define assert(N)
Definition: memory.c:113
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)
matches
Definition: types.c:1666
#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
void check_resid_block ( ptr_resid_block rb)

check_resid_block

Parameters
ptr_resid_block*rb

CHECK_RESID_BLOCK(rb) Explore a residuation block.

Definition at line 965 of file memory.c.

References check_goal_stack(), check_resid_list(), LONELY, and unchecked().

966 {
967  if (*rb) {
968  if (unchecked((GENERIC *)rb,sizeof(resid_block))) { // added cast DJD 12/8/2016
969  check_goal_stack((ptr_goal *)&((*rb)->ra)); // added cast DJD 12/8/2016
970  check_resid_list(&((*rb)->rv)); /* 21.9 */
971  /* unchecked(&((*rb)->rl),LONELY); 12.6 */ /* 10.6 */
972  (void)unchecked((GENERIC *)&((*rb)->md),LONELY); /* 10.6 */ // added cast DJD 12/8/2016
973  /* check_goal_stack(&((*rb)->rl)); 10.6 */
974  /* check_psi_term(&((*rb)->md)); 10.6 */
975  }
976  }
977 }
static void check_resid_list()
static void check_goal_stack(ptr_goal *g)
check_goal_stack
Definition: memory.c:800
static long unchecked(GENERIC *p, long len)
unchecked
Definition: memory.c:338
#define LONELY
Definition: memory.c:24
unsigned long * GENERIC
Definition: def_struct.h:17
void check_sys_definitions ( )

check_sys_definitions

Definition at line 2192 of file sys.c.

References check_definition(), sys_bitvector, sys_bytedata, sys_file_stream, sys_regexp, sys_socket_stream, and sys_stream.

2193 {
2194  check_definition(&sys_bytedata); /* DENYS: BYTEDATA */
2205 #ifdef LIFE_NDBM
2206  check_ndbm_definitions();
2207 #endif
2208 }
ptr_definition sys_regexp
Definition: def_glob.h:131
ptr_definition sys_file_stream
Definition: def_glob.h:133
ptr_definition sys_stream
Definition: def_glob.h:132
ptr_definition sys_process_signaled
Definition: sys.c:1716
ptr_definition sys_bitvector
Definition: def_glob.h:130
ptr_definition sys_process_stopped
Definition: sys.c:1717
ptr_definition sys_process_continued
Definition: sys.c:1718
void check_definition(ptr_definition *d)
check_definition
Definition: memory.c:662
ptr_definition sys_bytedata
Definition: def_glob.h:336
ptr_definition sys_socket_stream
Definition: def_glob.h:134
ptr_definition sys_process_exited
Definition: sys.c:1715
ptr_definition sys_process_no_children
Definition: sys.c:1714
long check_type ( ptr_psi_term  t)

check_type

Parameters
ptr_psi_termt

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

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

Definition at line 990 of file lefun.c.

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

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

clause_aim

Parameters
longr

CLAUSE_AIM(r) Prove a CLAUSE or RETRACT goal. That is try to unify the calling argument with the current rule. If this succeeds and R=TRUE then delete the rule (RETRACT).

Definition at line 1879 of file login.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, wl_goal::cccc_1, clause, clear_copy(), del_clause, Errorline(), FALSE, i_eval_args(), wl_definition::keyword, MAX_BUILT_INS, NULL, push_choice_point(), push_goal(), quote_copy(), retract, STACK, wl_psi_term::status, wl_keyword::symbol, traceline(), TRUE, wl_psi_term::type, and unify.

1880 {
1881  long success=FALSE;
1882  ptr_pair_list *p;
1883  ptr_psi_term head,body,rule_head,rule_body;
1884 
1885  head=(ptr_psi_term)aim->aaaa_1;
1886  body=(ptr_psi_term)aim->bbbb_1;
1887  p=(ptr_pair_list *)aim->cccc_1;
1888 
1889  if ((unsigned long)(*p)>MAX_BUILT_INS) {
1890  success=TRUE;
1891  /* deref(head); 17.9 */
1892 
1893  if ((*p)->next) {
1894  if (r) {
1895  traceline("pushing 'retract' choice point for %P\n", head);
1896  push_choice_point(del_clause,head,(ptr_psi_term)body,(GENERIC)&((*p)->next));
1897  /* push_choice_point(del_clause,head,body,p); */
1898  }
1899  else {
1900  traceline("pushing 'clause' choice point for %P\n", head);
1901  push_choice_point(clause,head,(ptr_psi_term)body,(GENERIC)&((*p)->next));
1902  }
1903  }
1904 
1905  if (r)
1907  if ((*p)->aaaa_2) {
1908  clear_copy();
1909  rule_head=quote_copy((*p)->aaaa_2,STACK);
1910  rule_body=quote_copy((*p)->bbbb_2,STACK);
1911 
1912  push_goal(unify,(ptr_psi_term)body,(ptr_psi_term)rule_body,NULL);
1913  push_goal(unify,(ptr_psi_term)head,(ptr_psi_term)rule_head,NULL);
1914 
1915  rule_head->status=4;
1916  rule_body->status=4;
1917 
1918  (void)i_eval_args(rule_body->attr_list);
1919  (void)i_eval_args(rule_head->attr_list);
1920 
1921  traceline("fetching next clause for %s\n", head->type->keyword->symbol);
1922  }
1923  else {
1924  success=FALSE;
1925  traceline("following clause had been retracted\n");
1926  }
1927  }
1928  else if ((unsigned long)(*p)>0) {
1929  if (r)
1930  Errorline("the built-in %P cannot be retracted.\n",head);
1931  else
1932  Errorline("the definition of built-in %P is not accessible.\n",head);
1933  }
1934 
1935  return success;
1936 }
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 aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
push_goal
Definition: login.c:600
GENERIC cccc_1
Definition: def_struct.h:226
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
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 TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define clause
Definition: def_const.h:285
ptr_goal aim
Definition: def_glob.h:49
#define retract
Definition: def_const.h:287
#define unify
Definition: def_const.h:274
long i_eval_args(ptr_node n)
i_eval_args
Definition: lefun.c:874
#define del_clause
Definition: def_const.h:286
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
#define MAX_BUILT_INS
Definition: def_const.h:82
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
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
push_choice_point
Definition: login.c:638
#define STACK
Definition: def_const.h:148
void clean_undo_window ( long  disp,
long  wind 
)

clean_undo_window

Parameters
longdisp
longwind

CLEAN_UNDO_WINDOW(disp,wind) Remove all trail entries that reference a given window. This is called when the window is destroyed.

Definition at line 848 of file login.c.

References choice_stack, wl_stack::next, undo_action, wl_choice_point::undo_point, and undo_stack.

849 {
850  // ptr_stack *prev,u;
851  // ptr_choice_point c;
852 
853 #ifdef X11
854  /* Remove entries on the trail */
855  u = undo_stack;
856  prev = &undo_stack;
857  while (u) {
858  if ((u->type & undo_action) &&
859  ((unsigned long)u->aaaa_3==disp) && ((unsigned long)u->bbbb_3==wind)) {
860  *prev = u->next;
861  }
862  prev = &(u->next);
863  u = u->next;
864  }
865 
866  /* Remove entries at the *tops* of trail entry points from the */
867  /* choice point stack. It's only necessary to look at the tops, */
868  /* since those are the only ones that haven't been touched by */
869  /* the previous while loop. */
870  c = choice_stack;
871  while (c) {
872  u = c->undo_point;
873  prev = &(c->undo_point);
874  while (u && (u->type & undo_action) &&
875  ((unsigned long)u->aaaa_3==disp) && ((unsigned long)u->bbbb_3==wind)) {
876  *prev = u->next;
877  prev = &(u->next);
878  u = u->next;
879  }
880  c = c->next;
881  }
882 #endif
883 }
ptr_stack undo_point
Definition: def_struct.h:233
ptr_stack undo_stack
Definition: def_glob.h:53
#define undo_action
Definition: def_const.h:188
ptr_stack next
Definition: def_struct.h:219
ptr_choice_point choice_stack
Definition: def_glob.h:51
void clear_already_loaded ( ptr_node  n)

clear_already_loaded

Parameters
ptr_noden

CLEAR_ALREADY_LOADED() Clear the 'already_loaded' flags in all symbol table entries. Done at each top level prompt.

Definition at line 351 of file types.c.

References wl_definition::already_loaded, wl_node::data, FALSE, wl_node::left, and wl_node::right.

352 {
353  ptr_definition d;
354 
355  if (n) {
356  d=((ptr_keyword)n->data)->definition;
360  }
361 }
char already_loaded
Definition: def_struct.h:137
void clear_already_loaded(ptr_node n)
clear_already_loaded
Definition: types.c:351
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define FALSE
Definition: def_const.h:128
struct wl_keyword * ptr_keyword
Definition: def_struct.h:99
ptr_node right
Definition: def_struct.h:184
void clear_coding ( )

clear_coding

CLEAR_CODING() Clear the bit-vector coding of the sorts.

Definition at line 727 of file types.c.

References wl_definition::code, first_definition, wl_definition::next, NOT_CODED, wl_definition::type_def, and type_it.

728 {
729  ptr_definition d;
730 
731  for(d=first_definition;d;d=d->next)
732  if (d->type_def==(def_type)type_it) d->code=NOT_CODED;
733 }
#define NOT_CODED
Definition: def_const.h:134
def_type type_def
Definition: def_struct.h:133
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_int_list code
Definition: def_struct.h:129
void clear_copy ( )

clear_copy

CLEAR_COPY() Erase the hash table. This must be done as a prelude to any copying operation.

Definition at line 53 of file copy.c.

References hashfree, and hashtime.

54 {
55  hashtime++;
56  hashfree=0;
57 }
static long hashfree
Definition: copy.c:19
static long hashtime
Definition: copy.c:18
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)
stack_add_psi_attr
Definition: token.c:239
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)
stack_add_int_attr
Definition: token.c:94
#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
ptr_int_list cons ( GENERIC  v,
ptr_int_list  l 
)

cons

Parameters
GENERICv
ptr_int_listl

CONS(value,list) Returns the list [VALUE|LIST]

Definition at line 179 of file types.c.

References HEAP_ALLOC, wl_int_list::next, and wl_int_list::value_1.

180 {
181  ptr_int_list n;
182 
183  n=HEAP_ALLOC(int_list);
184  n->value_1=v;
185  n->next=l;
186 
187  return n;
188 }
GENERIC value_1
Definition: def_struct.h:54
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
ptr_psi_term copy ( ptr_psi_term  t,
long  copy_flag,
long  heap_flag 
)

copy

Parameters
ptr_psi_termt
longcopy_flag
longheap_flag

COPY(t) This is the workhorse of the interpreter (alas!). All copy-related routines are non-interruptible by the garbage collector.

Make a copy in the STACK or in the HEAP of psi_term t, which is located in the HEAP. A copy is done whenever invoking a rule, so it had better be fast. This routine uses hash tables with buckets and partial inlining for speed.

The following three versions of copy all rename their variables and return a completely dereferenced object:

u=exact_copy(t,hf) u is an exact copy of t. u=quote_copy(t,hf) u is a copy of t that is recursively marked evaluated. u=eval_copy(t,hf) u is a copy of t that is recursively marked unevaluated.

This version of copy is an incremental copy to the heap. It copies only those parts of a psi_term that are on the stack, leaving the others unchanged:

u=inc_heap_copy(t) u is an exact copy of t, on the heap. This is like hf==HEAP, except that objects already on the heap are untouched. Relies on no pointers from heap to stack.

hf = heap_flag. hf = HEAP or STACK means allocate in the HEAP or STACK. Marking eval/uneval is done by modifying the STATUS field of the copied psi_term. In eval_copy, a term's status is set to 0 if the term or any subterm needs evaluation. Terms are dereferenced when copying them to the heap.

Definition at line 248 of file copy.c.

References abort_life(), wl_psi_term::attr_list, choice_stack, COPY_THRESHOLD, copy_tree(), curr_status, cut, deref_ptr, env, Errorline(), EVAL_FLAG, wl_definition::evaluate_args, FALSE, wl_psi_term::flags, function_it, global, global_time_stamp, HEAP, heap_pointer, HEAPDONE, insert_translation(), mark_quote_c(), NEW, NULL, wl_definition::properties, QUOTE_FLAG, QUOTE_STUB, QUOTED_TRUE, wl_psi_term::resid, stack_pointer, wl_psi_term::status, traceline(), translate(), TRUE, wl_psi_term::type, wl_definition::type_def, type_it, and wl_psi_term::value_3.

249 {
250  ptr_psi_term u;
251  long old_status;
252  long local_copy_flag;
253  long *infoptr;
254 
255 
256  if ((u=t)) {
257  deref_ptr(t); /* Always dereference when copying */
258 
259  if (HEAPDONE(t)) return t;
260  u = translate(t,&infoptr);
261 
262  if (u && *infoptr!=QUOTE_STUB) { /* 24.8 */
263  /* If it was eval-copied before, then quote it now. */
264  if (*infoptr==EVAL_FLAG && copy_flag==QUOTE_FLAG) { /* 24.8 25.8 */
265  mark_quote_c(t,heap_flag);
266  *infoptr=QUOTE_FLAG; /* I.e. don't touch this term any more */
267  }
268  if (copy_flag==EVAL_FLAG) { /* PVR 14.2.94 */
269  /* If any subterm has zero curr_status (i.e., if u->status==0),
270  then so does the whole term: */
271  old_status=curr_status;
272  curr_status=u->status;
273  if (curr_status) curr_status=old_status;
274  }
275  }
276  else {
278  Errorline("psi-term too large -- get a bigger Life!\n");
279  (void)abort_life(TRUE);
280  longjmp(env,FALSE); /* Back to main loop */ /* RM: Feb 15 1993 */
281  }
282  if (copy_flag==EVAL_FLAG && !t->type->evaluate_args) /* 24.8 25.8 */
283  local_copy_flag=QUOTE_FLAG; /* All arguments will be quoted 24.8 */
284  else /* 24.8 */
285  local_copy_flag=copy_flag;
286  if (copy_flag==EVAL_FLAG) {
287  old_status = curr_status;
288  curr_status = 4;
289  }
290  if (u) { /* 15.9 */
291  *infoptr=QUOTE_FLAG;
292  local_copy_flag=QUOTE_FLAG;
293  copy_flag=QUOTE_FLAG;
294  }
295  else {
296  u=NEW(t,psi_term);
297  insert_translation(t,u,local_copy_flag); /* 24.8 */
298  }
299  *u = *t;
300  u->resid=NULL; /* 24.8 Don't copy residuations */
301 #ifdef TS
302  u->time_stamp=global_time_stamp; /* 9.6 */
303 #endif
304 
305  if (t->attr_list)
306  u->attr_list=copy_tree(t->attr_list, local_copy_flag, heap_flag);
307 
308  if (copy_flag==EVAL_FLAG) {
309  switch((long)t->type->type_def) {
310  case (long)type_it:
311  if (t->type->properties)
312  curr_status=0;
313  break;
314 
315  case (long)function_it:
316  curr_status=0;
317  break;
318 
319  case (long)global: /* RM: Feb 8 1993 */
320  curr_status=0;
321  break;
322 
323  default:
324  break;
325  }
326  u->status=curr_status;
327  u->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
328  /* If any subterm has zero curr_status,
329  then so does the whole term: */
330  if (curr_status) curr_status=old_status;
331  } else if (copy_flag==QUOTE_FLAG) {
332  u->status=4;
333  u->flags=QUOTED_TRUE; /* 14.9 */
334  }
335  /* else copy_flag==EXACT_FLAG & u->status=t->status */
336 
337  if (heap_flag==HEAP) {
338  if (t->type==cut) u->value_3=NULL;
339  } else {
340  if (t->type==cut) {
342  traceline("current choice point is %x\n",choice_stack);
343  }
344  }
345  }
346  }
347 
348  return u;
349 }
#define COPY_THRESHOLD
Definition: def_const.h:68
ptr_residuation resid
Definition: def_struct.h:173
#define function_it
Definition: def_const.h:362
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
translate
Definition: copy.c:108
#define HEAP
Definition: def_const.h:147
char evaluate_args
Definition: def_struct.h:136
#define global
Definition: def_const.h:364
#define QUOTE_STUB
Definition: def_const.h:329
def_type type_def
Definition: def_struct.h:133
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
insert_translation
Definition: copy.c:67
#define NULL
Definition: def_const.h:203
#define NEW(A, TYPE)
Definition: def_macro.h:279
long abort_life(int nlflag)
abort_life
Definition: built_ins.c:2260
void traceline(char *format,...)
Definition: error.c:157
#define type_it
Definition: def_const.h:363
#define EVAL_FLAG
Definition: def_const.h:327
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 ptr_node copy_tree(ptr_node t, long copy_flag, long heap_flag)
ptr_node copy_tree
Definition: copy.c:148
static long curr_status
Definition: copy.c:209
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
void mark_quote_c(ptr_psi_term t, long heap_flag)
mark_quote_c
Definition: copy.c:434
GENERIC heap_pointer
Definition: def_glob.h:12
jmp_buf env
Definition: def_glob.h:236
ptr_definition cut
Definition: def_glob.h:83
unsigned long global_time_stamp
Definition: login.c:28
#define HEAPDONE(R)
Definition: def_macro.h:291
GENERIC stack_pointer
Definition: def_glob.h:14
#define QUOTE_FLAG
Definition: def_const.h:326
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_triple_list properties
Definition: def_struct.h:127
#define QUOTED_TRUE
Definition: def_const.h:123
ptr_node attr_list
Definition: def_struct.h:171
ptr_choice_point choice_stack
Definition: def_glob.h:51
ptr_int_list copyTypeCode ( ptr_int_list  u)

copyTypeCode

Parameters
ptr_int_listu

copyTypeCode(code) returns copy of code on the heap

Definition at line 808 of file types.c.

References HEAP_ALLOC, wl_int_list::next, NULL, or_codes(), and wl_int_list::value_1.

809 {
810  ptr_int_list code;
811 
812  code = HEAP_ALLOC(int_list);
813  code->value_1=0;
814  code->next=NULL;
815 
816  or_codes(code, u);
817 
818  return code;
819 }
#define NULL
Definition: def_const.h:203
GENERIC value_1
Definition: def_struct.h:54
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
void or_codes(ptr_int_list u, ptr_int_list v)
or_codes
Definition: types.c:831
ptr_int_list next
Definition: def_struct.h:55
long count_features ( ptr_node  t)

count_features

Parameters
ptr_nodet

COUNT_FEATURES(t) Return the number of features of a tree.

Definition at line 690 of file print.c.

References wl_node::left, and wl_node::right.

691 {
692  long c=0;
693  if(t) {
694  if(t->left)
695  c+=count_features(t->left);
696  c++;
697  if(t->right)
698  c+=count_features(t->right);
699  }
700  return c;
701 }
ptr_node left
Definition: def_struct.h:183
ptr_node right
Definition: def_struct.h:184
long count_sorts ( long  c0)

count_sorts

Parameters
longc0

COUNT_SORTS(c) Count the number of sorts in the symbol table T. Overestimates in the module version. RM: Jan 21 1993 No longer !! RM: Feb 3 1993

Definition at line 710 of file types.c.

References first_definition, wl_definition::next, wl_definition::type_def, and type_it.

711 {
712  ptr_definition d;
713 
714  for(d=first_definition;d;d=d->next)
715  if (d->type_def==(def_type)type_it) c0++;
716 
717  return c0;
718 }
def_type type_def
Definition: def_struct.h:133
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_module create_module ( char *  module)

ptr_module create_module(char *module)

CREATE_MODULE(module) Create a new module.

Definition at line 72 of file modules.c.

References find_module(), hash_create(), HEAP_ALLOC, heap_copy_string(), heap_insert(), input_file_name, NULL, and STRCMP.

73 {
74  ptr_module new;
75 
76 
77  new=find_module(module);
78  if(!new) {
79  new=HEAP_ALLOC(struct wl_module);
80  new->module_name=(char *)heap_copy_string(module);
81  new->source_file=(char *)heap_copy_string(input_file_name);
82  new->open_modules=NULL;
83  new->inherited_modules=NULL;
84  new->symbol_table=hash_create(16); /* RM: Feb 3 1993 */
85 
86  (void)heap_insert(STRCMP,new->module_name,&module_table,(GENERIC)new);
87 
88  }
89  return new;
90 }
ptr_node module_table
Definition: modules.c:14
string input_file_name
Definition: def_glob.h:40
ptr_hash_table hash_create(int size)
HASH_CREATE.
Definition: hash_table.c:25
#define NULL
Definition: def_const.h:203
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
#define STRCMP
Definition: def_const.h:255
ptr_module find_module(char *module)
find_module
Definition: modules.c:54
unsigned long * GENERIC
Definition: def_struct.h:17
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
void crunch ( long  prec,
long  limit 
)

crunch

Parameters
longprec
longlimit

CRUNCH(prec,limit) Crunch up = work out the arguments of anything on the stack whose precedence is <= PREC, and replace it with the corresponding psi-term. Do not go any further than LIMIT which is the end of the current expression.

Definition at line 662 of file parser.c.

References error_psi_term, FALSE, fx, look(), make_life_form(), nop, NULL, parse_ok, parser_stack_index, pop(), push(), xf, and xfx.

663 {
664  psi_term t,t1,t2,t3;
665  long op1,op2,op3;
666 
667  if(parse_ok && prec>=look() && parser_stack_index>limit) {
668 
669  (void)pop(&t1,&op1);
670 
671  switch(op1) {
672 
673  case nop:
674  (void)pop(&t2,&op2);
675  if(op2==fx)
676  t=make_life_form(&t2,&t1,NULL);
677  else
678  if(op2==xfx) {
679  (void)pop(&t3,&op3);
680  if(op3==nop)
681  t=make_life_form(&t2,&t3,&t1);
682  else {
683  printf("*** Parser: ooops, NOP expected.\n");
684  parse_ok=FALSE;
685  t= *error_psi_term;
686  }
687  }
688  break;
689 
690  case xf:
691  (void)pop(&t2,&op2);
692  if(op2==nop)
693  t=make_life_form(&t1,&t2,NULL);
694  else {
695  printf("*** Parser: ugh, NOP expected.\n");
696  t= *error_psi_term;
697  parse_ok=FALSE;
698  }
699  break;
700 
701  default:
702  printf("*** Parser: yuck, weirdo operator.\n");
703  }
704 
705  push(t,look(),nop);
706 
707  crunch(prec,limit);
708  }
709 }
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
long look()
look
Definition: parser.c:163
void push(psi_term tok, long prec, long op)
push
Definition: parser.c:107
#define NULL
Definition: def_const.h:203
#define nop
Definition: def_const.h:260
long pop(ptr_psi_term tok, long *op)
pop
Definition: parser.c:132
void crunch(long prec, long limit)
crunch
Definition: parser.c:662
ptr_psi_term error_psi_term
Definition: def_glob.h:23
#define FALSE
Definition: def_const.h:128
#define xf
Definition: def_const.h:261
psi_term make_life_form(ptr_psi_term tok, ptr_psi_term arg1, ptr_psi_term arg2)
make_life_form
Definition: parser.c:571
long parser_stack_index
Definition: def_glob.h:24
long parse_ok
Definition: def_glob.h:171
void curry ( )

curry

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

Definition at line 174 of file lefun.c.

References can_curry, curried, and TRUE.

175 {
176  if (can_curry)
177  curried=TRUE;
178 }
#define TRUE
Definition: def_const.h:127
long can_curry
Definition: def_glob.h:224
long curried
Definition: def_glob.h:223
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)
sub_type
Definition: types.c:1642
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)
find
Definition: trees.c:394
#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
ptr_int_list decode ( ptr_int_list  c)

decode

Parameters
ptr_int_listc

DECODE(c) Returns a list of the symbol names which make up the disjunction whose code is C.

Definition at line 1784 of file types.c.

References bit_length(), wl_definition::code, cons(), wl_int_list::next, NULL, STACK_ALLOC, and wl_int_list::value_1.

1785 {
1786  ptr_int_list c2,c3,c4,result=NULL,*prev;
1787  long p;
1788 
1789  p=bit_length(c);
1790 
1791  while (p) {
1792  p--;
1793  c2=gamma_table[p]->code;
1794  result=cons((GENERIC)gamma_table[p],result);
1795  prev= &c4;
1796  *prev=NULL;
1797 
1798  while (c2) {
1799  c3=STACK_ALLOC(int_list);
1800  *prev=c3;
1801  prev= &(c3->next);
1802  *prev=NULL;
1803 
1804  c3->value_1=(GENERIC)(((unsigned long)(c->value_1)) & ~((unsigned long)(c2->value_1)));
1805 
1806  c=c->next;
1807  c2=c2->next;
1808  }
1809 
1810  c=c4;
1811  p=bit_length(c);
1812  }
1813 
1814  return result;
1815 }
ptr_definition * gamma_table
Definition: types.c:14
ptr_int_list cons(GENERIC v, ptr_int_list l)
cons
Definition: types.c:179
#define NULL
Definition: def_const.h:203
long bit_length(ptr_int_list c)
bit_length
Definition: types.c:1753
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list next
Definition: def_struct.h:55
void delete_attr ( char *  s,
ptr_node n 
)

delete_attr

Parameters
char*s
ptr_node*n

DELETE_ATTR(key,tree) Remove the node addressed by KEY from TREE.

Definition at line 522 of file trees.c.

References wl_node::data, featcmp(), FEATCMP, heap_insert(), wl_node::key, wl_node::left, and wl_node::right.

523 {
524  long cmp;
525  ptr_node new,r;
526 
527  if (*n) {
528  cmp=featcmp(s,(*n)->key);
529  if (cmp<0)
530  delete_attr(s,&((*n)->left));
531  else if (cmp>0)
532  delete_attr(s,&((*n)->right));
533  else if ((*n)->left) {
534  if ((*n)->right) {
535  r=(*n)->right;
536  new=heap_insert(FEATCMP,r->key,&((*n)->left),r->data);
537  new->left=r->left;
538  new->right=r->right;
539  *n = (*n) -> left;
540  }
541  else
542  *n = (*n)->left;
543  }
544  else
545  *n = (*n)->right;
546  }
547 }
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
void delete_attr(char *s, ptr_node *n)
delete_attr
Definition: trees.c:522
ptr_node right
Definition: def_struct.h:184
void deref2_eval ( ptr_psi_term  t)

deref2_eval

Parameters
ptr_psi_termt

Definition at line 1356 of file lefun.c.

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

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

deref2_rec_eval

Parameters
ptr_psi_termt

Same as deref_rec_eval, but assumes goal_stack already restored.

Definition at line 1382 of file lefun.c.

References deref_ptr, and deref_rec_body().

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

deref_args_eval

Parameters
ptr_psi_termt
longset

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

Definition at line 1294 of file lefun.c.

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

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

deref_eval

Parameters
ptr_psi_termt

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

Definition at line 1180 of file lefun.c.

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

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

deref_rec_args

Parameters
ptr_noden

Definition at line 1272 of file lefun.c.

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

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

deref_rec_args_exc

Parameters
ptr_noden
longset

Definition at line 1332 of file lefun.c.

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

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

deref_rec_body

Parameters
ptr_psi_termt

Definition at line 1243 of file lefun.c.

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

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

deref_rec_eval

Parameters
ptr_psi_termt

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

Definition at line 1226 of file lefun.c.

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

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

disjunct_aim

DISJUNCT_AIM() This is the disjunction enumeration routine. If U is the disjunction {H|T} then first bind U to H, then on backtracking enumerate the disjunction T. U is always passed along so that every choice of the disjunction can be bound to U.

Definition at line 1621 of file login.c.

References TRUE.

1622 {
1623  // ptr_psi_term u,v;
1624  // ptr_list l;
1625  long success=TRUE;
1626 
1627  printf("Call to disjunct_aim\nThis routine inhibited by RM: Dec 9 1992\n");
1628 
1629  return success;
1630 }
#define TRUE
Definition: def_const.h:127
void display_couple ( ptr_psi_term  u,
char *  s,
ptr_psi_term  v 
)

display_couple

Parameters
ptr_psi_termu
char*s
ptr_psi_termv

DISPLAY_COUPLE(u,s,v) Print a couple of psi-terms (u,v) with the correct co-referencing. Print string S in between.

Definition at line 1643 of file print.c.

References buffer, check_pointer(), const_quote, end_tab(), FALSE, gen_sym_counter, heap_pointer, indent, indx, insert_variables(), listing_flag, mark_tab(), MAX_PRECEDENCE, new_tab(), NULL, output_stream, pointer_names, pretty_output(), pretty_tag_or_psi_term(), pretty_things, prettyf(), printed_pointers, TRUE, var_tree, work_out_length(), write_canon, and write_resids.

1644 {
1645  GENERIC old_heap_pointer;
1646  ptr_tab_brk new;
1647 
1648  output_stream=stdout;
1650  old_heap_pointer=heap_pointer;
1651 
1654  gen_sym_counter=0;
1655  check_pointer(u);
1656  check_pointer(v);
1658 
1659  indent=FALSE;
1660  const_quote=TRUE;
1663  *buffer=0;
1665  new_tab(&new);
1666  mark_tab(new);
1668  prettyf(s);
1670  end_tab();
1671 
1672  if (indent) {
1673  work_out_length();
1674  pretty_output();
1675  }
1676 
1677  heap_pointer=old_heap_pointer;
1678 }
ptr_node printed_pointers
Definition: def_glob.h:28
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
ptr_node pointer_names
Definition: def_glob.h:29
#define TRUE
Definition: def_const.h:127
ptr_item indx
Definition: def_glob.h:329
#define FALSE
Definition: def_const.h:128
GENERIC heap_pointer
Definition: def_glob.h:12
#define MAX_PRECEDENCE
Definition: def_const.h:103
long gen_sym_counter
Definition: def_glob.h:30
FILE * output_stream
Definition: def_glob.h:41
unsigned long * GENERIC
Definition: def_struct.h:17
void display_psi ( FILE *  s,
ptr_psi_term  t 
)

display_psi

Parameters
FILE*s
ptr_psi_termt

DISPLAY_PSI(stream,t) Print the psi_term T to the given stream.

Definition at line 1579 of file print.c.

References main_display_psi_term(), and outfile.

1580 {
1581  outfile=s;
1583 }
FILE * outfile
Definition: def_glob.h:333
void display_psi_stderr ( ptr_psi_term  t)

display_psi_stderr

Parameters
ptr_psi_termt

DISPLAY_PSI_STDERR(t) Print the psi_term T to stderr as simply as possible (no indenting).

Definition at line 1550 of file print.c.

References main_display_psi_term(), and outfile.

1551 {
1552  outfile=stderr;
1554 }
FILE * outfile
Definition: def_glob.h:333
void display_psi_stdout ( ptr_psi_term  t)

display_psi_stdout

Parameters
ptr_psi_termt

DISPLAY_PSI_STDOUT(t) Print the psi_term T to stdout as simply as possible (no indenting).

Definition at line 1536 of file print.c.

References main_display_psi_term(), and outfile.

1537 {
1538  outfile=stdout;
1540 }
FILE * outfile
Definition: def_glob.h:333
void display_psi_stream ( ptr_psi_term  t)

display_psi_stream

Parameters
ptr_psi_termt

DISPLAY_PSI_STREAM(t) Print the psi_term T to output_stream as simply as possible (no indenting).

Definition at line 1564 of file print.c.

References main_display_psi_term(), outfile, and output_stream.

1565 {
1568 }
FILE * outfile
Definition: def_glob.h:333
FILE * output_stream
Definition: def_glob.h:41
ptr_psi_term distinct_copy ( ptr_psi_term  t)

distinct_copy

Parameters
ptr_psi_termt

DISTINCT_COPY(t) Make a distinct copy of T and T's attribute tree, which are identical to T, only located elsewhere in memory. This is used by apply to build the calling psi-term which is used for matching. Note that this routine is not recursive, i.e. it only copies the main functor & the attribute tree.

Definition at line 393 of file copy.c.

References wl_psi_term::attr_list, distinct_tree(), global_time_stamp, and STACK_ALLOC.

394 {
395  ptr_psi_term res;
396 
397  res=STACK_ALLOC(psi_term);
398  *res= *t;
399 #ifdef TS
400  res->time_stamp=global_time_stamp; /* 9.6 */
401 #endif
402  /* res->coref=distinct_copy(t->coref); */
404 
405  return res;
406 }
ptr_node distinct_tree(ptr_node t)
distinct_tree
Definition: copy.c:366
#define STACK_ALLOC(A)
Definition: def_macro.h:16
unsigned long global_time_stamp
Definition: login.c:28
ptr_node attr_list
Definition: def_struct.h:171
ptr_node distinct_tree ( ptr_node  t)

distinct_tree

Parameters
ptr_nodet

DISTINCT_TREE(t) Return an exact copy of an attribute tree. This is used by APPLY in order to build the calling psi-term which is used for matching.

Definition at line 366 of file copy.c.

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

367 {
368  ptr_node n;
369 
370  n=NULL;
371  if (t) {
372  n=STACK_ALLOC(node);
373  n->key=t->key;
374  n->data=t->data;
375  n->left=distinct_tree(t->left);
376  n->right=distinct_tree(t->right);
377  }
378 
379  return n;
380 }
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node distinct_tree(ptr_node t)
distinct_tree
Definition: copy.c:366
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_node right
Definition: def_struct.h:184
void do_currying ( )

do_currying

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

Definition at line 383 of file lefun.c.

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

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

do_pretty_attr

Parameters
ptr_nodet
ptr_tab_brktab
long*cnt
longtwo
longdepth

DO_PRETTY_ATTR(t,tab,cnt,two,depth) Pretty print the attribute tree T at position TAB.

CNT is what the value of the first integer label should be, so that "p(1=>a,2=>b)" is printed "p(a,b)" but "p(2=>a,3=>b)" is printed as "p(2 => a,3 => b)".

Definition at line 1199 of file print.c.

References COMMA_PREC, wl_node::data, display_modules, extract_module_from_name(), wl_node::key, wl_node::left, mark_tab(), wl_module::module_name, pretty_tag_or_psi_term(), prettyf(), prettyf_quote(), wl_node::right, str_to_int(), and strip_module_name().

1200 {
1201  long v;
1202  char s[4];
1203  ptr_module module;
1204 
1205  if (t) {
1206  if (t->left) {
1207  do_pretty_attr(t->left,tab,cnt,two,depth);
1208  prettyf(",");
1209  }
1210 
1211  /* Don't start each argument on a new line, */
1212  /* unless printing a function body: */
1213  mark_tab(tab);
1214 
1215  v=str_to_int(t->key);
1216  if (v<0) {
1217  if(display_modules) { /* RM: Jan 21 1993 */
1218  module=extract_module_from_name(t->key);
1219  if(module) {
1220  prettyf(module->module_name);
1221  prettyf("#");
1222  }
1223  }
1225 
1226  prettyf(" => ");
1227  }
1228  else if (v== *cnt)
1229  (*cnt)++ ;
1230  else {
1231  (void)snprintf(s,4,"%ld",v);
1232  prettyf(s); /* 6.10 */
1233  prettyf(" => ");
1234  }
1235 
1236  /* pretty_tag_or_psi_term(t->data,(two?COMMA_PREC:MAX_PRECEDENCE+1)); */
1238 
1239  if (t->right) {
1240  prettyf(",");
1241  do_pretty_attr(t->right,tab,cnt,two,depth);
1242  }
1243  }
1244 }
char * two
Definition: def_glob.h:251
char * strip_module_name(char *str)
strip_module_name
Definition: modules.c:144
GENERIC data
Definition: def_struct.h:185
long display_modules
Definition: def_glob.h:164
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
ptr_module extract_module_from_name(char *str)
extract_module_from_name
Definition: modules.c:116
char * module_name
Definition: def_struct.h:75
ptr_node right
Definition: def_struct.h:184
long do_residuation ( )

do_residuation

C-defined routines do all stack manipulation themselves

Definition at line 336 of file lefun.c.

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

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

do_residuation_user()

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

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

Definition at line 324 of file lefun.c.

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

325 {
326  goal_stack=resid_aim->next; /* reset goal stack */
327  return do_residuation();
328 }
long do_residuation()
do_residuation
Definition: lefun.c:336
ptr_goal goal_stack
Definition: def_glob.h:50
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_goal next
Definition: def_struct.h:227
int dummy_printf ( char *  f,
char *  s,
char *  t 
)

dummy_printf

Parameters
char*f
char*s
char*t

Definition at line 2619 of file login.c.

2620 {
2621  return strlen(f);
2622 }
void encode_types ( )

encode_types

ENCODE_TYPES() This routine performs type-coding using transitive closure. First any previous coding is undone. Then a new encryption is performed.

Some of these routines loop indefinitely if there is a circular type definition (an error should be reported but it isn't implemented (but it's quite easy to do)).

Definition at line 1091 of file types.c.

References all_sorts(), built_in, wl_definition::children, clear_coding(), wl_definition::code, cons(), count_sorts(), equalize_codes(), Errorline(), FALSE, heap_alloc(), inherit_always_check(), integer, wl_definition::keyword, least_sorts(), lf_false, lf_true, make_sys_type_links(), make_type_link(), wl_int_list::next, NOT_CODED, nothing, NULL, or_codes(), overlap_type(), wl_definition::parents, perr(), propagate_definitions(), quoted_string, real, wl_keyword::symbol, top, traceline(), TRUE, two_to_the(), type_count, type_cyclicity(), types_done, types_modified, and wl_int_list::value_1.

1092 {
1093  long p=0,i,possible,ok=TRUE;
1094  ptr_int_list layer,l,kids,dads,code;
1095  ptr_definition xdef,kdef,ddef; //,err;
1096 
1097  if (types_modified) {
1098 
1099  nothing->parents=NULL;
1101 
1102  top->parents=NULL;
1103  top->children=NULL;
1104 
1105  /* The following definitions are vital to avoid crashes */
1107  make_type_link(lf_true,boolean);
1108  make_type_link(lf_false,boolean);
1109 
1110  /* These just might be useful */
1112  make_type_link(boolean,built_in);
1114 
1116 
1117  type_count=count_sorts(-1); /* bottom does not count */
1118  clear_coding();
1119  nothing->parents=NULL; /* Must be cleared before all_sorts */
1120  all_sorts();
1121  if (type_cyclicity(nothing,NULL)) {
1122  clear_coding();
1123  return;
1124  }
1125  clear_coding();
1126  nothing->parents=NULL; /* Must be cleared before least_sorts */
1127  least_sorts();
1128 
1129  nothing->code=NULL;
1130 
1131  /* RM: Feb 17 1993 */
1132  traceline("*** Codes:\n%C= %s\n", NULL, nothing->keyword->symbol);
1133 
1135 
1136  layer=nothing->parents;
1137 
1138  while (layer) {
1139  l=layer;
1140  do {
1141  xdef=(ptr_definition)l->value_1;
1142  if (xdef->code==NOT_CODED && xdef!=top) {
1143 
1144  kids=xdef->children;
1145  code=two_to_the(p);
1146 
1147  while (kids) {
1148  kdef=(ptr_definition)kids->value_1;
1149  or_codes(code,kdef->code);
1150  kids=kids->next;
1151  }
1152 
1153  xdef->code=code;
1154  gamma_table[p]=xdef;
1155 
1156  /* RM: Feb 17 1993 */
1157  traceline("%C = %s\n", code, xdef->keyword->symbol);
1158  p=p+1;
1159  }
1160 
1161  l=l->next;
1162 
1163  } while (l);
1164 
1165  l=layer;
1166  layer=NULL;
1167 
1168  do {
1169  xdef=(ptr_definition)l->value_1;
1170  dads=xdef->parents;
1171 
1172  while (dads) {
1173  ddef=(ptr_definition)dads->value_1;
1174  if(ddef->code==NOT_CODED) {
1175 
1176  possible=TRUE;
1177  kids=ddef->children;
1178 
1179  while(kids && possible) {
1180  kdef=(ptr_definition)kids->value_1;
1181  if(kdef->code==NOT_CODED)
1182  possible=FALSE;
1183  kids=kids->next;
1184  }
1185  if(possible)
1186  layer=cons((GENERIC)ddef,layer);
1187  }
1188  dads=dads->next;
1189  }
1190  l=l->next;
1191  } while(l);
1192  }
1193 
1194  top->code=two_to_the(p);
1195  for (i=0;i<p;i++)
1196  or_codes(top->code,two_to_the(i));
1197 
1198  gamma_table[p]=top;
1199 
1200  /* RM: Jan 13 1993 */
1201  /* Added the following line because type_count is now over generous
1202  because the same definition can be referenced several times in
1203  the symbol table because of modules
1204  */
1205  type_count=p+1;
1206  for(i=type_count;i<type_count;i++)
1207  gamma_table[i]=NULL;
1208 
1209  traceline("%C = @\n\n", top->code);
1210  equalize_codes(p/32+1);
1211 
1213 
1214  /* Inherit 'FALSE' always_check flags to all types' children */
1216 
1217  traceline("*** Encoding done, %d sorts\n",type_count);
1218 
1220  Errorline("the sorts 'real' and 'string' are not disjoint.\n");
1221  ok=FALSE;
1222  }
1223 
1224  /* RM: Dec 15 1992 I don't think this really matters any more
1225  if (overlap_type(real,alist)) {
1226  Errorline("the sorts 'real' and 'list' are not disjoint.\n");
1227  ok=FALSE;
1228  }
1229  */
1230 
1231  /* RM: Dec 15 1992 I don't think this really matters any more
1232  if (overlap_type(alist,quoted_string)) {
1233  Errorline("the sorts 'list' and 'string' are not disjoint.\n");
1234  ok=FALSE;
1235  }
1236  */
1237 
1238  if (!ok) {
1239  perr("*** Internal problem:\n");
1240  perr("*** Wild_Life may behave abnormally because some basic types\n");
1241  perr("*** have been defined incorrectly.\n\n");
1242  }
1243 
1245  types_done=TRUE;
1246  }
1247 }
long type_cyclicity(ptr_definition d, ptr_int_list anc)
type_cyclicity
Definition: types.c:977
ptr_definition * gamma_table
Definition: types.c:14
void least_sorts()
void least_sorts()
Definition: types.c:743
void perr(char *str)
Definition: error.c:659
long type_count
Definition: def_glob.h:46
#define NOT_CODED
Definition: def_const.h:134
ptr_int_list two_to_the(long p)
two_to_the
Definition: types.c:776
void propagate_definitions()
propagate_definitions
Definition: types.c:662
void clear_coding()
clear_coding
Definition: types.c:727
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
ptr_keyword keyword
Definition: def_struct.h:124
ptr_int_list cons(GENERIC v, ptr_int_list l)
cons
Definition: types.c:179
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
void make_sys_type_links()
make_sys_type_links
Definition: sys.c:2174
char * symbol
Definition: def_struct.h:91
long types_modified
Definition: def_glob.h:47
void inherit_always_check()
inherit_always_check
Definition: types.c:1068
void traceline(char *format,...)
Definition: error.c:157
void make_type_link(ptr_definition t1, ptr_definition t2)
make_type_link
Definition: types.c:901
void Errorline(char *format,...)
Definition: error.c:414
ptr_definition real
Definition: def_glob.h:102
#define TRUE
Definition: def_const.h:127
void all_sorts()
all_sorts
Definition: types.c:759
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
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
struct wl_definition * ptr_definition
Definition: def_struct.h:31
ptr_definition lf_false
Definition: def_glob.h:89
void equalize_codes(int len)
equalize_codes
Definition: types.c:859
long types_done
Definition: def_glob.h:36
ptr_definition nothing
Definition: def_glob.h:98
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
long count_sorts(long c0)
count_sorts
Definition: types.c:710
ptr_int_list children
Definition: def_struct.h:131
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
void or_codes(ptr_int_list u, ptr_int_list v)
or_codes
Definition: types.c:831
ptr_int_list next
Definition: def_struct.h:55
ptr_int_list parents
Definition: def_struct.h:130
void end_tab ( )

end_tab

END_TAB() Mark the end of an item. Copy the item's string into global space and point to the next item.

Definition at line 554 of file print.c.

References buffer, heap_alloc(), indent, indx, and wl_item::str.

555 {
556  if (indent) {
557  indx->str=(char *)heap_alloc(strlen(buffer)+1);
558  strcpy(indx->str,buffer);
559  indx++;
560  *buffer=0;
561  }
562 }
char * str
Definition: def_struct.h:311
ptr_item indx
Definition: def_glob.h:329
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
void end_terminal_io ( )

end_terminal_io

END_TERMINAL_IO() End of terminal I/O bracketing.

Definition at line 516 of file token.c.

References inchange, input_state, NULL, old_state, out, outchange, output_stream, and restore_state().

517 {
518  if (inchange) {
521  old_state=NULL; /* RM: Feb 17 1993 */
522  }
523  if (outchange)
525 }
#define NULL
Definition: def_const.h:203
ptr_psi_term input_state
Definition: def_glob.h:199
ptr_psi_term old_state
Definition: token.c:480
static long outchange
Definition: token.c:478
void restore_state(ptr_psi_term t)
restore_state
Definition: token.c:334
static long inchange
Definition: token.c:478
static FILE * out
Definition: token.c:479
FILE * output_stream
Definition: def_glob.h:41
void equalize_codes ( int  len)

equalize_codes

Parameters
intlen

EQUALIZE_CODES(w) Make sure all codes are w words long, by increasing the length of the shorter ones. This simplifies greatly the bitvector manipulation routines. This operation should be done after encoding. For correct operation, w>=maximum number of words used for a code.

Definition at line 859 of file types.c.

References assert, wl_definition::code, first_definition, HEAP_ALLOC, wl_int_list::next, wl_definition::next, NULL, wl_definition::type_def, and type_it.

860 {
861  ptr_definition d;
862  ptr_int_list c,*ci;
863  long i;
864  int w;
865 
866  for(d=first_definition;d;d=d->next)
867  if (d->type_def==(def_type)type_it) {
868  c = d->code;
869  ci = &(d->code); /* RM: Feb 15 1993 */
870  w=len;
871 
872  /* Count how many words have to be added */
873  while (c) {
874  ci= &(c->next);
875  c=c->next;
876  w--;
877  }
878  assert(w>=0);
879  /* Add the words */
880  for (i=0; i<w; i++) {
881  *ci = HEAP_ALLOC(int_list);
882  (*ci)->value_1=0;
883  ci= &((*ci)->next);
884  }
885  (*ci)=NULL;
886  }
887 }
def_type type_def
Definition: def_struct.h:133
#define NULL
Definition: def_const.h:203
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_int_list code
Definition: def_struct.h:129
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
#define assert(N)
Definition: memory.c:113
ptr_int_list next
Definition: def_struct.h:55
void Errorline ( char *  format,
  ... 
)

Definition at line 414 of file error.c.

References assert, display_psi(), FALSE, input_file_name, parse_ok, perr_i(), perr_s(), print_code(), print_def_type(), print_operator_kind(), and psi_term_line_number.

415 {
416  va_list VarArg;
417  // int l;
418  char buffer_loc[5];
419  char *p;
420  unsigned long lng2;
421  char *cptr;
422  ptr_int_list pil;
423  ptr_psi_term psi;
424  operator kind;
425  def_type t ;
426 
427  va_start(VarArg,format);
428  // fprintf(stderr,"format = %lx %s\n",(long)format,format);fflush(stdout);
429  fprintf(stderr,"*** Error: ");
430  // fprintf(stderr,"format2 = %lx %s\n",(long)format,format);
431  // vinfoline(format, stderr, VarArg);
432  //#define vinfoline(format, stderr, xxxx) {
433  for (p=format;p && *p; p++)
434  {
435  if (*p == '%')
436  {
437  p++;
438  switch (*p)
439  {
440  case 'd':
441  case 'x':
442  buffer_loc[0] = '%';
443  buffer_loc[1] = 'l';
444  buffer_loc[2] = *p;
445  buffer_loc[3] = 0;
446  lng2 = va_arg(VarArg,long);
447  fprintf(stderr, buffer_loc, lng2);
448  break;
449  case 's':
450  buffer_loc[0] = '%';
451  buffer_loc[1] = *p;
452  buffer_loc[2] = 0;
453  cptr = va_arg(VarArg,char *);
454  fprintf(stderr, buffer_loc, cptr);
455  break;
456  case 'C':
457  /* type coding as bin string */
458  pil = va_arg(VarArg,ptr_int_list);
459  print_code(stderr,pil);
460  break;
461  case 'P':
462  psi = va_arg(VarArg,ptr_psi_term);
463  display_psi(stderr,psi);
464  break;
465  case 'O':
466  kind = va_arg(VarArg,operator);
467  print_operator_kind(stderr,kind);
468  break;
469  case 'T':
470  assert(stderr==stderr);
471  t = va_arg(VarArg,def_type);
472  print_def_type(t);
473  break;
474  case 'E':
475  assert(stderr==stderr);
476  perr_i("near line %ld",psi_term_line_number);
477  if (strcmp(input_file_name,"stdin")) {
478  perr_s(" in file \042%s\042",input_file_name);
479  }
480  parse_ok=FALSE;
481  break;
482  case '%':
483  (void)putc(*p,stderr);
484  break;
485  default:
486  fprintf(stderr,"<%c follows %% : report bug >", *p);
487  break;
488  }
489  }
490  else
491  (void)putc(*p,stderr);
492  }
493  va_end(VarArg);
494 #ifdef CLIFE
495 exit(0);
496 #endif
497 }
void perr_i(char *str, long i)
Definition: error.c:677
long psi_term_line_number
Definition: def_glob.h:268
string input_file_name
Definition: def_glob.h:40
void display_psi(FILE *s, ptr_psi_term t)
display_psi
Definition: print.c:1579
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
print_code
Definition: print.c:167
void print_def_type(def_type t)
print_def_type
Definition: types.c:24
#define FALSE
Definition: def_const.h:128
long parse_ok
Definition: def_glob.h:171
void print_operator_kind(FILE *s, long kind)
print_operator_kind
Definition: print.c:192
#define assert(N)
Definition: memory.c:113
long eval_aim ( )

eval_aim

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

Definition at line 497 of file lefun.c.

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

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

eval_args

Parameters
ptr_noden

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

Definition at line 889 of file lefun.c.

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

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

eval_copy

Parameters
ptr_psi_termt
longheap_flag

Definition at line 196 of file copy.c.

References copy(), EVAL_FLAG, FALSE, and to_heap.

197 { to_heap=FALSE; return (copy(t, EVAL_FLAG, heap_flag)); }
#define EVAL_FLAG
Definition: def_const.h:327
ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
copy
Definition: copy.c:248
long to_heap
Definition: def_glob.h:264
#define FALSE
Definition: def_const.h:128
void eval_global_var ( ptr_psi_term  t)

eval_global_var

Parameters
ptr_psi_termt

EVAL_GLOBAL_VAR(t) Dereference a global variable.

Definition at line 1440 of file lefun.c.

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

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

exact_copy

Parameters
ptr_psi_termt
longheap_flag

Definition at line 176 of file copy.c.

References copy(), EXACT_FLAG, FALSE, and to_heap.

177 { to_heap=FALSE; return (copy(t, EXACT_FLAG, heap_flag)); }
#define EXACT_FLAG
Definition: def_const.h:325
ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
copy
Definition: copy.c:248
long to_heap
Definition: def_glob.h:264
#define FALSE
Definition: def_const.h:128
void exit_if_true ( long  exitflag)

exit_if_true

Parameters
longexitflag

Definition at line 55 of file lib.c.

56 {
57  if (exitflag) {
58  printf("\n\n*** Execution is not allowed to continue.\n");
59  /*exit_life(TRUE);*/
60  exit(EXIT_FAILURE);
61  }
62 }
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)
open_input_file
Definition: token.c:594
char * expand_file_name ( char *  s)

expand_file_name

Parameters
char*s

EXPAND_FILE_NAME(str) Return the expansion of file name STR. For the time being all this does is replace '~' by the HOME directory if no user is given, or tries to find the user.

Definition at line 537 of file token.c.

References STRLEN.

538 {
539  char *r;
540  char *home; // *getenv();
541  struct passwd *pw;
542  /* char *user="eight character name"; 18.5 */
543  char userbuf[STRLEN];
544  char *user=userbuf;
545  char *t1,*t2;
546 
547  r=s;
548  if (s[0]=='~') {
549  t1=s+1;
550  t2=user;
551  while (*t1!=0 && *t1!='/') {
552  *t2= *t1;
553  *t2++;
554  *t1++;
555  }
556  *t2=0;
557  if ((int)strlen(user)>0) {
558  pw = getpwnam(user);
559  if (pw) {
560  user=pw->pw_dir;
561  r=(char *)malloc(strlen(user)+strlen(t1)+1);
562  sprintf(r,"%s%s",user,t1);
563  }
564  else
565  /* if (warning()) printf("couldn't find user '%s'.\n",user) */;
566  }
567  else {
568  home=getenv("HOME");
569  if (home) {
570  r=(char *)malloc(strlen(home)+strlen(s)+1);
571  sprintf(r,"%s%s",home,s+1);
572  }
573  else
574  /* if (warning()) printf("no HOME directory.\n") */;
575  }
576  }
577 
578  /* printf("*** Using file name: '%s'\n",r); */
579 
580  return r;
581 }
#define STRLEN
Definition: def_const.h:86
ptr_module extract_module_from_name ( char *  str)

extract_module_from_name

Parameters
char*str

EXTRACT_MODULE_FROM_NAME Return the module corresponding to "module#symbol". Return NULL if only "#symbol".

Definition at line 116 of file modules.c.

References create_module(), legal_in_name(), and NULL.

117 {
118  char *s;
119  ptr_module result=NULL;
120 
121  s=str;
122  while(legal_in_name(*s))
123  s++;
124  if(s!=str && *s=='#' /* && *(s+1)!=0 */) {
125  *s=0;
126  result=create_module(str);
127  *s='#';
128  /*
129  printf("Extracted module name '%s' from '%s'\n",result->module_name,str);
130  */
131  }
132 
133  return result;
134 }
long legal_in_name(long c)
legal_in_name
Definition: token.c:980
#define NULL
Definition: def_const.h:203
ptr_module create_module(char *module)
ptr_module create_module(char *module)
Definition: modules.c:72
long f_check_out ( ptr_psi_term  t)

f_check_out

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

Definition at line 1046 of file lefun.c.

References check_func_flag, check_out(), and TRUE.

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

fail_all

FAIL_ALL() This routines provokes a total failure, in case of a bad error (out of memory, abort, etc...). All goals are abandoned.

Definition at line 188 of file memory.c.

References abort_life(), choice_stack, goal_stack, NULL, open_input_file(), output_stream, stdin_cleareof(), TRUE, and undo_stack.

189 {
190  output_stream=stdout;
194  (void)abort_life(TRUE);
195  /* printf("\n*** Abort\n"); */
196  stdin_cleareof();
197  (void)open_input_file("stdin");
198 }
ptr_goal goal_stack
Definition: def_glob.h:50
#define NULL
Definition: def_const.h:203
long abort_life(int nlflag)
abort_life
Definition: built_ins.c:2260
ptr_stack undo_stack
Definition: def_glob.h:53
#define TRUE
Definition: def_const.h:127
FILE * output_stream
Definition: def_glob.h:41
void stdin_cleareof()
stdin_cleareof
Definition: token.c:51
long open_input_file(char *file)
open_input_file
Definition: token.c:594
ptr_choice_point choice_stack
Definition: def_glob.h:51
long featcmp ( char *  str1,
char *  str2 
)

featcmp

Parameters
char*str1
char*str2

FEATCMP(s1,s2) Compares two strings which represent features, for use in FIND or INSERT. This differs from strcmp for those strings that represent integers. These are compared as integers. In addition, all integers are considered to be less than all strings that do not represent integers.

Definition at line 106 of file trees.c.

References is_int().

107 {
108  long len1,len2,sgn1,sgn2;
109  char *s1,*s2;
110 
111  if(str1==str2)
112  return 0;
113 
114  /* if (*str1==0 && *str2==0) return 0; "" bug is unaffected -- PVR 23.2.94 */
115 
116  if(*(str1+1)==0 && *(str2+1)==0)
117  return *str1 - *str2;
118 
119 
120  s1=str1; /* Local copies of the pointers */
121  s2=str2;
122 
123  if (is_int(&s1,&len1,&sgn1)) {
124  if (is_int(&s2,&len2,&sgn2)) {
125  if (sgn1!=sgn2) return (sgn2-sgn1); /* Check signs first */
126  if (len1!=len2) return (len1-len2); /* Then check lengths */
127  return strcmp(s1,s2); /* Use strcmp only if same sign and length */
128  }
129  else
130  return -1;
131  }
132  else {
133  if (is_int(&s2,&len2,&sgn2))
134  return 1;
135  else
136  return strcmp(s1,s2);
137  }
138 }
long is_int(char **s, long *len, long *sgn)
is_int
Definition: trees.c:41
void feature_insert ( char *  keystr,
ptr_node tree,
ptr_psi_term  psi 
)

feature_insert

Parameters
char*keystr
ptr_node*tree
ptr_psi_termpsi

FEATURE_INSERT(keystr,tree,psi) Insert the psi_term psi into the attribute tree. If the feature already exists, create a call to the unification function.

Definition at line 251 of file parser.c.

References FEATCMP, find(), stack_copy_psi_term(), stack_insert_copystr(), and Syntaxerrorline().

252 {
253  ptr_node loc;
254  ptr_psi_term stk_psi;
255 
256  // printf("before find in feature_insert feature=%s\n",keystr);
257  if ((loc=find(FEATCMP,keystr,*tree))) {
258  /* Give an error message if there is a duplicate feature: */
259  Syntaxerrorline("duplicate feature %s\n",keystr);
260  }
261  else {
262  /* If the feature does not exist, insert it. */
263  stk_psi=stack_copy_psi_term(*psi); // 19.8 */
264  stack_insert_copystr(keystr,tree,(GENERIC)stk_psi); /* 10.8 */
265  }
266 }
#define FEATCMP
Definition: def_const.h:257
void Syntaxerrorline(char *format,...)
Definition: error.c:498
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
unsigned long * GENERIC
Definition: def_struct.h:17
void stack_insert_copystr(char *keystr, ptr_node *tree, GENERIC info)
stack_insert_copystr
Definition: trees.c:301
void fetch_def ( ptr_psi_term  u,
long  allflag 
)

fetch_def

Parameters
ptr_psi_termu
longallflag

FETCH_DEF(psi_term) Fetch the type definition of a psi_term and execute it. That is, get the list of (term,predicate) pairs that define the type. Unify the psi_term with the term, then prove the predicate.

This routine only gets the pairs that are defined in the type itself, not those defined in any types above it. This is the correct behavior for enumerating type disjunctions–all higher constraints have already been checked.

The above is true if allflag==FALSE. If allflag==TRUE then all constraints are executed, not just those defined in the type itself.

Definition at line 1208 of file login.c.

References wl_triple_list::aaaa_4, wl_psi_term::attr_list, wl_triple_list::bbbb_4, wl_triple_list::cccc_4, clear_copy(), DEFRULES, deref_ptr, eval_copy(), i_eval_args(), int_ptr, wl_triple_list::next, NULL, wl_definition::properties, prove, push2_ptr_value(), push_goal(), RMASK, SMASK, STACK, wl_psi_term::status, traceline(), wl_psi_term::type, and unify.

1209 {
1210  ptr_triple_list prop;
1211  ptr_psi_term v,w;
1212  ptr_definition utype;
1213 
1214  /* Uses SMASK because called from check_out */
1216  u->status=(4 & SMASK) | (u->status & RMASK);
1217 
1218  utype=u->type;
1219  prop=u->type->properties;
1220  if (prop) {
1221 
1222  traceline("fetching definition of %P\n",u);
1223 
1224  while (prop) {
1225  if (allflag || prop->cccc_4==utype) {
1226  clear_copy();
1227  v=eval_copy(prop->aaaa_4,STACK);
1228  w=eval_copy(prop->bbbb_4,STACK);
1229 
1231 
1232  deref_ptr(v);
1233  v->status=4;
1235  (void)i_eval_args(v->attr_list);
1236  }
1237  prop=prop->next;
1238  }
1239  }
1240 }
#define prove
Definition: def_const.h:273
void push2_ptr_value(type_ptr t, GENERIC *p, GENERIC v)
push2_ptr_value
Definition: login.c:573
void clear_copy()
clear_copy
Definition: copy.c:53
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
push_goal
Definition: login.c:600
#define DEFRULES
Definition: def_const.h:138
#define NULL
Definition: def_const.h:203
ptr_triple_list next
Definition: def_struct.h:199
ptr_definition cccc_4
Definition: def_struct.h:198
void traceline(char *format,...)
Definition: error.c:157
#define deref_ptr(P)
Definition: def_macro.h:95
#define RMASK
Definition: def_const.h:159
ptr_psi_term bbbb_4
Definition: def_struct.h:197
#define unify
Definition: def_const.h:274
long i_eval_args(ptr_node n)
i_eval_args
Definition: lefun.c:874
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_triple_list properties
Definition: def_struct.h:127
#define SMASK
Definition: def_const.h:160
ptr_node attr_list
Definition: def_struct.h:171
ptr_psi_term aaaa_4
Definition: def_struct.h:196
#define STACK
Definition: def_const.h:148
#define int_ptr
Definition: def_const.h:172
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

Parameters
ptr_psi_termu
ptr_definitionold1
ptr_definitionold2
ptr_nodeold1attr
ptr_nodeold2attr
longold1stat
longold2stat

FETCH_DEF_LAZY(psi_term,type1,type2,attr_list1,attr_list2) Fetch the type definition of a psi_term and execute it. That is, get the list of (term,pred) pairs that define the type. 'Term' is one of the type's attributes and 'pred' is a constraint. Unify the psi_term with the term, then prove pred.

Only those (term,pred) pairs are executed whose original type is below both type1 and type2, the types of the two psi-terms whose unification created psi_term. This avoids doing much superfluous work.

The above behavior is correct for a psi_term when always_check==TRUE for that psi_term. If always_check==FALSE for a psi_term, then if it does not have attributes it is not checked, and the addition of an attribute will force checking to occur.

Example:

:: t(a=>one,b=>two,c=> X) | thing(X).

psi_term = A:t (it can be any psi_term of type t) term = t(a=>one,b=>two,c=> X) pred = thing(X)

Definition at line 1276 of file login.c.

References wl_triple_list::aaaa_4, wl_definition::always_check, wl_psi_term::attr_list, wl_triple_list::bbbb_4, wl_triple_list::cccc_4, clear_copy(), DEFRULES, deref_ptr, eval_copy(), FALSE, i_eval_args(), int_ptr, matches(), wl_triple_list::next, NULL, wl_definition::properties, prove, push_goal(), push_ptr_value(), STACK, wl_psi_term::status, traceline(), wl_psi_term::type, and unify.

1277 {
1278  ptr_triple_list prop;
1279  ptr_psi_term v,w;
1280  long checked1, checked2;
1281  long m1, m2;
1282 
1283  if (!u->type->always_check) if (u->attr_list==NULL) return;
1284 
1286  u->status=4;
1287 
1288  prop=u->type->properties;
1289  if (prop) {
1290  traceline("fetching partial definition of %P\n",u);
1291 
1292  checked1 = old1attr || old1->always_check;
1293  checked2 = old2attr || old2->always_check;
1294 
1295  /* checked1 = (old1stat==4); */ /* 18.2.94 */
1296  /* checked2 = (old2stat==4); */
1297 
1298  while (prop) {
1299  /* Only do those constraints that have not yet been done: */
1300  /* In matches, mi is TRUE iff oldi <| prop->cccc_1. */
1301  if (!checked1) m1=FALSE; else (void)matches(old1,prop->cccc_4,&m1);
1302  if (!checked2) m2=FALSE; else (void)matches(old2,prop->cccc_4,&m2);
1303  if (!m1 && !m2) {
1304  /* At this point, prop->cccc_1 is an attribute that has not yet */
1305  /* been checked. */
1306  clear_copy();
1307  v=eval_copy(prop->aaaa_4,STACK);
1308  w=eval_copy(prop->bbbb_4,STACK);
1309 
1311 
1312  deref_ptr(v);
1313  v->status=4;
1315  (void)i_eval_args(v->attr_list);
1316  }
1317  prop=prop->next;
1318  }
1319  }
1320 }
#define prove
Definition: def_const.h:273
void clear_copy()
clear_copy
Definition: copy.c:53
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
push_goal
Definition: login.c:600
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
matches
Definition: types.c:1666
#define DEFRULES
Definition: def_const.h:138
#define NULL
Definition: def_const.h:203
ptr_triple_list next
Definition: def_struct.h:199
ptr_definition cccc_4
Definition: def_struct.h:198
char always_check
Definition: def_struct.h:134
void traceline(char *format,...)
Definition: error.c:157
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
ptr_psi_term bbbb_4
Definition: def_struct.h:197
#define unify
Definition: def_const.h:274
long i_eval_args(ptr_node n)
i_eval_args
Definition: lefun.c:874
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_triple_list properties
Definition: def_struct.h:127
ptr_node attr_list
Definition: def_struct.h:171
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
ptr_psi_term aaaa_4
Definition: def_struct.h:196
#define STACK
Definition: def_const.h:148
#define int_ptr
Definition: def_const.h:172
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)
expand_file_name
Definition: token.c:537
ptr_psi_term fileptr2stream ( FILE *  fp,
ptr_definition  typ 
)

fileptr2stream

Parameters
FILE*fp
ptr_definitiontyp removed * DJD = prior to 2.29

Definition at line 688 of file sys.c.

References BYTEDATA_DATA, FP_NONE, and make_bytedata().

689 {
690  ptr_psi_term result = make_bytedata(typ,sizeof(struct a_stream));
691  ((ptr_stream)BYTEDATA_DATA(result))->fp = fp;
692  ((ptr_stream)BYTEDATA_DATA(result))->op = FP_NONE;
693  return result;
694 }
struct a_stream * ptr_stream
#define FP_NONE
Definition: sys.c:668
#define BYTEDATA_DATA(X)
Definition: sys.c:139
Definition: sys.c:672
static ptr_psi_term make_bytedata(ptr_definition sort, unsigned long bytes)
make_bytedata(
Definition: sys.c:126
ptr_node find ( long  comp,
char *  keystr,
ptr_node  tree 
)

find

Parameters
longcomp
char*keystr
ptr_nodetree

FIND(comp,keystr,tree) Return the NODE address corresponding to key KEYSTR in TREE using function COMP to compare keys.

Definition at line 394 of file trees.c.

References Errorline(), FALSE, featcmp(), FEATCMP, intcmp(), INTCMP, wl_node::left, NULL, wl_node::right, STRCMP, and TRUE.

395 {
396  ptr_node result;
397  long cmp;
398  long to_do=TRUE;
399 
400  /*
401  if(comp==strcmp)
402  printf("%s ",keystr);
403  */
404 
405  do {
406  if (tree==NULL) {
407  result=NULL;
408  to_do=FALSE;
409  }
410  else {
411  if (comp == INTCMP)
412  cmp = intcmp((long)keystr,(long) (tree)->key);
413  else if (comp == FEATCMP)
414  cmp = featcmp(keystr,(tree)->key);
415  else if (comp == STRCMP)
416  cmp = strcmp(keystr,(tree)->key);
417  else
418  Errorline("Bad comp in general_insert.\n");
419 
420  if (cmp<0)
421  tree=tree->left;
422  else
423  if (cmp==0) {
424  result=tree;
425  to_do=FALSE;
426  }
427  else
428  tree=tree->right;
429  }
430  } while (to_do);
431 
432 
433  /* RM: Jan 27 1993
434  if(comp==strcmp)
435  printf("Find: '%s' -> %x\n",keystr,result);
436  */
437 
438  return result;
439 }
#define FEATCMP
Definition: def_const.h:257
#define INTCMP
Definition: def_const.h:256
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
void Errorline(char *format,...)
Definition: error.c:414
#define TRUE
Definition: def_const.h:127
#define STRCMP
Definition: def_const.h:255
#define FALSE
Definition: def_const.h:128
long intcmp(long a, long b)
intcmp
Definition: trees.c:21
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
ptr_node right
Definition: def_struct.h:184
void find_adults ( )

find_adults

FIND_ADULTS() Returns the list of all the maximal types (apart from top) in the symbol table. That is, types which have no parents. This routine modifies the global variable 'adults'.

Definition at line 549 of file types.c.

References adults, first_definition, HEAP_ALLOC, wl_int_list::next, wl_definition::next, NULL, wl_definition::parents, wl_definition::type_def, type_it, and wl_int_list::value_1.

551 {
552  ptr_definition d;
553  ptr_int_list l;
554 
555  for(d=first_definition;d;d=d->next)
556  if(d->type_def==(def_type)type_it && d->parents==NULL) {
557  l=HEAP_ALLOC(int_list);
558  l->value_1=(GENERIC)d;
559  l->next=adults;
560  adults=l;
561  }
562 }
def_type type_def
Definition: def_struct.h:133
#define NULL
Definition: def_const.h:203
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_int_list adults
Definition: def_glob.h:354
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
ptr_int_list parents
Definition: def_struct.h:130
ptr_node find_data ( GENERIC  p,
ptr_node  t 
)

find_data

Parameters
GENERICp
ptr_nodet

FIND_DATA(p,t) Return the node containing the data P in tree T. This is a linear search and can be used to find the key to some data if it is unkown. Return NULL if no key corresponds to data P.

Definition at line 452 of file trees.c.

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

453 {
454  ptr_node r=NULL;
455 
456  if(t)
457  if(t->data==p)
458  r=t;
459  else {
460  r=find_data(p,t->left);
461  if(r==NULL)
462  r=find_data(p,t->right);
463  }
464 
465  return r;
466 }
ptr_node find_data(GENERIC p, ptr_node t)
find_data
Definition: trees.c:452
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
ptr_node right
Definition: def_struct.h:184
ptr_module find_module ( char *  module)

find_module

Parameters
char*module

FIND_MODULE(module) Return a module if it exists.

Definition at line 54 of file modules.c.

References wl_node::data, FEATCMP, find(), and NULL.

55 {
56  ptr_node nodule;
57 
58  nodule=find(FEATCMP,(char *)module,module_table);
59  if(nodule)
60  return (ptr_module)(nodule->data);
61  else
62  return NULL;
63 }
ptr_node module_table
Definition: modules.c:14
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
void forbid_variables ( ptr_node  n)

FORBID_VARIABLES This inserts the value of the dereferenced variables into the PRINTED_POINTERS tree, so that they will never be printed as NAME:value inside a psi-term. Each variable is printed as NAME = VALUE by the PRINT_VARIABLES routine.

Definition at line 334 of file print.c.

References wl_node::data, deref_ptr, heap_insert(), INTCMP, wl_node::key, wl_node::left, printed_pointers, and wl_node::right.

335 {
336  ptr_psi_term v;
337 
338  if(n) {
340  v=(ptr_psi_term )n->data;
341  deref_ptr(v);
342  (void)heap_insert(INTCMP,(char *)v,&printed_pointers,(GENERIC)n->key);
344  }
345 }
ptr_node printed_pointers
Definition: def_glob.h:28
#define INTCMP
Definition: def_const.h:256
GENERIC data
Definition: def_struct.h:185
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
char * key
Definition: def_struct.h:182
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node right
Definition: def_struct.h:184
void garbage ( )

garbage

GARBAGE() The garbage collector. This routine is called whenever memory is getting low. It returns TRUE if insufficient memory was freed to allow the interpreter to carry on working.

This is a half-space GC, it first explores all known structures, then compresses the heap and the stack, then during the second pass assigns all the new addresses.

Bugs will appear if the collector is called during parsing or other such routines which are 'unsafe'. In order to avoid this problem, before one of these routines is invoked the program will check to see whether there is enough memory available to work, and will call the GC if not (this is a fix, because it is not possible to determine in advance what the size of a psi_term read by the parser will be).

Definition at line 1529 of file memory.c.

References assert, bounds_undo_stack(), check(), clear_copy(), compress(), FALSE, garbage_time, gc_time, heap_pointer, ignore_eff, last_garbage_time, life_time, mem_base, mem_limit, NULL, other_base, other_limit, pass, pointer_names, print_gc_info(), printed_pointers, stack_info(), stack_pointer, TRUE, and verbose.

1530 {
1531  GENERIC addr;
1532  struct tms garbage_start_time,garbage_end_time;
1533  long start_number_cells, end_number_cells;
1534 
1535  start_number_cells = (stack_pointer-mem_base) + (mem_limit-heap_pointer);
1536 
1537  (void)times(&garbage_start_time);
1538 
1539  /* Time elapsed since last garbage collection */
1540  life_time=(garbage_start_time.tms_utime - last_garbage_time.tms_utime)/60.0;
1541 
1542 
1543  if (verbose) {
1544  fprintf(stderr,"*** Garbage Collect "); /* RM: Jan 26 1993 */
1545  fprintf(stderr,"\n*** Begin");
1547  (void)fflush(stderr);
1548  }
1549 
1550 
1551  /* reset the other base */
1552  for (addr = other_base; addr < other_limit; addr ++)
1553  *addr = 0;
1554 
1555  pass=1;
1556 
1557  check();
1558 #ifdef GCVERBOSE
1559  fprintf(stderr,"- Done pass 1 ");
1560 #endif
1561 
1563  compress();
1564 #ifdef GCVERBOSE
1565  fprintf(stderr,"- Done compress ");
1566 #endif
1567 
1568  pass=2;
1569 
1570  check();
1572 #ifdef GCVERBOSE
1573  fprintf(stderr,"- Done pass 2\n");
1574 #endif
1575 
1576  clear_copy();
1577 
1580 
1581  (void)times(&garbage_end_time);
1582  gc_time=(garbage_end_time.tms_utime - garbage_start_time.tms_utime)/60.0;
1584 
1585  if (verbose) {
1586  fprintf(stderr,"*** End ");
1587  print_gc_info(TRUE); /* RM: Jan 26 1993 */
1588  stack_info(stderr);
1589  (void)fflush(stderr);
1590  }
1591 
1592  last_garbage_time=garbage_end_time;
1593 
1594  end_number_cells = (stack_pointer-mem_base) + (mem_limit-heap_pointer);
1595  assert(end_number_cells<=start_number_cells);
1596 
1597  ignore_eff=FALSE;
1598 
1599 }
ptr_node printed_pointers
Definition: def_glob.h:28
static void check()
check
Definition: memory.c:1299
void clear_copy()
clear_copy
Definition: copy.c:53
GENERIC mem_limit
Definition: def_glob.h:13
static float gc_time
Definition: memory.c:27
long verbose
Definition: def_glob.h:273
static long pass
Definition: memory.c:21
GENERIC other_base
Definition: def_glob.h:19
#define NULL
Definition: def_const.h:203
long ignore_eff
Definition: def_glob.h:151
ptr_node pointer_names
Definition: def_glob.h:29
void print_gc_info(long timeflag)
print_gc_info
Definition: memory.c:1492
#define TRUE
Definition: def_const.h:127
static float life_time
Definition: memory.c:27
#define FALSE
Definition: def_const.h:128
GENERIC mem_base
Definition: def_glob.h:11
GENERIC heap_pointer
Definition: def_glob.h:12
static void compress()
compress
Definition: memory.c:222
void stack_info(FILE *outfile)
Definition: error.c:58
GENERIC other_limit
Definition: def_glob.h:20
GENERIC stack_pointer
Definition: def_glob.h:14
float garbage_time
Definition: def_glob.h:16
unsigned long * GENERIC
Definition: def_struct.h:17
long bounds_undo_stack()
bounds_undo_stack
Definition: memory.c:142
static struct tms last_garbage_time
Definition: memory.c:26
#define assert(N)
Definition: memory.c:113
ptr_node general_insert ( long  comp,
char *  keystr,
ptr_node tree,
GENERIC  info,
long  heapflag,
long  copystr,
long  bkflag 
)

ptr_node general_insert

Parameters
longcomp
char*keystr
ptr_node*tree
GENERICinfo
longheapflag
longcopystr
longbkflag

GENERAL_INSERT(comp,keystr,tree,info,heapflag,copystr,bkflag) General tree insertion routine. comp = comparison routine for insertion. keystr = the insertion key. tree = the tree to insert in. info = the information to insert. heapflag = HEAP or STACK for heap or stack allocation of insertion node. copystr = TRUE iff copy the keystr to the heap on insertion. bkflag = 1 iff the insertion is backtrackable (trailed with trail check). 2 iff the insertion must always be trailed. Returns a pointer to the node containing the pair (keystr,info).

Here KEYSTR can be either a pointer to a string, an integer, or a feature. COMP is the function to call to compare 2 keys so it has three possible values: COMP==strcmp(), COMP==intcmp(), or COMP==featcmp(). COMP(a,b) should return n where: n=0 if a=b; n>0 if a>b; n<0 if a<b.

Definition at line 224 of file trees.c.

References Errorline(), FALSE, featcmp(), FEATCMP, HEAP, HEAP_ALLOC, heap_copy_string(), int_ptr, intcmp(), INTCMP, wl_node::key, NULL, push_ptr_value(), push_ptr_value_global(), STACK_ALLOC, STRCMP, and TRUE.

225 {
226  long cmp;
227  ptr_node result;
228  long to_do=TRUE;
229 
230 
231  do {
232  if (*tree==NULL) {
233  if (bkflag==1) push_ptr_value(int_ptr,(GENERIC *)tree);
234  else if (bkflag==2) push_ptr_value_global(int_ptr,(GENERIC *)tree);
235  *tree = (heapflag==HEAP) ? HEAP_ALLOC(node): STACK_ALLOC(node);
236  result= *tree;
237  (*tree)->key = copystr ? heap_copy_string(keystr) : keystr;
238  (*tree)->left=NULL;
239  (*tree)->right=NULL;
240  (*tree)->data=info;
241  to_do=FALSE;
242  }
243  else {
244  if (comp == INTCMP)
245  cmp = intcmp((long)keystr,(long) (*tree)->key);
246  else if (comp == FEATCMP)
247  cmp = featcmp(keystr,(*tree)->key);
248  else if (comp == STRCMP)
249  cmp = strcmp(keystr,(*tree)->key);
250  else
251  Errorline("Bad comp in general_insert.\n");
252 
253  if (cmp<0)
254  tree=(&((*tree)->left));
255  else
256  if (cmp==0) {
257  if (bkflag)
258  Errorline("attempt to overwrite an existing feature; ignored.\n");
259  else
260  (*tree)->data=info;
261  result= *tree;
262  to_do=FALSE;
263  }
264  else
265  tree=(&((*tree)->right));
266  }
267  } while (to_do);
268 
269  return result;
270 }
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
#define HEAP
Definition: def_const.h:147
#define FEATCMP
Definition: def_const.h:257
#define INTCMP
Definition: def_const.h:256
void push_ptr_value_global(type_ptr t, GENERIC *p)
push_ptr_value_global
Definition: login.c:523
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Definition: error.c:414
char * key
Definition: def_struct.h:182
#define TRUE
Definition: def_const.h:127
#define STRCMP
Definition: def_const.h:255
#define FALSE
Definition: def_const.h:128
long intcmp(long a, long b)
intcmp
Definition: trees.c:21
#define STACK_ALLOC(A)
Definition: def_macro.h:16
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
unsigned long * GENERIC
Definition: def_struct.h:17
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
#define int_ptr
Definition: def_const.h:172
long get_arg ( ptr_psi_term  g,
ptr_psi_term arg,
char *  number 
)

get_arg

Parameters
ptr_psi_termg
ptr_psi_term*arg
char*number

GET_ARG assign the argument "number" of the goal "g" in "arg". return FALSE if bad argument.

Definition at line 25 of file templates.c.

References wl_psi_term::attr_list, wl_node::data, FALSE, FEATCMP, find(), and TRUE.

26 {
27  ptr_node n;
28 
29  if ((n = find (FEATCMP, number, g->attr_list)))
30  return (*arg = (ptr_psi_term) n->data) ? TRUE: FALSE;
31  else
32  return FALSE;
33 }
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
ptr_node attr_list
Definition: def_struct.h:171
GENERIC get_attr ( ptr_psi_term  t,
char *  attrname 
)

get_attr

Parameters
ptr_psi_termt
char*attrname

Get the GENERIC value of a psi-term's attribute

Definition at line 265 of file token.c.

References wl_psi_term::attr_list, wl_node::data, FEATCMP, and find().

266 {
267  ptr_node n=find(FEATCMP,attrname,t->attr_list);
268  return n->data;
269 }
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
ptr_node attr_list
Definition: def_struct.h:171
int get_module ( ptr_psi_term  psi,
ptr_module module 
)

get_module

Parameters
ptr_psi_termpsi
ptr_module*module

GET_MODULE(psi,module,resid) Convert a psi-term to a module. The psi-term must be a string.

Definition at line 1226 of file modules.c.

References deref_ptr, Errorline(), FALSE, find_module(), wl_definition::keyword, NULL, overlap_type(), quoted_string, wl_keyword::symbol, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

1227 {
1228  int success=TRUE;
1229  char *s;
1230 
1231  *module=NULL;
1232 
1233  deref_ptr(psi);
1234  if(overlap_type(psi->type,quoted_string) && psi->value_3)
1235  s=(char *)psi->value_3;
1236  else
1237  s=psi->type->keyword->symbol;
1238 
1239  *module=find_module(s);
1240  if(!(*module)) {
1241  Errorline("undefined module \"%s\"\n",s);
1242  success=FALSE;
1243  }
1244 
1245  return success;
1246 }
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
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_definition quoted_string
Definition: def_glob.h:101
GENERIC value_3
Definition: def_struct.h:170
ptr_module find_module(char *module)
find_module
Definition: modules.c:54
ptr_definition type
Definition: def_struct.h:165
void get_one_arg ( ptr_node  t,
ptr_psi_term a 
)

get_one_arg

Parameters
ptr_nodet
ptr_psi_term*a

GET_ONE_ARG(attr_list,arg1) Get the argument labelled '1' as quickly as possible from the binary tree ATTR_LIST, place it in ARG1. This routine nearly always makes a direct hit.

Definition at line 99 of file login.c.

References wl_node::data, FEATCMP, find(), wl_node::key, NULL, and one.

100 {
101  ptr_node n;
102 
103  *a=NULL;
104  if (t) {
105  if (t->key==one) {
106  *a=(ptr_psi_term)t->data;
107  }
108  else {
109  n=find(FEATCMP,one,t);
110  if (n==NULL)
111  *a=NULL;
112  else
113  *a=(ptr_psi_term)n->data;
114  }
115  }
116 }
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
char * key
Definition: def_struct.h:182
char * one
Definition: def_glob.h:250
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void get_one_arg_addr ( ptr_node  t,
ptr_psi_term **  a 
)

get_one_arg_addr

Parameters
ptr_nodet
ptr_psi_term**a

GET_ONE_ARG_ADDR(attr_list,arg1addr) Get address of slot in the attr_list that points to the argument labelled '1' as quickly as possible from the binary tree ATTR_LIST. This routine nearly always makes a direct hit.

Definition at line 132 of file login.c.

References wl_node::data, FEATCMP, find(), wl_node::key, NULL, and one.

133 {
134  ptr_node n;
135  // ptr_psi_term *b;
136 
137  *a=NULL;
138  if (t) {
139  if (t->key==one)
140  *a= (ptr_psi_term *)(&t->data);
141  else {
142  n=find(FEATCMP,one,t);
143  if (n==NULL)
144  *a=NULL;
145  else
146  *a= (ptr_psi_term *)(&n->data);
147  }
148  }
149 }
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
char * key
Definition: def_struct.h:182
char * one
Definition: def_glob.h:250
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
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)
matches
Definition: types.c:1666
#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
FILE * get_stream ( ptr_psi_term  t)

get_stream

Parameters
ptr_psi_termt

Get the psi-term's STREAM attribute

Definition at line 278 of file token.c.

References get_attr(), and STREAM.

279 {
280  return (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
281 }
#define STREAM
Definition: def_const.h:225
GENERIC get_attr(ptr_psi_term t, char *attrname)
get_attr
Definition: token.c:265
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void get_two_args ( ptr_node  t,
ptr_psi_term a,
ptr_psi_term b 
)

get_two_args

Parameters
ptr_nodet,
ptr_psi_term*a
ptr_psi_term*b

GET_TWO_ARGS(attr_list,arg1,arg2) Get the arguments labelled '1' and '2' as quickly as possible from the binary tree ATTR_LIST, place them in ARG1 and ARG2. This routine nearly always makes a direct hit.

Definition at line 47 of file login.c.

References wl_node::data, FEATCMP, find(), wl_node::key, NULL, one, wl_node::right, and two.

48 {
49  ptr_node n;
50 
51  *a=NULL;
52  *b=NULL;
53  if (t) {
54  if (t->key==one) {
55  *a=(ptr_psi_term )t->data;
56  n=t->right;
57  if (n)
58  if (n->key==two)
59  *b=(ptr_psi_term )n->data;
60  else {
61  n=find(FEATCMP,two,t);
62  if(n==NULL)
63  *b=NULL;
64  else
65  *b=(ptr_psi_term )n->data;
66  }
67  else
68  *b=NULL;
69  }
70  else {
71  n=find(FEATCMP,one,t);
72  if (n==NULL)
73  *a=NULL;
74  else
75  *a=(ptr_psi_term )n->data;
76  n=find(FEATCMP,two,t);
77  if (n==NULL)
78  *b=NULL;
79  else
80  *b=(ptr_psi_term )n->data;
81  }
82  }
83 }
#define FEATCMP
Definition: def_const.h:257
char * two
Definition: def_glob.h:251
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
char * key
Definition: def_struct.h:182
char * one
Definition: def_glob.h:250
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_node right
Definition: def_struct.h:184
int GetBoolOption ( char *  name)

GetBoolOption.

Parameters
char*name

Definition at line 64 of file memory.c.

References GetStrOption().

65 {
66  char *s;
67  s=GetStrOption(name,"off");
68  return strcmp(s,"off");
69 }
char * name
Definition: def_glob.h:325
char * GetStrOption(char *name, char *def)
GetStrOption.
Definition: memory.c:41
int GetIntOption ( char *  name,
int  def 
)

GetIntOption.

Parameters
char*name
intdef

Definition at line 78 of file memory.c.

References GetStrOption().

79 {
80  char *s;
81  char buffer_loc[40];
82  (void)snprintf(buffer_loc,40,"%d",def);
83  s=GetStrOption(name,buffer_loc);
84  return atof(s);
85 }
char * name
Definition: def_glob.h:325
char * GetStrOption(char *name, char *def)
GetStrOption.
Definition: memory.c:41
char * GetStrOption ( char *  name,
char *  def 
)

GetStrOption.

Parameters
char*name
char*def

STUFF FOR PARSING COMMAND LINE ARGS

Definition at line 41 of file memory.c.

References arg_c, and arg_v.

42 {
43  int i;
44  char *result=def;
45  int l=strlen(name);
46 
47  for(i=1;i<arg_c;i++)
48  if(arg_v[i][0]=='-' && (int)strlen(arg_v[i])>=l+1)
49  if(!strncmp(arg_v[i]+1,name,l))
50  if(arg_v[i][l+1]=='=')
51  result=arg_v[i]+l+2;
52  else
53  result=arg_v[i]+l+1;
54 
55  return result;
56 }
char * name
Definition: def_glob.h:325
int arg_c
Definition: def_glob.h:5
char * arg_v[10]
Definition: def_glob.h:6
long glb ( ptr_definition  t1,
ptr_definition  t2,
ptr_definition t3,
ptr_int_list c3 
)

glb

Parameters
ptr_definitiont1
ptr_definitiont2
ptr_definition*t3
ptr_int_list*c3

GLB(t1,t2,t3) This function returns the Greatest Lower Bound of two types T1 and T2 in T3.

T3 = T1 /\ T2

If T3 is not a simple type then C3 is its code, and T3=NULL.

It also does some type comparing, and returns

0 if T3 = bottom 1 if T1 = T2 2 if T1 <| T2 ( T3 = T1 ) 3 if T1 |> T2 ( T3 = T2 ) 4 otherwise ( T3 strictly <| T1 and T3 strictly <| T2 )

These results are used for knowing when to inherit properties or release residuations. The t3 field is NULL iff a new type is needed to represent the result.

RM: May 7 1993 Fixed bug in when multiple word code

Definition at line 1481 of file types.c.

References wl_definition::code, FALSE, wl_int_list::next, NOT_CODED, nothing, NULL, STACK_ALLOC, top, TRUE, and wl_int_list::value_1.

1482 {
1483  ptr_int_list c1,c2;
1484  long result=0;
1485  unsigned long v1,v2,v3;
1486  int e1,e2,b; /* RM: May 7 1993 */
1487 
1488 
1489 
1490  *c3=NULL;
1491 
1492  if (t1==t2) {
1493  result=1;
1494  *t3= t1;
1495  }
1496  else if (t1==top) {
1497  *t3= t2;
1498  if (t2==top)
1499  result=1;
1500  else
1501  result=3;
1502  }
1503  else if (t2==top) {
1504  result=2;
1505  *t3= t1;
1506  }
1507  else {
1508  /* printf("glb of %s and %s\n",
1509  t1->keyword->combined_name,
1510  t2->keyword->combined_name); */
1511 
1512  c1=t1->code;
1513  c2=t2->code;
1514 
1515  e1=TRUE;e2=TRUE;b=TRUE;
1516 
1517  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1518  result=0;
1519  while (c1 && c2) {
1520 
1521  *c3 = STACK_ALLOC(int_list);
1522  (*c3)->next=NULL;
1523 
1524  v1=(unsigned long)(c1->value_1);
1525  v2=(unsigned long)(c2->value_1);
1526  v3=v1 & v2;
1527 
1528  /* printf("v1=%d, v2=%d, v3=%d\n",v1,v2,v3); */
1529 
1530  (*c3)->value_1=(GENERIC)v3;
1531 
1532  if(v3!=v1) /* RM: May 7 1993 */
1533  e1=FALSE;
1534  if(v3!=v2)
1535  e2=FALSE;
1536  if(v3)
1537  b=FALSE;
1538 
1539  c1=c1->next;
1540  c2=c2->next;
1541  c3= &((*c3)->next);
1542  }
1543  *t3=NULL;
1544 
1545  if(b) /* RM: May 7 1993 */
1546  result=0; /* 0 if T3 = bottom */
1547  else
1548  if(e1)
1549  if(e2)
1550  result=1; /* 1 if T1 = T2 */
1551  else
1552  result=2; /* 2 if T1 <| T2 ( T3 = T1 ) */
1553  else
1554  if(e2)
1555  result=3; /* 3 if T1 |> T2 ( T3 = T2 ) */
1556  else
1557  result=4; /* 4 otherwise */
1558  }
1559  }
1560 
1561  if (!result) *t3=nothing;
1562 
1563  /* printf("result=%d\n\n",result); */
1564 
1565  return result;
1566 }
#define NOT_CODED
Definition: def_const.h:134
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_definition nothing
Definition: def_glob.h:98
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list next
Definition: def_struct.h:55
long glb_code ( long  f1,
GENERIC  c1,
long  f2,
GENERIC  c2,
long *  f3,
GENERIC c3 
)

glb_code

Parameters
longf1
GENERICc1
longf2
GENERICc2
long*f3
GENERIC*c3

GLB_CODE(f1,c1,f2,c2,f3,c3) (21.9) Calculate glb of two type codes C1 and C2, put result in C3. Return a result value (see comments of glb(..)).

Sorts are stored as a 'Variant Record': f1==TRUE: c1 is a ptr_definition (an interned symbol). f1==FALSE: c1 is a ptr_int_list (a sort code). The result (f3,c3) is also in this format. This is needed to correctly handle psi-terms that don't have a sort code (for example, functions, predicates, and singleton sorts). The routine handles a bunch of special cases that keep f3==TRUE. Other than that, it is almost a replica of the inner loop of glb(..).

Definition at line 1351 of file types.c.

References wl_definition::code, FALSE, wl_int_list::next, NOT_CODED, NULL, STACK_ALLOC, top, TRUE, and wl_int_list::value_1.

1352 {
1353  long result=0;
1354  unsigned long v1,v2,v3;
1355  ptr_int_list cd1,cd2,*cd3; /* sort codes */
1356 
1357  /* First, the cases where c1 & c2 are ptr_definitions: */
1358  if (f1 && f2) {
1359  if ((ptr_definition)c1==(ptr_definition)c2) {
1360  *c3=c1;
1361  result=1;
1362  }
1363  else if ((ptr_definition)c1==top) {
1364  *c3=c2;
1365  if ((ptr_definition)c2==top)
1366  result=1;
1367  else
1368  result=3;
1369  }
1370  else if ((ptr_definition)c2==top) {
1371  *c3=c1;
1372  result=2;
1373  }
1374  /* If both inputs are either top or the same ptr_definition */
1375  /* then can return quickly with a ptr_definition. */
1376  if (result) {
1377  *f3=TRUE; /* c3 is ptr_definition (an interned symbol) */
1378  return result;
1379  }
1380  }
1381  /* In the other cases, can't return with a ptr_definition: */
1382  cd1=(ptr_int_list)(f1?(GENERIC)((ptr_definition)c1)->code:c1);
1383  cd2=(ptr_int_list)(f2?(GENERIC)((ptr_definition)c2)->code:c2);
1384  cd3=(ptr_int_list*)c3;
1385  *f3=FALSE; /* cd3 is ptr_int_list (a sort code) */
1386  if (cd1==NOT_CODED) {
1387  if (cd2==NOT_CODED) {
1388  if (c1==c2) {
1389  *cd3=cd1;
1390  result=1;
1391  }
1392  else
1393  result=0;
1394  }
1395  else if (cd2==top->code) {
1396  *cd3=cd1;
1397  result=2;
1398  }
1399  else
1400  result=0;
1401  }
1402  else if (cd1==top->code) {
1403  if (cd2==top->code) {
1404  *cd3=cd1;
1405  result=1;
1406  }
1407  else {
1408  *cd3=cd2;
1409  result=3;
1410  }
1411  }
1412  else if (cd2==NOT_CODED)
1413  result=0;
1414  else if (cd2==top->code) {
1415  *cd3=cd1;
1416  result=2;
1417  }
1418  else while (cd1 && cd2) {
1419  /* Bit operations needed only if c1 & c2 coded & different from top */
1420  *cd3 = STACK_ALLOC(int_list);
1421  (*cd3)->next=NULL;
1422 
1423  v1=(unsigned long)(cd1->value_1);
1424  v2=(unsigned long)(cd2->value_1);
1425  v3=v1 & v2;
1426  (*cd3)->value_1=(GENERIC)v3;
1427 
1428  if (v3) {
1429  if (v3<v1 && v3<v2)
1430  result=4;
1431  else if (result!=4)
1432  if (v1<v2)
1433  result=2;
1434  else if (v1>v2)
1435  result=3;
1436  else
1437  result=1;
1438  }
1439  else if (result)
1440  if (v1 || v2)
1441  result=4;
1442 
1443  cd1=cd1->next;
1444  cd2=cd2->next;
1445  cd3= &((*cd3)->next);
1446  }
1447 
1448  return result;
1449 }
#define NOT_CODED
Definition: def_const.h:134
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
struct wl_definition * ptr_definition
Definition: def_struct.h:31
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
struct wl_int_list * ptr_int_list
Definition: def_struct.h:29
ptr_int_list next
Definition: def_struct.h:55
long glb_value ( long  result,
long  f,
GENERIC  c,
GENERIC  value1,
GENERIC  value2,
GENERIC value 
)

glb_value

Parameters
longresult
longf
GENERICc
GENERICvalue1
GENERICvalue2
GENERIC*value

GLB_VALUE(result,f,c,value1,value2,value) Do the comparison of the value fields of two psi-terms. This is used in conjunction with glb_code to correctly implement completeness for disequality for psi-terms with non-NULL value fields. This must be preceded by a call to glb_code, since it uses the outputs of that call.

result result of preceding glb_code call (non-NULL iff non-empty intersec.) f,c sort intersection (sortflag & code) of preceding glb_code call. value1 value field of first psi-term. value2 value field of second psi-term. value output value field (if any).

Definition at line 1290 of file types.c.

References wl_definition::code, FALSE, NULL, quoted_string, REAL, real, sub_CodeType(), and TRUE.

1291 {
1292  ptr_int_list code;
1293 
1294  if (!result) return FALSE;
1295  if (value1==NULL) {
1296  *value=value2;
1297  return TRUE;
1298  }
1299  if (value2==NULL) {
1300  *value=value1;
1301  return TRUE;
1302  }
1303  /* At this point, both value fields are non-NULL */
1304  /* and must be compared. */
1305 
1306  /* Get a pointer to the sort code */
1307  code = f ? ((ptr_definition)c)->code : (ptr_int_list)c;
1308 
1309  /* This rather time-consuming analysis is necessary if both objects */
1310  /* have non-NULL value fields. Note that only those objects with a */
1311  /* non-NULL value field needed for disentailment are looked at. */
1312  if (sub_CodeType(code,real->code)) {
1313  *value=value1;
1314  return (*(REAL *)value1 == *(REAL *)value2);
1315  }
1316  else if (sub_CodeType(code,quoted_string->code)) {
1317  *value=value1;
1318  return (!strcmp((char *)value1,(char *)value2));
1319  }
1320  else {
1321  /* All other sorts with 'value' fields always return TRUE, that is, */
1322  /* the value field plays no role in disentailment. */
1323  *value=value1;
1324  return TRUE;
1325  }
1326 }
long sub_CodeType(ptr_int_list c1, ptr_int_list c2)
sub_CodeType
Definition: types.c:1618
#define NULL
Definition: def_const.h:203
#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
ptr_definition quoted_string
Definition: def_glob.h:101
struct wl_definition * ptr_definition
Definition: def_struct.h:31
ptr_int_list code
Definition: def_struct.h:129
struct wl_int_list * ptr_int_list
Definition: def_struct.h:29
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
int global_unify ( ptr_psi_term  u,
ptr_psi_term  v 
)

global_unify

Parameters
ptr_psi_termu
ptr_psi_termv

GLOBAL_UNIFY(u,v) Unify two psi-terms, where it is known that V is on the heap (a persistent variable).

This routine really matches U and V, it will only succeed if V is more general than U. U will then be bound to V.

Definition at line 1053 of file modules.c.

References wl_psi_term::attr_list, c_abort(), wl_psi_term::coref, deref_ptr, Errorline(), FALSE, glb(), global_unify_attr(), heap_pointer, overlap_type(), push_psi_ptr_value(), quoted_string, REAL, real, release_resid(), wl_psi_term::resid, traceline(), TRUE, wl_psi_term::type, and wl_psi_term::value_3.

1054 {
1055  int success=TRUE;
1056  int compare;
1057  ptr_definition new_type;
1058  ptr_int_list new_code;
1059 
1060  deref_ptr(u);
1061  deref_ptr(v);
1062 
1063  traceline("match persistent %P with %P\n",u,v);
1064 
1065  /* printf("u=%ld, v=%ld, heap_pointer=%ld\n",u,v,heap_pointer);*/
1066 
1067  /* printf("u=%s, v=%s\n",
1068  u->type->keyword->symbol,
1069  v->type->keyword->symbol); */
1070 
1071  if((GENERIC)u>=heap_pointer) {
1072  Errorline("cannot unify persistent values\n");
1073  return c_abort();
1074  }
1075 
1076  /**** U is on the stack, V is on the heap ****/
1077 
1078  /**** Calculate their Greatest Lower Bound and compare them ****/
1079  compare=glb(u->type,v->type,&new_type,&new_code);
1080 
1081  /* printf("compare=%d\n",compare); */
1082 
1083  if (compare==1 || compare==3) { /* Match only */
1084 
1085  /**** Check for values ****/
1086  if(v->value_3) {
1087  if(u->value_3) {
1088  if(u->value_3!=v->value_3) { /* One never knows */
1089  if (overlap_type(v->type,real))
1090  success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
1091  else if (overlap_type(v->type,quoted_string))
1092  success=(strcmp((char *)u->value_3,(char *)v->value_3)==0);
1093  else
1094  return FALSE; /* Don't unify CUTs and STREAMs and things */
1095  }
1096  }
1097  }
1098  else
1099  if(u->value_3)
1100  return FALSE;
1101 
1102  if(success) {
1103  /**** Bind the two psi-terms ****/
1104  push_psi_ptr_value(u,(GENERIC *)&(u->coref));
1105  u->coref=v;
1106 
1107  /**** Match the attributes ****/
1108  success=global_unify_attr(u->attr_list,v->attr_list);
1109 
1110  /*
1111  if(!success)
1112  warningline("attributes don't unify in %P and %P\n",u,v);
1113  */
1114 
1115  if(success && u->resid)
1116  release_resid(u);
1117  }
1118  }
1119  else
1120  success=FALSE;
1121 
1122  return success;
1123 }
ptr_residuation resid
Definition: def_struct.h:173
long glb(ptr_definition t1, ptr_definition t2, ptr_definition *t3, ptr_int_list *c3)
glb
Definition: types.c:1481
int global_unify_attr(ptr_node, ptr_node)
global_unify_attr
Definition: modules.c:1135
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
long c_abort()
c_abort
Definition: built_ins.c:2248
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
#define REAL
Definition: def_const.h:72
void release_resid(ptr_psi_term t)
release_resid
Definition: lefun.c:445
void traceline(char *format,...)
Definition: error.c:157
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
#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_psi_term coref
Definition: def_struct.h:172
GENERIC heap_pointer
Definition: def_glob.h:12
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
int global_unify_attr ( ptr_node  u,
ptr_node  v 
)

global_unify_attr

Parameters
ptr_nodeu
ptr_nodev

GLOBAL_UNIFY_ATTR(u,v) Unify the attributes of two terms, one on the heap, one on the stack. This is really matching, so all features of U must appear in V.

Definition at line 1135 of file modules.c.

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

1136 {
1137  int success=TRUE;
1138  ptr_node temp;
1139  long cmp;
1140 
1141  if(u)
1142  if(v) {
1143  /* RM: Feb 16 1993 Avoid C optimiser bug */
1144  (void)dummy_printf("%s %s\n",u->key,v->key);
1145 
1146  cmp=featcmp(u->key,v->key);
1147  if(cmp<0) {
1148  temp=u->right;
1149  u->right=NULL;
1150  success=global_unify_attr(u,v->left) && global_unify_attr(temp,v);
1151  u->right=temp;
1152  }
1153  else
1154  if(cmp>0) {
1155  temp=u->left;
1156  u->left=NULL;
1157  success=global_unify_attr(u,v->right) && global_unify_attr(temp,v);
1158  u->left=temp;
1159  }
1160  else {
1161  success=
1162  global_unify_attr(u->left,v->left) &&
1163  global_unify_attr(u->right,v->right) &&
1165  }
1166  }
1167  else
1168  success=FALSE;
1169 
1170  return success;
1171 }
int global_unify_attr(ptr_node, ptr_node)
global_unify_attr
Definition: modules.c:1135
int global_unify(ptr_psi_term u, ptr_psi_term v)
global_unify
Definition: modules.c:1053
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
int dummy_printf(char *f, char *s, char *t)
dummy_printf
Definition: login.c:2619
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
ptr_node right
Definition: def_struct.h:184
void go_through ( ptr_psi_term  t)

go_through

Parameters
ptr_psi_termt

GO_THROUGH(t) This routine goes through all the sub_terms of psi_term T to determine which pointers need to have names given to them for printing because they are referred to elsewhere. T is a dereferenced psi_term.

Definition at line 282 of file print.c.

References wl_psi_term::attr_list, and go_through_tree().

283 {
284  if (t->attr_list)
286 
287  /*
288  if(r=t->resid)
289  while(r) {
290  if(r->goal->pending)
291  go_through(r->goal->aaaa_1);
292  r=r->next;
293  } */
294 }
ptr_node attr_list
Definition: def_struct.h:171
void go_through_tree ( ptr_node  t)

go_through_tree

Parameters
ptr_nodet

GO_THROUGH_TREE(t) Explore all the pointers in the attribute tree T. Pointers that occur more than once will need a tag.

Definition at line 258 of file print.c.

References check_pointer(), wl_node::data, wl_node::left, and wl_node::right.

259 {
260  if (t) {
261  if (t->left) {
262  go_through_tree(t->left);
263  }
265  if (t->right) {
267  }
268  }
269 
270 }
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
ptr_node right
Definition: def_struct.h:184
ptr_goal GoalFromPsiTerm ( ptr_psi_term  psiTerm)
char ** group_features ( char **  f,
ptr_node  n 
)

group_features

Parameters
char**f
ptr_noden

Definition at line 34 of file lib.c.

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

35 {
36  *f=NULL;
37  if(n) {
38  if(n->left)
39  f=group_features(f,n->left);
40  *f=n->key;
41  f++;
42  if(n->right)
43  f=group_features(f,n->right);
44  }
45 
46  return f;
47 }
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
char ** group_features(char **f, ptr_node n)
group_features
Definition: lib.c:34
ptr_node right
Definition: def_struct.h:184
void handle_interrupt ( )

HANDLE_INTERRUPT.

This deals with an eventual interrupt. Return TRUE if execution continues normally, otherwise abort query, toggle trace on or off, or quit Wild_Life (suicide).

Definition at line 52 of file interrupt.c.

References abort_life(), DIGIT, EOLN, exit_life(), FALSE, input_state, interrupted, open_input_file(), prompt, quietflag, read_char(), restore_state(), show_count(), stdin_cleareof(), stepcount, stepflag, steptrace, trace, TRUE, and verbose.

53 {
54  ptr_psi_term old_state_loc;
55  char *old_prompt;
56  int old_quiet; /* 21.1 */
57  long c,d; /* 21.12 (prev. char) */
58  long count;
59 
60  if (interrupted) printf("\n");
62  old_prompt=prompt;
63  old_quiet=quietflag; /* 21.1 */
65 
66  /* new_state(&old_state_loc); */
67  old_state_loc=input_state;
68  (void)open_input_file("stdin");
70 
71  StartAgain:
72  do {
73  printf("*** Command ");
74  prompt="(q,c,a,s,t,h)?";
75  quietflag=FALSE; /* 21.1 */
76 
77  do {
78  c=read_char();
79  } while (c!=EOLN && c>0 && c<=32);
80 
81  d=c;
82  count=0;
83  while (DIGIT(d)) { count=count*10+(d-'0'); d=read_char(); }
84 
85  while (d!=EOLN && d!=EOF) d=read_char();
86 
87  if (c=='h' || c=='?') {
88  printf("*** [Quit (q), Continue (c), Abort (a), Step (s,RETURN), Trace (t), Help (h,?)]\n");
89  }
90 
91  } while (c=='h' || c=='?');
92 
93  prompt=old_prompt;
94  quietflag=old_quiet; /* 21.1 */
95 
96  switch (c) {
97  case 'v':
98  case 'V':
99  verbose=TRUE;
100  break;
101  case 'q':
102  case 'Q':
103  case EOF:
104  if (c==EOF) printf("\n");
105  exit_life(FALSE);
106  break;
107  case 'a':
108  case 'A':
109  (void)abort_life(FALSE);
110  show_count();
111  break;
112  case 'c':
113  case 'C':
114  trace=FALSE;
115  stepflag=FALSE;
116  break;
117  case 't':
118  case 'T':
119  trace=TRUE;
120  stepflag=FALSE;
121  break;
122  case 's':
123  case 'S':
124  case EOLN:
125  trace=TRUE;
126  stepflag=TRUE;
127  break;
128  case '0': case '1': case '2': case '3': case '4':
129  case '5': case '6': case '7': case '8': case '9':
130  trace=TRUE;
131  stepflag=TRUE;
132  if (count>0) {
133  stepcount=count;
134  stepflag=FALSE;
135  }
136  break;
137  default:
138  goto StartAgain;
139  }
140  input_state=old_state_loc;
142 }
void exit_life(long nl_flag)
exit_life
Definition: built_ins.c:2220
long verbose
Definition: def_glob.h:273
#define DIGIT(C)
Definition: def_macro.h:37
long quietflag
Definition: def_glob.h:271
void show_count()
show_count
Definition: login.c:1161
ptr_psi_term input_state
Definition: def_glob.h:199
long steptrace
Definition: def_glob.h:274
long abort_life(int nlflag)
abort_life
Definition: built_ins.c:2260
long trace
Definition: def_glob.h:272
long stepcount
Definition: def_glob.h:275
#define EOLN
Definition: def_const.h:140
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long stepflag
Definition: def_glob.h:150
void restore_state(ptr_psi_term t)
restore_state
Definition: token.c:334
char * prompt
Definition: def_glob.h:42
long read_char()
read_char
Definition: token.c:680
long interrupted
Definition: interrupt.c:12
void stdin_cleareof()
stdin_cleareof
Definition: token.c:51
long open_input_file(char *file)
open_input_file
Definition: token.c:594
long has_non_alpha ( char *  s)

has_non_alpha

Parameters
char*s

Return TRUE iff s contains a character that is not alphanumeric.

Definition at line 418 of file print.c.

References FALSE, ISALPHA, and TRUE.

419 {
420  while (*s) {
421  if (!ISALPHA(*s)) return TRUE;
422  s++;
423  }
424  return FALSE;
425 }
#define ISALPHA(C)
Definition: def_macro.h:43
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
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
int hash_code ( ptr_hash_table  table,
char *  symbol 
)

HASH_CODE.

Parameters
ptr_hash_tabletable
char*symbol

Return the hash code for a symbol

Definition at line 79 of file hash_table.c.

References rand_array, and wl_hash_table::size.

80 {
81  int n=0;
82 
83  /* printf("code of %s ",symbol); */
84 
85  while(*symbol) {
86  n ^= rand_array[*symbol]+rand_array[n&255];
87  n++;
88  symbol++;
89  }
90 
91  n &= (table->size-1);
92 
93 
94  /* printf("=%d\n",n); */
95 
96  return n;
97 }
long rand_array[256]
Definition: hash_table.c:16
ptr_hash_table hash_create ( int  size)

HASH_CREATE.

Parameters
intsize

Create a hash-table for max size keywords.

Definition at line 25 of file hash_table.c.

References NULL, and wl_hash_table::size.

26 {
27  ptr_hash_table new;
28  int i;
29 
30  new=(ptr_hash_table)malloc(sizeof(struct wl_hash_table));
31  new->size=size;
32  new->used=0;
33  new->data=(ptr_keyword *)malloc(size*sizeof(ptr_keyword));
34  for(i=0;i<size;i++)
35  new->data[i]=NULL;
36  return new;
37 }
#define NULL
Definition: def_const.h:203
struct wl_hash_table * ptr_hash_table
Definition: def_struct.h:68
void hash_display ( ptr_hash_table  table)

HASH_DISPLAY.

Parameters
ptr_hash_tabletable

Display a symbol table (for debugging).

Definition at line 174 of file hash_table.c.

References hash_code().

175 {
176  int i;
177  int n;
178  char *s;
179  int c=0;
180  int t=0;
181 
182  printf("*** Hash table %lx:\n",(long)table);
183  printf("Size: %d\n",table->size);
184  printf("Used: %d\n",table->used);
185 
186  for(i=0;i<table->size;i++)
187  if(table->data[i]) {
188  t++;
189  s=table->data[i]->symbol;
190  n=hash_code(table,s);
191 
192  printf("%4d %4d %s %s\n",
193  i,
194  n,
195  i==n?"ok ":"*bad*",
196  s);
197 
198  if(i!=n)
199  c++;
200  }
201 
202  printf("Really used: %d\n",t);
203  printf("Collisions: %d = %1.3f%%\n",
204  c,
205  100.0*c/(double)t);
206 }
ptr_keyword * data
Definition: def_struct.h:114
char * symbol
Definition: def_struct.h:91
int hash_code(ptr_hash_table table, char *symbol)
HASH_CODE.
Definition: hash_table.c:79
void hash_expand ( ptr_hash_table  table,
int  new_size 
)

HASH_EXPAND.

Parameters
ptr_hash_tabletable
intnew_size

Allocate a bigger hash table.

Definition at line 47 of file hash_table.c.

References wl_hash_table::data, hash_insert(), NULL, wl_hash_table::size, and wl_hash_table::used.

48 {
49  ptr_keyword *old_data;
50  int old_size;
51  int i;
52 
53 
54  old_data=table->data;
55  old_size=table->size;
56 
57  table->size=new_size; /* Must be power of 2 */
58  table->used=0;
59  table->data=(ptr_keyword *)malloc(new_size*sizeof(ptr_keyword));
60 
61  for(i=0;i<new_size;i++)
62  table->data[i]=NULL;
63 
64  for(i=0;i<old_size;i++)
65  if(old_data[i])
66  hash_insert(table,old_data[i]->symbol,old_data[i]);
67 
68  free(old_data);
69 }
ptr_keyword * data
Definition: def_struct.h:114
#define NULL
Definition: def_const.h:203
void hash_insert(ptr_hash_table table, char *symbol, ptr_keyword keyword)
HASH_INSERT.
Definition: hash_table.c:151
int hash_find ( ptr_hash_table  table,
char *  symbol 
)

hash_find

Parameters
ptr_hash_tabletable
char*symbol

Definition at line 106 of file hash_table.c.

References wl_hash_table::data, hash_code(), wl_hash_table::size, and wl_keyword::symbol.

107 {
108  int n;
109  int i=1;
110 
111  n=hash_code(table,symbol);
112 
113  while(table->data[n] && strcmp(table->data[n]->symbol,symbol)) {
114  /* Not a direct hit... */
115  n+= i*i;
116  /* i++; */
117  n &= table->size-1;
118  }
119 
120  return n;
121 }
ptr_keyword * data
Definition: def_struct.h:114
char * symbol
Definition: def_struct.h:91
int hash_code(ptr_hash_table table, char *symbol)
HASH_CODE.
Definition: hash_table.c:79
void hash_insert ( ptr_hash_table  table,
char *  symbol,
ptr_keyword  keyword 
)

HASH_INSERT.

Parameters
ptr_hash_tabletable
char*symbol
ptr_keywordkeyword

Add a symbol and data to a table. Overwrite previous data.

Definition at line 151 of file hash_table.c.

References wl_hash_table::data, hash_expand(), hash_find(), wl_hash_table::size, and wl_hash_table::used.

152 {
153  int n;
154 
155  n=hash_find(table,symbol);
156 
157  /* printf("inserting %s at %d keyword %x\n",symbol,n,keyword); */
158 
159  if(!table->data[n])
160  table->used++;
161  table->data[n]=keyword;
162 
163  if(table->used*2>table->size)
164  hash_expand(table,table->size*2);
165 }
ptr_keyword * data
Definition: def_struct.h:114
int hash_find(ptr_hash_table table, char *symbol)
hash_find
Definition: hash_table.c:106
void hash_expand(ptr_hash_table table, int new_size)
HASH_EXPAND.
Definition: hash_table.c:47
ptr_keyword hash_lookup ( ptr_hash_table  table,
char *  symbol 
)

HASH_LOOKUP.

Parameters
ptr_hash_tabletable
char*symbol

Look up a symbol in the symbol table.

Definition at line 131 of file hash_table.c.

References wl_hash_table::data, and hash_find().

132 {
133  int n;
134 
135  n=hash_find(table,symbol);
136 
137  /* printf("found %s at %d keyword %x\n",symbol,n,table->data[n]); */
138 
139  return table->data[n];
140 }
ptr_keyword * data
Definition: def_struct.h:114
int hash_find(ptr_hash_table table, char *symbol)
hash_find
Definition: hash_table.c:106
void heap_add_int_attr ( ptr_psi_term  t,
char *  attrname,
long  value 
)

heap_add_int_attr

Parameters
ptr_psi_termt
char*attrname
longvalue)

Add an attribute whose value is an integer to a psi-term that does not yet contains this attribute.

Definition at line 74 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_alloc(), heap_copy_string(), heap_insert(), heap_psi_term(), integer, REAL, wl_psi_term::type, and wl_psi_term::value_3.

75 {
76  ptr_psi_term t1;
77 
78  t1=heap_psi_term(4);
79  t1->type=integer;
80  t1->value_3=heap_alloc(sizeof(REAL));
81  *(REAL *)t1->value_3 = (REAL) value;
82 
83  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)t1);
84 }
#define FEATCMP
Definition: def_const.h:257
ptr_psi_term heap_psi_term(long stat)
heap_psi_term
Definition: lefun.c:75
#define REAL
Definition: def_const.h:72
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
ptr_definition integer
Definition: def_glob.h:93
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_node attr_list
Definition: def_struct.h:171
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
void heap_add_psi_attr ( ptr_psi_term  t,
char *  attrname,
ptr_psi_term  g 
)

heap_add_psi_attr

Parameters
ptr_psi_termt
char*attrname
ptr_psi_termg

Attach a psi-term to another as an attribute.

Definition at line 226 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_copy_string(), and heap_insert().

227 {
228  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
229 }
#define FEATCMP
Definition: def_const.h:257
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
void heap_add_str_attr ( ptr_psi_term  t,
char *  attrname,
char *  str 
)

heap_add_str_attr

Parameters
ptr_psi_termt
char*attrname
char*str

Add an attribute whose value is a string to a psi-term that does not yet contains this attribute.

Definition at line 151 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_copy_string(), heap_insert(), heap_psi_term(), quoted_string, wl_psi_term::type, and wl_psi_term::value_3.

152 {
153  ptr_psi_term t1;
154 
155  t1=heap_psi_term(4);
156  t1->type=quoted_string;
157  t1->value_3=(GENERIC)heap_copy_string(str);
158 
159  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
160 }
#define FEATCMP
Definition: def_const.h:257
ptr_psi_term heap_psi_term(long stat)
heap_psi_term
Definition: lefun.c:75
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
ptr_definition quoted_string
Definition: def_glob.h:101
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_node attr_list
Definition: def_struct.h:171
GENERIC heap_alloc ( long  s)

heap_alloc

Parameters
longs

HEAP_ALLOC(s) This returns a pointer to S bytes of memory in the heap. Alignment is taken into account in the following manner: the macro ALIGN is supposed to be a power of 2 and the pointer returned is a multiple of ALIGN.

Definition at line 1616 of file memory.c.

References ALIGN, Errorline(), heap_pointer, and stack_pointer.

1617 {
1618  if (s & (ALIGN-1))
1619  s = s - (s & (ALIGN-1))+ALIGN;
1620  /* assert(s % sizeof(*heap_pointer) == 0); */
1621  s /= sizeof (*heap_pointer);
1622 
1623  heap_pointer -= s;
1624 
1626  Errorline("the heap overflowed into the stack.\n");
1627 
1628  return heap_pointer;
1629 }
void Errorline(char *format,...)
Definition: error.c:414
GENERIC heap_pointer
Definition: def_glob.h:12
GENERIC stack_pointer
Definition: def_glob.h:14
#define ALIGN
Definition: def_const.h:31
ptr_psi_term heap_copy_psi_term ( psi_term  t)

heap_copy_psi_term

Parameters
psi_termt

HEAP_COPY_PSI_TERM(tok) Return the address of a copy of TOK on the HEAP.

Definition at line 226 of file parser.c.

References global_time_stamp, and HEAP_ALLOC.

227 {
228  ptr_psi_term p;
229 
230  p=HEAP_ALLOC(psi_term);
231  (*p)=t;
232 #ifdef TS
233  p->time_stamp=global_time_stamp; /* 9.6 */
234 #endif
235 
236  return p;
237 }
unsigned long global_time_stamp
Definition: login.c:28
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
char * heap_copy_string ( char *  s)

heap_copy_string

Parameters
char*s

HEAP_COPY_STRING(string) Make a copy of the string in the heap, and return a pointer to that. Exceptions: "1" and "2" are unique (and in the heap).

Definition at line 172 of file trees.c.

References heap_ncopy_string().

173 { return heap_ncopy_string(s,strlen(s)); }
char * heap_ncopy_string(char *s, int n)
heap_ncopy_string
Definition: trees.c:150
ptr_node heap_insert ( long  comp,
char *  keystr,
ptr_node tree,
GENERIC  info 
)

heap_insert

Parameters
longcomp
char*keystr
ptr_node*tree
GENERICinfo

HEAP_INSERT(comp,keystr,tree,info) Insert the pointer INFO under the reference KEYSTR in the binary tree TREE stored in the heap. Return the pointer to the node of KEYSTR.

Definition at line 320 of file trees.c.

References FALSE, general_insert(), and HEAP.

321 {
322 
323  return general_insert(comp,keystr,tree,info,HEAP,FALSE,0L);
324 }
#define HEAP
Definition: def_const.h:147
#define FALSE
Definition: def_const.h:128
ptr_node general_insert(long comp, char *keystr, ptr_node *tree, GENERIC info, long heapflag, long copystr, long bkflag)
ptr_node general_insert
Definition: trees.c:224
void heap_insert_copystr ( char *  keystr,
ptr_node tree,
GENERIC  info 
)

heap_insert_copystr

Parameters
char*keystr
ptr_node*tree
GENERICinfo

HEAP_INSERT_COPYSTR(keystr,tree,info) Insert the pointer INFO under the reference string KEYSTR (which is a feature name) in the binary tree TREE. KEYSTR is copied to the heap. A potential additional node allocated to TREE is put on the heap.

Definition at line 284 of file trees.c.

References FEATCMP, general_insert(), HEAP, and TRUE.

285 {
286  (void)general_insert(FEATCMP,keystr,tree,info,HEAP,TRUE,0L);
287 }
#define HEAP
Definition: def_const.h:147
#define FEATCMP
Definition: def_const.h:257
#define TRUE
Definition: def_const.h:127
ptr_node general_insert(long comp, char *keystr, ptr_node *tree, GENERIC info, long heapflag, long copystr, long bkflag)
ptr_node general_insert
Definition: trees.c:224
void heap_mod_int_attr ( ptr_psi_term  t,
char *  attrname,
long  value 
)

heap_mod_int_attr

Parameters
ptr_psi_termt
char*attrname
longvalue

Modify an attribute whose value is an integer to a psi-term that already contains this attribute with another integer value.

Definition at line 116 of file token.c.

References wl_psi_term::attr_list, wl_node::data, FEATCMP, find(), REAL, and wl_psi_term::value_3.

117 {
118  ptr_node n;
119  ptr_psi_term t1;
120 
121  n=find(FEATCMP,attrname,t->attr_list);
122  t1=(ptr_psi_term)n->data;
123  *(REAL *)t1->value_3 = (REAL) value;
124 }
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
#define REAL
Definition: def_const.h:72
GENERIC value_3
Definition: def_struct.h:170
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_node attr_list
Definition: def_struct.h:171
void heap_mod_str_attr ( ptr_psi_term  t,
char *  attrname,
char *  str 
)

heap_mod_str_attr

Parameters
ptr_psi_termt
char*attrname
char*str

Modify an attribute whose value is a string to a psi-term that already contains this attribute with another integer value.

Definition at line 191 of file token.c.

References wl_psi_term::attr_list, wl_node::data, FEATCMP, find(), heap_copy_string(), and wl_psi_term::value_3.

192 {
193  ptr_node n;
194  ptr_psi_term t1;
195 
196  n=find(FEATCMP,attrname,t->attr_list);
197  t1=(ptr_psi_term)n->data;
198  t1->value_3=(GENERIC)heap_copy_string(str);
199 }
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
GENERIC value_3
Definition: def_struct.h:170
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
char * heap_ncopy_string ( char *  s,
int  n 
)

heap_ncopy_string

Parameters
char*s
intn

HEAP_NCOPY_STRING(string,length) Make a copy of the string in the heap, and return a pointer to that. Exceptions: "1" and "2" are unique (and in the heap).

Definition at line 150 of file trees.c.

References heap_alloc(), one, and two.

151 {
152  char *p;
153 
154  if (s==one || s==two) return s;
155 
156  p=(char *)heap_alloc(n+1);
157  strncpy(p,s,n);
158  p[n]='\0';
159 
160  return p;
161 }
char * two
Definition: def_glob.h:251
char * one
Definition: def_glob.h:250
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
char * heap_nice_name ( )

heap_nice_name

Generate a nice-looking new variable name.

Definition at line 63 of file print.c.

References gen_sym_counter, heap_copy_string(), perr(), and STRLEN.

64 {
65  string tmp1,tmp2;
66  char g,len; // ,leading_a;
67 
68  g= ++gen_sym_counter;
69  len=2;
70  strcpy(tmp2,"");
71  do {
72  g--;
73  /* Prefix one character to tmp2: */
74  (void)snprintf(tmp1,2,"%c",g%26+'A');
75  strcat(tmp1,tmp2);
76  strcpy(tmp2,tmp1);
77  g=g/26;
78  len++;
79  } while (g>0 && len<STRLEN);
80  if (len>=STRLEN)
81  perr("Variable name too long -- the universe has ceased to exist.");
82 
83  strcpy(tmp1,"_");
84  strcat(tmp1,tmp2);
85 
86  return heap_copy_string(tmp1);
87 }
void perr(char *str)
Definition: error.c:659
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
long gen_sym_counter
Definition: def_glob.h:30
#define STRLEN
Definition: def_const.h:86
ptr_psi_term heap_psi_term ( long  stat)

heap_psi_term

Parameters
longstat

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

Definition at line 75 of file lefun.c.

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

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

i_check_out

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

Definition at line 1033 of file lefun.c.

References check_func_flag, check_out(), and FALSE.

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

i_eval_args

Parameters
ptr_noden

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

Definition at line 874 of file lefun.c.

References check_func_flag, eval_args(), and FALSE.

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

in_set

Parameters
char*str
longset

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

Definition at line 1316 of file lefun.c.

References FALSE, featcmp(), and TRUE.

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

inc_heap_copy

Parameters
ptr_psi_termt

There is a bug in inc_heap_copy

Definition at line 206 of file copy.c.

References copy(), EXACT_FLAG, to_heap, and TRUE.

207 { to_heap=TRUE; return (copy(t, EXACT_FLAG, TRUE)); }
#define EXACT_FLAG
Definition: def_const.h:325
#define TRUE
Definition: def_const.h:127
ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
copy
Definition: copy.c:248
long to_heap
Definition: def_glob.h:264
void infoline ( char *  format,
  ... 
)

Definition at line 245 of file error.c.

References assert, display_psi(), FALSE, input_file_name, NOTQUIET, parse_ok, perr_i(), perr_s(), print_code(), print_def_type(), print_operator_kind(), and psi_term_line_number.

246 {
247  va_list VarArg;
248  // int l;
249  char buffer_loc[5];
250  char *p;
251  unsigned long lng2;
252  char *cptr;
253  ptr_int_list pil;
254  ptr_psi_term psi;
255  operator kind;
256  def_type t ;
257 
258  va_start(VarArg,format);
259  if (NOTQUIET)
260  {
261 
262  // vinfoline(format, stdout, VarArg);
263  //#define vinfoline(format, outfile, xxxx) {
264  for (p=format;p && *p; p++)
265  {
266  if (*p == '%')
267  {
268  p++;
269  switch (*p)
270  {
271  case 'd':
272  case 'x':
273  buffer_loc[0] = '%';
274  buffer_loc[1] = 'l';
275  buffer_loc[2] = *p;
276  buffer_loc[3] = 0;
277  lng2 = va_arg(VarArg,long);
278  fprintf(stdout, buffer_loc, lng2);
279  break;
280  case 's':
281  buffer_loc[0] = '%';
282  buffer_loc[1] = *p;
283  buffer_loc[2] = 0;
284  cptr = va_arg(VarArg,char *);
285  fprintf(stdout, buffer_loc, cptr);
286  break;
287  case 'C':
288  /* type coding as bin string */
289  pil = va_arg(VarArg,ptr_int_list);
290  print_code(stdout,pil);
291  break;
292  case 'P':
293  psi = va_arg(VarArg,ptr_psi_term);
294  display_psi(stdout,psi);
295  break;
296  case 'O':
297  kind = va_arg(VarArg,operator);
298  print_operator_kind(stdout,kind);
299  break;
300  case 'T':
301  assert(stdout==stderr);
302  t = va_arg(VarArg,def_type);
303  print_def_type(t);
304  break;
305  case 'E':
306  assert(stdout==stderr);
307  perr_i("near line %ld",psi_term_line_number);
308  if (strcmp(input_file_name,"stdin")) {
309  perr_s(" in file 042%s042",input_file_name);
310  }
311  parse_ok=FALSE;
312  break;
313  case '%':
314  (void)putc(*p,stdout);
315  break;
316  default:
317  fprintf(stdout,"<%c follows %% : report bug >", *p);
318  break;
319  }
320  }
321  else
322  (void)putc(*p,stdout);
323  }
324  }
325  va_end(VarArg);
326 }
#define NOTQUIET
Definition: def_macro.h:10
void perr_i(char *str, long i)
Definition: error.c:677
long psi_term_line_number
Definition: def_glob.h:268
string input_file_name
Definition: def_glob.h:40
void display_psi(FILE *s, ptr_psi_term t)
display_psi
Definition: print.c:1579
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
print_code
Definition: print.c:167
void print_def_type(def_type t)
print_def_type
Definition: types.c:24
#define FALSE
Definition: def_const.h:128
long parse_ok
Definition: def_glob.h:171
void print_operator_kind(FILE *s, long kind)
print_operator_kind
Definition: print.c:192
#define assert(N)
Definition: memory.c:113
void inherit_always_check ( )

inherit_always_check

INHERIT_ALWAYS_CHECK() The 'always_check' flag, if false, should be propagated to a sort's children. This routine does a closure on this propagation operation for all declared sorts.

Definition at line 1068 of file types.c.

References FALSE, and one_pass_always_check().

1069 {
1070  long change;
1071 
1072  do {
1073  change=FALSE;
1074  one_pass_always_check(&change);
1075  } while (change);
1076 }
void one_pass_always_check(long *ch)
one_pass_always_check
Definition: types.c:1049
#define FALSE
Definition: def_const.h:128
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()
c_public
Definition: modules.c:687
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()
c_display_modules
Definition: modules.c:739
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()
c_set_module
Definition: modules.c:488
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()
c_open_module
Definition: modules.c:519
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)
update_symbol
Definition: modules.c:270
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()
c_display_persistent
Definition: modules.c:775
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()
insert_sys_builtins
Definition: sys.c:2215
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()
all_public_symbols
Definition: modules.c:1363
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()
c_current_module
Definition: modules.c:974
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()
c_private_feature
Definition: modules.c:1302
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()
c_trace_input
Definition: modules.c:810
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()
c_alias
Definition: modules.c:1180
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()
c_private
Definition: modules.c:714
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()
c_replace
Definition: modules.c:936
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)
set_current_module
Definition: modules.c:100
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
void init_copy ( )

init_copy

INIT_COPY() Execute once upon startup of Wild_Life.

Definition at line 32 of file copy.c.

References HASHSIZE, hashtable, hashtime, numbuckets, and NUMBUCKETS.

33 {
34  long i;
35 
36  /* for(i=0; i<HASHSTATS; i++) hashstats[i]=0; 20.8 */
37 
38  for(i=0; i<HASHSIZE; i++) hashtable[i].timestamp = 0;
39  hashtime = 0;
41  hashbuckets = (struct hashbucket *)
42  malloc(NUMBUCKETS * sizeof(struct hashbucket));
43 }
static struct hashentry hashtable[HASHSIZE]
Definition: copy.c:16
#define NUMBUCKETS
Definition: def_const.h:319
static long numbuckets
Definition: copy.c:20
static long hashtime
Definition: copy.c:18
static struct hashbucket * hashbuckets
Definition: copy.c:17
#define HASHSIZE
Definition: def_const.h:315
void init_global_vars ( )

init_global_vars

INIT_GLOBAL_VARS() Initialize all non-persistent global variables.

Definition at line 1484 of file lefun.c.

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

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

INIT_INTERRUPT.

This initialises interrupts by trapping the interrupt signal and sending it to INTERRUPT.

Definition at line 36 of file interrupt.c.

References interrupt().

37 {
38  void (*f)(); /* RM: Apr 7 1993 Weird problem in GCC and C89 */
39  f=interrupt;
40  if (signal(SIGINT,SIG_IGN)!=SIG_IGN)
41  (void)signal(SIGINT,f);
42 }
void interrupt()
INTERRUPT()
Definition: interrupt.c:21
void init_io ( )

void init_io

I/O initialization

Definition at line 69 of file lib.c.

References buffer, input_state, NULL, output_stream, stdin_state, stdin_terminal, and TRUE.

70 {
71 #ifdef DJD_PORT_FALSE
72  struct stat buffer_loc;
73 
74  fstat(fileno(stdin), &buffer_loc);
75  /* True iff stdin is from a terminal */
76  stdin_terminal=(S_IFCHR & buffer.st_mode)!=0;
79  output_stream=stdout;
80 #else
84  output_stream=stdout;
85 #endif
86 }
ptr_psi_term stdin_state
Definition: def_glob.h:200
long stdin_terminal
Definition: def_glob.h:188
#define NULL
Definition: def_const.h:203
ptr_psi_term input_state
Definition: def_glob.h:199
char * buffer
Definition: def_glob.h:175
#define TRUE
Definition: def_const.h:127
FILE * output_stream
Definition: def_glob.h:41
void init_memory ( )

init_memory ()

INIT_MEMORY() Get two big blocks of memory to work in. The second is only used for the half-space garbage collector. The start and end addresses of the blocks are re-aligned correctly. to allocate.

Definition at line 1671 of file memory.c.

References ALIGNUP, alloc_words, buffer, delta, Errorline(), GetIntOption(), heap_pointer, mem_base, mem_limit, mem_size, other_base, other_limit, other_pointer, PRINT_BUFFER, and stack_pointer.

1672 {
1673  alloc_words=GetIntOption("memory",ALLOC_WORDS);
1674  mem_size=alloc_words*sizeof(long);
1675 
1676  mem_base = (GENERIC) malloc(mem_size);
1677  other_base = (GENERIC) malloc(mem_size);
1678 
1679  if (mem_base && other_base) {
1680  /* Rewrote some rather poor code... RM: Mar 1 1994 */
1681  ALIGNUP(mem_base);
1683 
1684  mem_limit=mem_base+alloc_words-2;
1685  ALIGNUP(mem_limit);
1687 
1690 
1691  other_limit=other_base+alloc_words-2;
1693 
1695  buffer = (char *) malloc (PRINT_BUFFER); /* The printing buffer */
1696 
1697  /* RM: Oct 22 1993 */
1698  /* Fill the memory with rubbish data */
1699  /*
1700  {
1701  int i;
1702 
1703  for(i=0;i<alloc_words;i++) {
1704  mem_base[i]= -1234;
1705  other_base[i]= -1234;
1706  }
1707  }
1708  */
1709  }
1710  else
1711  Errorline("Wild_life could not allocate sufficient memory to run.\n\n");
1712 }
GENERIC mem_limit
Definition: def_glob.h:13
int alloc_words
Definition: def_glob.h:10
static long delta
Definition: memory.c:12
int mem_size
Definition: def_glob.h:9
GENERIC other_base
Definition: def_glob.h:19
GENERIC other_pointer
Definition: def_glob.h:21
void Errorline(char *format,...)
Definition: error.c:414
char * buffer
Definition: def_glob.h:175
#define ALIGNUP(X)
Definition: def_macro.h:294
#define PRINT_BUFFER
Definition: def_const.h:106
GENERIC mem_base
Definition: def_glob.h:11
GENERIC heap_pointer
Definition: def_glob.h:12
GENERIC other_limit
Definition: def_glob.h:20
GENERIC stack_pointer
Definition: def_glob.h:14
int GetIntOption(char *name, int def)
GetIntOption.
Definition: memory.c:78
unsigned long * GENERIC
Definition: def_struct.h:17
void init_modules ( )

init_modules

INIT_MODULES() Initialize the module system.

Definition at line 34 of file modules.c.

References create_module(), and set_current_module().

35 {
36  bi_module=create_module("built_ins");
37  no_module=create_module("no_module");
39  syntax_module=create_module("syntax");
40  user_module=create_module("user"); /* RM: Jan 27 1993 */
42 
44 }
ptr_module user_module
Definition: modules.c:22
ptr_module sys_module
Definition: modules.c:19
ptr_module bi_module
Definition: modules.c:17
ptr_module create_module(char *module)
ptr_module create_module(char *module)
Definition: modules.c:72
ptr_module x_module
Definition: modules.c:23
ptr_module no_module
Definition: modules.c:16
ptr_module set_current_module(ptr_module module)
set_current_module
Definition: modules.c:100
ptr_module syntax_module
Definition: modules.c:18
void init_parse_state ( )

init_parse_state

Initialize the parser/tokenizer state variables.

Definition at line 464 of file token.c.

References eof_flag, FALSE, line_count, NULL, old_saved_char, old_saved_psi_term, saved_char, saved_psi_term, start_of_line, stringparse, and TRUE.

465 {
466  line_count=0;
468  saved_char=0;
469  old_saved_char=0;
472  eof_flag=FALSE;
474 }
long eof_flag
Definition: def_glob.h:196
long start_of_line
Definition: def_glob.h:191
long old_saved_char
Definition: def_glob.h:193
#define NULL
Definition: def_const.h:203
long saved_char
Definition: def_glob.h:192
long line_count
Definition: def_glob.h:39
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
long stringparse
Definition: def_glob.h:202
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
void init_print ( )

init_print

Initialize size of single segment of split printing. Wild_Life integers are represented as REALS, and therefore can have higher precision than the machine integers. They will be printed in segments.

Definition at line 52 of file print.c.

References PRINT_POWER, and seg_format.

53 {
54  (void)snprintf(seg_format,PRINT_POWER+4,"%%0%ldd",PRINT_POWER);
55 }
#define PRINT_POWER
Definition: def_const.h:96
void init_system ( )

init_system

Initial state of system to begin a query

Definition at line 94 of file lib.c.

References choice_stack, current_module, exit_if_true(), FALSE, goal_stack, init_global_vars(), mem_base, memory_check(), wl_module::module_name, NULL, prompt, PROMPT, PROMPT_BUFFER, prompt_buffer, resid_aim, stack_nil(), stack_pointer, undo_stack, user_module, var_tree, x_window_creation, and xevent_list.

95 {
96 #ifdef X11
98 #endif
102  undo_stack=NULL; /* 7.8 */
103  var_tree=NULL;
104 
105  /* RM: Oct 13 1993 */
107  prompt=PROMPT;
108  else {
111  }
112 
113  resid_aim=NULL;
115 
116 #ifdef X11
117  /* RM: Dec 15 1992 */
119 #endif
120 
121  init_global_vars(); /* RM: Feb 15 1993 */
122 }
ptr_goal goal_stack
Definition: def_glob.h:50
ptr_module current_module
Definition: def_glob.h:161
char prompt_buffer[PROMPT_BUFFER]
Definition: def_glob.h:237
ptr_psi_term xevent_list
Definition: def_glob.h:208
ptr_module user_module
Definition: def_glob.h:156
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
#define PROMPT
Definition: def_const.h:109
ptr_goal resid_aim
Definition: def_glob.h:220
long x_window_creation
Definition: def_glob.h:217
ptr_stack undo_stack
Definition: def_glob.h:53
void exit_if_true(long exitflag)
exit_if_true
Definition: lib.c:55
void init_global_vars()
init_global_vars
Definition: lefun.c:1484
#define FALSE
Definition: def_const.h:128
GENERIC mem_base
Definition: def_glob.h:11
ptr_psi_term stack_nil()
stack_nil
Definition: built_ins.c:26
char * module_name
Definition: def_struct.h:75
#define PROMPT_BUFFER
Definition: def_const.h:112
char * prompt
Definition: def_glob.h:42
GENERIC stack_pointer
Definition: def_glob.h:14
long memory_check()
memory_check
Definition: memory.c:1723
ptr_choice_point choice_stack
Definition: def_glob.h:51
void init_trace ( )

Definition at line 587 of file error.c.

References FALSE, stepcount, stepflag, and trace.

588 {
589  trace=FALSE;
590  stepflag=FALSE;
591  stepcount=0;
592 }
#define FALSE
Definition: def_const.h:128
long stepcount
Definition: error.c:22
long trace
Definition: error.c:18
long stepflag
Definition: error.c:20
void insert_dbm_builtins ( )
void insert_math_builtins ( )

insert math builtins into table

insert functions into table

Definition at line 1346 of file bi_math.c.

References bi_module, c_add(), c_bit_and(), c_bit_not(), c_bit_or(), c_ceiling(), c_cos(), c_div(), c_exp(), c_floor(), c_intdiv(), c_log(), c_mod(), c_mult(), c_shift_left(), c_shift_right(), c_sin(), c_sqrt(), c_sub(), c_tan(), function_it, new_built_in(), and syntax_module.

1347 {
1353  new_built_in(syntax_module,"mod",(def_type)function_it,c_mod); /* PVR 24.2.94 */
1367 }
static long c_mult()
multiplication
Definition: bi_math.c:28
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
new_built_in
Definition: built_ins.c:5371
#define function_it
Definition: def_const.h:362
static long c_shift_right()
Definition: bi_math.c:864
static long c_log()
natural logarithm
Definition: bi_math.c:1238
static long c_shift_left()
bitwise shift left
Definition: bi_math.c:853
static long c_sub()
subtraction
Definition: bi_math.c:1132
static long c_bit_not()
bitwise not
Definition: bi_math.c:649
static long c_div()
division
Definition: bi_math.c:138
static long c_floor()
floor
Definition: bi_math.c:479
static long c_intdiv()
integer division
Definition: bi_math.c:264
static long c_bit_or()
bitwise or
Definition: bi_math.c:785
static long c_bit_and()
bitwise and
Definition: bi_math.c:703
static long c_ceiling()
ceiling
Definition: bi_math.c:490
static long c_exp()
exponential
Definition: bi_math.c:1295
static long c_cos()
cosine
Definition: bi_math.c:617
ptr_module syntax_module
Definition: def_glob.h:159
static long c_sin()
sin Return the sine of the argument
Definition: bi_math.c:627
static long c_add()
addition
Definition: bi_math.c:1016
ptr_module bi_module
Definition: def_glob.h:155
static long c_sqrt()
square root
Definition: bi_math.c:501
static long c_tan()
tangent
Definition: bi_math.c:638
static long c_mod()
modulo
Definition: bi_math.c:945
void insert_own_prop ( ptr_definition  d)

insert_own_prop

Parameters
ptr_definitiond

INSERT_OWN_PROP(definition) Append a type's "rules" (i.e. its own attr. & constr.) to its property list. The property list also contains the type's code. A type's attributes and constraints are stored in the 'rule' field of the definition.

Definition at line 575 of file types.c.

References wl_pair_list::aaaa_2, wl_pair_list::bbbb_2, children, FALSE, HEAP_ALLOC, wl_int_list::next, wl_definition::next, wl_pair_list::next, NULL, wl_definition::properties, wl_definition::rule, TRUE, and wl_int_list::value_1.

576 {
577  ptr_int_list l;
578  ptr_pair_list rule;
579  ptr_triple_list *t;
580  long flag;
581 
582  l=HEAP_ALLOC(int_list);
583  l->value_1=(GENERIC)d;
584  l->next=children;
585  children=l;
586 
587  rule = d->rule;
588  while (rule) {
589  t= &(d->properties);
590  flag=TRUE;
591 
592  while (flag) {
593  if (*t)
594  if ((*t)->aaaa_4==rule->aaaa_2 && (*t)->bbbb_4==rule->bbbb_2 && (*t)->cccc_4==d)
595  flag=FALSE;
596  else
597  t= &((*t)->next);
598  else {
599  *t = HEAP_ALLOC(triple_list);
600  (*t)->aaaa_4=rule->aaaa_2;
601  (*t)->bbbb_4=rule->bbbb_2;
602  (*t)->cccc_4=d;
603  (*t)->next=NULL;
604  flag=FALSE;
605  }
606  }
607  rule=rule->next;
608  }
609 }
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
ptr_definition next
Definition: def_struct.h:148
#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_int_list children
Definition: def_glob.h:354
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_triple_list properties
Definition: def_struct.h:127
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
void insert_prop ( ptr_definition  d,
ptr_triple_list  prop 
)

insert_prop

Parameters
ptr_definitiond
ptr_triple_listprop

INSERT_PROP(definition,prop) Append the properties to the definition if they aren't already present.

Definition at line 620 of file types.c.

References wl_triple_list::aaaa_4, wl_triple_list::bbbb_4, wl_triple_list::cccc_4, children, FALSE, HEAP_ALLOC, wl_int_list::next, wl_definition::next, wl_triple_list::next, NULL, wl_definition::properties, TRUE, and wl_int_list::value_1.

621 {
622  ptr_int_list l;
623  ptr_triple_list *t;
624  long flag;
625 
626  l=HEAP_ALLOC(int_list);
627  l->value_1=(GENERIC)d;
628  l->next=children;
629  children=l;
630 
631  while (prop) {
632  t= &(d->properties);
633  flag=TRUE;
634 
635  while (flag) {
636  if (*t)
637  if ((*t)->aaaa_4==prop->aaaa_4 && (*t)->bbbb_4==prop->bbbb_4 && (*t)->cccc_4==prop->cccc_4)
638  flag=FALSE;
639  else
640  t= &((*t)->next);
641  else {
642  *t = HEAP_ALLOC(triple_list);
643  (*t)->aaaa_4=prop->aaaa_4;
644  (*t)->bbbb_4=prop->bbbb_4;
645  (*t)->cccc_4=prop->cccc_4;
646  (*t)->next=NULL;
647  flag=FALSE;
648  }
649  }
650  prop=prop->next;
651  }
652 }
#define NULL
Definition: def_const.h:203
ptr_triple_list next
Definition: def_struct.h:199
ptr_definition cccc_4
Definition: def_struct.h:198
ptr_definition next
Definition: def_struct.h:148
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_psi_term bbbb_4
Definition: def_struct.h:197
ptr_int_list children
Definition: def_glob.h:354
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_triple_list properties
Definition: def_struct.h:127
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_psi_term aaaa_4
Definition: def_struct.h:196
ptr_int_list next
Definition: def_struct.h:55
void insert_sys_builtins ( )

insert_sys_builtins

Definition at line 2215 of file sys.c.

References bi_module, c_accept(), c_apply1(), c_bind(), c_bitvector_and(), c_bitvector_clear(), c_bitvector_count(), c_bitvector_get(), c_bitvector_not(), c_bitvector_or(), c_bitvector_set(), c_bitvector_xor(), c_call_once(), c_connect(), c_cuserid(), c_errmsg(), c_errno(), c_fclose(), c_fflush(), c_fopen(), c_fork(), c_fseek(), c_ftell(), c_fwrite(), c_get_buffer(), c_get_code(), c_get_record(), c_gethostname(), c_getpid(), c_import_symbol(), c_int2stream(), c_kill(), c_lazy_project(), c_listen(), c_make_bitvector(), c_my_wait_on_feature(), c_regexp_compile(), c_regexp_execute(), c_socket(), c_stream2sys_stream(), c_sys_stream2stream(), c_wait(), c_wait_on_feature(), c_waitpid(), current_module, function_it, insert_dbm_builtins(), new_built_in(), predicate, set_current_module(), sys_bitvector, sys_bytedata, sys_file_stream, sys_module, sys_regexp, sys_socket_stream, sys_stream, and update_symbol().

2216 {
2217  ptr_module curmod = current_module;
2219 
2220  sys_bytedata =update_symbol(sys_module,"bytedata"); /* DENYS: BYTEDATA */
2221  sys_bitvector =update_symbol(sys_module,"bitvector");
2222  sys_regexp =update_symbol(sys_module,"regexp");
2223  sys_stream =update_symbol(sys_module,"stream");
2224  sys_file_stream =update_symbol(sys_module,"file_stream");
2225  sys_socket_stream =update_symbol(sys_module,"socket_stream");
2226  sys_process_no_children=update_symbol(sys_module,"process_no_children");
2227  sys_process_exited =update_symbol(sys_module,"process_exited");
2228  sys_process_signaled =update_symbol(sys_module,"process_signaled");
2229  sys_process_stopped =update_symbol(sys_module,"process_stopped");
2230  sys_process_continued =update_symbol(sys_module,"process_continued");
2231 
2232  /* DENYS: BYTEDATA */
2233  /* purely for illustration
2234  new_built_in(sys_module,"string_to_bytedata",(def_type)function_it,c_string_to_bytedata);
2235  new_built_in(sys_module,"bytedata_to_string",(def_type)function_it,c_bytedata_to_string);
2236  */
2279 #ifdef LIFE_DBM
2281 #endif
2282 #ifdef LIFE_NDBM
2283  insert_ndbm_builtins();
2284 #endif
2287  (void)set_current_module(curmod);
2288 }
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
new_built_in
Definition: built_ins.c:5371
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
ptr_definition sys_regexp
Definition: def_glob.h:131
static long c_make_bitvector()
c_make_bitvector
Definition: sys.c:174
static long c_bitvector_not()
c_bitvector_not
Definition: sys.c:366
static long c_wait()
c_wait
Definition: sys.c:1788
ptr_module current_module
Definition: def_glob.h:161
static long c_accept()
c_accept
Definition: sys.c:1503
static long c_fwrite()
c_fwrite
Definition: sys.c:819
static long c_call_once()
c_call_once
Definition: sys.c:2090
static long c_stream2sys_stream()
c_stream2sys_stream
Definition: sys.c:1214
static long c_ftell()
c_ftell
Definition: sys.c:1144
static long c_regexp_compile()
c_regexp_compile
Definition: sys.c:554
static long c_int2stream()
c_int2stream
Definition: sys.c:723
static long c_kill()
c_kill
Definition: sys.c:1841
ptr_definition sys_file_stream
Definition: def_glob.h:133
static long c_fseek()
c_fseek
Definition: sys.c:1185
static long c_get_record()
c_get_record
Definition: sys.c:1083
ptr_definition sys_stream
Definition: def_glob.h:132
static long c_getpid()
c_getpid
Definition: sys.c:2163
static long c_get_code()
c_get_code
Definition: sys.c:1113
static long c_bitvector_set()
c_bitvector_set
Definition: sys.c:472
static long c_fclose()
c_fclose
Definition: sys.c:787
ptr_definition update_symbol(ptr_module module, char *symbol)
update_symbol
Definition: modules.c:270
static long c_apply1()
c_apply1()
Definition: sys.c:2136
static long c_bitvector_xor()
c_bitvector_xor
Definition: sys.c:281
static long c_fflush()
c_fflush
Definition: sys.c:849
static long c_fopen()
c_fopen
Definition: sys.c:758
static long c_connect()
c_connect
Definition: sys.c:1434
static long c_listen()
c_listen
Definition: sys.c:1460
static long c_import_symbol()
c_import_symbol
Definition: sys.c:1624
static long c_waitpid()
c_waitpid
Definition: sys.c:1814
ptr_definition sys_process_signaled
Definition: sys.c:1716
ptr_definition sys_bitvector
Definition: def_glob.h:130
static long c_fork()
c_fork
Definition: sys.c:1655
ptr_definition sys_process_stopped
Definition: sys.c:1717
ptr_definition sys_process_continued
Definition: sys.c:1718
static long c_bitvector_count()
c_bitvector_count
Definition: sys.c:376
void insert_dbm_builtins()
static long c_wait_on_feature()
c_wait_on_feature
Definition: sys.c:2001
static long c_bind()
c_bind
Definition: sys.c:1419
static long c_errno()
c_errno
Definition: sys.c:1532
static long c_regexp_execute()
c_regexp_execute
Definition: sys.c:648
ptr_module sys_module
Definition: def_glob.h:162
static long c_cuserid()
c_cuserid
Definition: sys.c:1875
static long c_bitvector_or()
c_bitvector_or
Definition: sys.c:271
static long c_socket()
c_socket
Definition: sys.c:1319
ptr_definition sys_bytedata
Definition: def_glob.h:336
ptr_definition sys_socket_stream
Definition: def_glob.h:134
ptr_definition sys_process_exited
Definition: sys.c:1715
static long c_bitvector_and()
c_bitvector_and
Definition: sys.c:261
static long c_lazy_project()
c_lazy_project
Definition: sys.c:1953
static long c_my_wait_on_feature()
c_my_wait_on_feature
Definition: sys.c:2049
static long c_bitvector_get()
c_bitvector_get
Definition: sys.c:462
static long c_bitvector_clear()
c_bitvector_clear
Definition: sys.c:482
ptr_module bi_module
Definition: def_glob.h:155
static long c_sys_stream2stream()
c_sys_stream2stream
Definition: sys.c:1244
static long c_gethostname()
c_gethostname
Definition: sys.c:1907
ptr_module set_current_module(ptr_module module)
set_current_module
Definition: modules.c:100
static long c_get_buffer()
c_get_buffer
Definition: sys.c:885
ptr_definition sys_process_no_children
Definition: sys.c:1714
static long c_errmsg()
c_errmsg
Definition: sys.c:1564
void insert_system_builtins ( )

insert_system_builtins

Definition at line 744 of file bi_sys.c.

References bi_module, c_cputime(), c_encode(), c_garbage(), c_getenv(), c_localtime(), c_maxint(), c_mresiduate(), c_quiet(), c_realtime(), c_residList(), c_residuate(), c_statistics(), c_step(), c_system(), c_tprove(), c_trace(), c_verbose(), c_warning(), function_it, new_built_in(), and predicate.

745 {
752  new_built_in(bi_module,"quiet",(def_type)function_it,c_quiet); /* 21.1 */
764 }
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_mresiduate()
c_mresiduate
Definition: bi_sys.c:696
static long c_garbage()
force garbage collection
Definition: bi_sys.c:343
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
static long c_step()
toggle trace single step
Definition: bi_sys.c:98
static long c_realtime()
real time since 00:00:00 GMT, January 1, 1970
Definition: bi_sys.c:236
static long c_verbose()
toggle verbose flag
Definition: bi_sys.c:115
static long c_residuate()
c_residuate
Definition: bi_sys.c:662
static long c_getenv()
get value environment variable
Definition: bi_sys.c:360
long c_trace()
trace
Definition: bi_sys.c:30
static long c_warning()
toggle warning flag
Definition: bi_sys.c:136
static long c_system()
pass string to system to execute
Definition: bi_sys.c:400
static long c_cputime()
cpu time used
Definition: bi_sys.c:207
static long c_residList()
c_residList()
Definition: bi_sys.c:611
static long c_encode()
encode type
Definition: bi_sys.c:449
static long c_localtime()
localtime
Definition: bi_sys.c:269
ptr_module bi_module
Definition: def_glob.h:155
static long c_maxint()
return greatest exact integer
Definition: bi_sys.c:157
static long c_statistics()
wild_life stats
Definition: bi_sys.c:306
long c_tprove()
UNSURE.
Definition: bi_sys.c:81
long c_quiet()
Definition: bi_sys.c:186
void insert_translation ( ptr_psi_term  a,
ptr_psi_term  b,
long  info 
)

insert_translation

void insert_translation(ptr_psi_term a,ptr_psi_term b,long info) INSERT_TRANSLATION(a,b,info) Add the translation of address A to address B in the translation table. Also add an info field.

Definition at line 67 of file copy.c.

References hashentry::bucketindex, HASH, hashbuckets, HASHEND, hashfree, hashtable, hashtime, hashbucket::info, hashbucket::new_value, hashbucket::next, numbuckets, hashbucket::old_value, hashentry::timestamp, and traceline().

68 {
69  long index;
70  long lastbucket;
71 
72  /* Ensure there are free buckets by doubling their number if necessary */
73  if (hashfree >= numbuckets) {
74  numbuckets *= 2;
75  hashbuckets = (struct hashbucket *)
76  realloc((void *) hashbuckets, numbuckets * sizeof(struct hashbucket));
77  /* *** Do error handling here *** */
78  traceline("doubled the number of hashbuckets to %d\n", numbuckets);
79  }
80 
81  /* Add a bucket to the beginning of the list */
82  index = HASH(a);
83  if (hashtable[index].timestamp == hashtime)
84  lastbucket = hashtable[index].bucketindex;
85  else {
86  lastbucket = HASHEND;
87  hashtable[index].timestamp = hashtime;
88  }
93  hashbuckets[hashfree].next = lastbucket;
94  hashfree++;
95 }
static struct hashentry hashtable[HASHSIZE]
Definition: copy.c:16
static long hashfree
Definition: copy.c:19
static long numbuckets
Definition: copy.c:20
#define HASHEND
Definition: def_const.h:322
ptr_psi_term old_value
Definition: def_struct.h:385
static long hashtime
Definition: copy.c:18
void traceline(char *format,...)
Definition: error.c:157
ptr_psi_term new_value
Definition: def_struct.h:386
long timestamp
Definition: def_struct.h:392
static struct hashbucket * hashbuckets
Definition: copy.c:17
long bucketindex
Definition: def_struct.h:393
#define HASH(A)
Definition: def_macro.h:273
void insert_type_builtins ( )

void insert_type_builtins

Definition at line 820 of file bi_type.c.

References bi_module, c_children(), c_glb(), c_is_function(), c_is_number(), c_is_persistent(), c_is_predicate(), c_is_sort(), c_is_value(), c_isa_cmp(), c_isa_eq(), c_isa_ge(), c_isa_gt(), c_isa_le(), c_isa_lt(), c_isa_ncmp(), c_isa_neq(), c_isa_nge(), c_isa_ngt(), c_isa_nle(), c_isa_nlt(), c_isa_subsort(), c_lub(), c_parents(), c_smallest(), function_it, new_built_in(), predicate, and syntax_module.

821 {
822  /* Sort comparisons */
835 
836 
837  /* Type checks */
844 
845  /* Sort hierarchy maneuvering */
852 }
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_isa_cmp()
c_isa_cmp
Definition: bi_type.c:466
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
static long c_smallest()
c_smallest
Definition: bi_type.c:159
long c_lub()
long c_lub
Definition: bi_type.c:775
static long c_is_number()
static long c_is_number
Definition: bi_type.c:632
static long c_is_predicate()
c_is_predicate
Definition: bi_type.c:548
static long c_isa_lt()
c_isa_lt
Definition: bi_type.c:337
static long c_isa_ncmp()
c_isa_ncmp
Definition: bi_type.c:475
long c_glb()
long c_glb
Definition: bi_type.c:708
static long c_children()
Return a list of roots of the children types of T (except bottom).
Definition: bi_type.c:30
static long c_isa_nle()
c_isa_nle
Definition: bi_type.c:397
static long c_isa_ge()
c_isa_ge
Definition: bi_type.c:352
long c_isa_subsort()
long c_isa_subsort
Definition: bi_type.c:661
static long c_isa_nlt()
c_isa_nlt
Definition: bi_type.c:412
static long c_isa_ngt()
c_isa_ngt
Definition: bi_type.c:442
static long c_isa_gt()
c_isa_gt
Definition: bi_type.c:367
ptr_module syntax_module
Definition: def_glob.h:159
static long c_is_value()
c_is_value
Definition: bi_type.c:606
static long c_isa_nge()
c_isa_nge
Definition: bi_type.c:427
static long c_parents()
Return a list of roots of the parent types of T.
Definition: bi_type.c:96
static long c_is_sort()
c_is_sort
Definition: bi_type.c:576
static long c_is_function()
c_is_function
Definition: bi_type.c:488
static long c_isa_eq()
c_isa_eq
Definition: bi_type.c:382
ptr_module bi_module
Definition: def_glob.h:155
static long c_isa_le()
c_isa_le
Definition: bi_type.c:322
static long c_is_persistent()
c_is_persistent
Definition: bi_type.c:516
static long c_isa_neq()
c_isa_neq
Definition: bi_type.c:457
void insert_variables ( ptr_node  vars,
long  force 
)

insert_variables

Parameters
ptr_nodevars
longforce

INSERT_VARIABLES(vars,force) This routine gives the name of the query variable to the corresponding pointer in the POINTER_NAMES. If FORCE is TRUE then variables will be printed as TAGS, even if not referred to elsewhere.

Definition at line 308 of file print.c.

References wl_node::data, deref_ptr, find(), INTCMP, wl_node::key, wl_node::left, pointer_names, and wl_node::right.

309 {
310  ptr_psi_term p;
311  ptr_node n;
312 
313  if(vars) {
314  insert_variables(vars->right,force);
315  p=(ptr_psi_term )vars->data;
316  deref_ptr(p);
317  n=find(INTCMP,(char *)p,pointer_names);
318  if (n)
319  if (n->data || force)
320  n->data=(GENERIC)vars->key;
321  insert_variables(vars->left,force);
322  }
323 }
#define INTCMP
Definition: def_const.h:256
GENERIC data
Definition: def_struct.h:185
ptr_node pointer_names
Definition: def_glob.h:29
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
char * key
Definition: def_struct.h:182
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node right
Definition: def_struct.h:184
long int_div_warning ( ptr_psi_term  arg,
REAL  val 
)

Definition at line 845 of file error.c.

References nonint_warning().

848 {
849  return nonint_warning(arg,val,"of integer division is not an integer");
850 }
long nonint_warning(ptr_psi_term arg, REAL val, char *msg)
Definition: error.c:810
long intcmp ( long  a,
long  b 
)

intcmp

Parameters
longa
longb

INTCMP(a,b) Compares two integers, for use in FIND or INSERT.

Definition at line 21 of file trees.c.

22 {
23 #ifdef CMPDBG
24  printf("intcmp a = %ld b = %ld a - b = %ld\n", a ,b , a - b);
25 #endif
26  return a - b;
27 }
void interrupt ( )

INTERRUPT()

This routine is called whenever the user types CONTROL C which generates an interrupt. The interrupt is dealt with later, when convenient, or ignored.

Definition at line 21 of file interrupt.c.

References interrupted, and TRUE.

22 {
23  void (*f)(); /* RM: Apr 7 1993 Weird problem in GCC and C89 */
24 
26  f=interrupt;
27  (void)signal(SIGINT,f);/* RM: Feb 15 1993 */
28 }
void interrupt()
INTERRUPT()
Definition: interrupt.c:21
#define TRUE
Definition: def_const.h:127
long interrupted
Definition: interrupt.c:12
GENERIC intListNext ( ptr_int_list  p)

return p->next

Parameters
ptr_int_listp

not sure purpose (DJD ???)

Definition at line 515 of file bi_sys.c.

References wl_int_list::next.

516 {
517  return (GENERIC )(p->next);
518 }
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list next
Definition: def_struct.h:55
ptr_psi_term intListValue ( ptr_int_list  p)

make psi term from ptr_int_list [->value_1]

Parameters
ptr_int_listp

not sure purpose (DJD ???)

Definition at line 503 of file bi_sys.c.

References makePsiTerm(), and wl_int_list::value_1.

504 {
505  return makePsiTerm((void *)p->value_1);
506 }
ptr_psi_term makePsiTerm(ptr_definition x)
Definition: bi_sys.c:572
GENERIC value_1
Definition: def_struct.h:54
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
long is_int ( char **  s,
long *  len,
long *  sgn 
)

is_int

Parameters
char**s
long*len
long*sgn

Return TRUE iff the string s represents an integer. Modify s to point to first non-zero digit. Return number of significant digits in the integer and its sign.

Definition at line 41 of file trees.c.

References FALSE, and TRUE.

42 {
43  char *sint; /* Ptr to first non-zero digit */
44  char *stmp; /* Scratchpad for string ptr */
45 #ifdef CMPDBG
46  printf("is_int *s = %s\n",*s);
47 #endif
48  /*
49  { register char *p= *s;
50  register char c= *p;
51  if(c>'0' && c<='9' && *(p+1)==0) return TRUE;
52  }
53  */
54 
55  stmp=(*s);
56  if ((*sgn=(*stmp=='-'))) {
57  stmp++;
58  if (!*stmp)
59  {
60 #ifdef CMPDBG
61  printf("is_int = FALSE\n");
62 #endif
63  return FALSE;
64  }
65  }
66  if (!*stmp)
67  {
68 #ifdef CMPDBG
69  printf("is_int = FALSE\n");
70 #endif
71  return FALSE; /* 6.10 */
72  }
73  while (*stmp=='0') stmp++;
74  sint=stmp;
75  while (*stmp) {
76  if (*stmp<'0' || *stmp>'9')
77  {
78 #ifdef CMPDBG
79  printf("is_int = FALSE\n");
80 #endif
81  return FALSE;
82  }
83  stmp++;
84  }
85  *len=stmp-sint;
86  *s=sint;
87 #ifdef CMPDBG
88  printf("is_int = TRUE *len = %ld *sgn = %ld *s = %s\n",*len,*sgn,*s);
89 #endif
90  return TRUE;
91 }
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long is_integer ( char *  s)

is_integer

Parameters
char*s

Return TRUE if s represents an integer.

Definition at line 450 of file print.c.

References DIGIT, FALSE, and TRUE.

451 {
452  if (!*s) return FALSE;
453  if (*s=='-') s++;
454  while (*s) {
455  if (!DIGIT(*s)) return FALSE;
456  s++;
457  }
458  return TRUE;
459 }
#define DIGIT(C)
Definition: def_macro.h:37
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
int is_ipaddr ( char *  s)

is_ipaddr

Parameters
char*s

Definition at line 1333 of file sys.c.

References NULL.

1334 {
1335  if (s==NULL) return 0;
1336  while (*s)
1337  if (!isdigit(*s) && *s!='.') return 0;
1338  else s++;
1339  return 1;
1340 }
#define NULL
Definition: def_const.h:203
int isSubTypeValue ( ptr_psi_term  arg1,
ptr_psi_term  arg2 
)

isSubTypeValue

Parameters
ptr_psi_termarg1
ptr_psi_termarg2

Definition at line 180 of file bi_type.c.

References FALSE, integer, quoted_string, REAL, real, TRUE, wl_psi_term::type, and wl_psi_term::value_3.

181 {
182  long ans=TRUE;
183 
184  /* we already know that either arg1->type == arg2->type or that at both
185  * of the two are either long or real
186  */
187 
188  if (arg2->value_3) {
189  if (arg1->value_3) {
190  if (arg1->type==real || arg1->type==integer) {
191  ans=( *(REAL *)arg1->value_3 == *(REAL *)arg2->value_3);
192  }
193  else if (arg1->type==quoted_string) {
194  ans=(strcmp((char *)arg1->value_3,(char *)arg2->value_3)==0);
195  }
196  }
197  else
198  ans=FALSE;
199  }
200  else {
201  if (arg1->value_3 && (arg1->type==real || arg1->type==integer)) {
202  if (arg2->type==integer)
203  ans=(*(REAL *)arg1->value_3 == floor(*(REAL *)arg1->value_3));
204  else
205  ans=TRUE;
206  }
207  }
208  return ans;
209 }
#define REAL
Definition: def_const.h:72
ptr_definition real
Definition: def_glob.h:102
#define TRUE
Definition: def_const.h:127
ptr_definition integer
Definition: def_glob.h:93
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
long isValue ( ptr_psi_term  p)

isValue(p)

Parameters
ptr_psi_termp

Definition at line 691 of file bi_type.c.

References NULL, and wl_psi_term::value_3.

692 {
693  return (p->value_3 != NULL);
694 }
#define NULL
Definition: def_const.h:203
GENERIC value_3
Definition: def_struct.h:170
void least_sorts ( )

void least_sorts()

LEAST_SORTS() Build the list of terminals (i.e. sorts with no children) in nothing->parents.

Definition at line 743 of file types.c.

References wl_definition::children, cons(), first_definition, wl_definition::next, nothing, NULL, wl_definition::parents, wl_definition::type_def, and type_it.

744 {
745  ptr_definition d;
746 
747  for(d=first_definition;d;d=d->next)
748  if (d->type_def==(def_type)type_it && d->children==NULL && d!=nothing)
750 }
def_type type_def
Definition: def_struct.h:133
ptr_int_list cons(GENERIC v, ptr_int_list l)
cons
Definition: types.c:179
#define NULL
Definition: def_const.h:203
#define type_it
Definition: def_const.h:363
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_definition nothing
Definition: def_glob.h:98
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list children
Definition: def_struct.h:131
ptr_int_list parents
Definition: def_struct.h:130
long legal_in_name ( long  c)

legal_in_name

Parameters
longc

LEGAL_IN_NAME(character) Tests if character is legal in a name or a variable (see macros).

Definition at line 980 of file token.c.

References DIGIT, LOWER, and UPPER.

981 {
982  return
983  UPPER(c) ||
984  LOWER(c) ||
985  DIGIT(c);
986 
987  /* || c=='\'' RM: Dec 16 1992 */ ;
988 }
#define UPPER(C)
Definition: def_macro.h:39
#define DIGIT(C)
Definition: def_macro.h:37
#define LOWER(C)
Definition: def_macro.h:41
void List_Append ( RefListHeader  header,
Ref  atom 
)

void List_Append

Parameters
RefListHeaderheader
Refatom

Definition at line 71 of file list.c.

References wl_ListHeader::First, wl_ListHeader::GetLinks, wl_ListHeader::Last, and NULL.

72 {
73  RefListGetLinksProc getLinks = header->GetLinks;
74 
75  /* Link to the end of list */
76 
77  if (header->Last != NULL)
78  (*getLinks)(header->Last)->Next = atom;
79 
80  else /* The list is empty */
81  header->First = atom;
82 
83  /* Update links of atom to insert */
84 
85  (*getLinks)(atom)->Prev = header->Last;
86  (*getLinks)(atom)->Next = NULL;
87 
88  /* Update last element of header */
89 
90  header->Last = atom;
91 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
#define NULL
Definition: def_const.h:203
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
long List_Card ( RefListHeader  header)

List_Card.

Parameters
RefListHeaderheader

Definition at line 461 of file list.c.

References List_CountAtom(), and List_Enum().

462 {
463  long n = 0;
464 
465  (void)List_Enum (header,(RefListEnumProc) List_CountAtom, &n);
466  return n;
467 }
int(* RefListEnumProc)()
Definition: def_struct.h:262
static long List_CountAtom(Ref p, Ref nbR)
List_CountAtom.
Definition: list.c:446
long List_Enum(RefListHeader header, RefListEnumProc proc, Ref closure)
List_Enum.
Definition: list.c:379
void List_Concat ( RefListHeader  header1,
RefListHeader  header2 
)

List_Concat.

Parameters
RefListHeaderheader1
RefListHeaderheader2

Definition at line 308 of file list.c.

References wl_ListHeader::First, wl_ListHeader::GetLinks, wl_ListHeader::Last, and NULL.

309 {
310  RefListGetLinksProc getLinks = header1->GetLinks;
311 
312  if (header1->GetLinks == header2->GetLinks)
313  {
314 #ifdef prlDEBUG
315  OS_PrintMessage ("List_Concat: ERROR concat different lists\n");
316 #endif
317  return;
318  }
319 
320  /* Concatenate only if the second list is not empty */
321 
322  if (header2->First != NULL)
323  {
324  /* Obvious concatenate when the first list is empty */
325 
326  if (header1->First == NULL)
327  header1->First = header2->First;
328 
329  else /* Concatenate the two non empty lists */
330  {
331  (*getLinks)(header1->Last)->Next = header2->First;
332  (*getLinks)(header2->First)->Prev = header1->Last;
333  }
334  header1->Last = header2->Last;
335  }
336 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
#define NULL
Definition: def_const.h:203
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
void List_Cut ( RefListHeader  header,
Ref  atom,
RefListHeader  newHeader 
)

List_Cut.

Parameters
RefListHeaderheader
Refatom
RefListHeadernewHeader

Definition at line 488 of file list.c.

References wl_ListHeader::First, wl_ListHeader::GetLinks, wl_ListHeader::Last, List_Last, List_Next, and NULL.

489 {
490  RefListGetLinksProc getLinks = header->GetLinks;
491 
492  if (atom != List_Last (header))
493  {
494  newHeader->First = List_Next (header, atom);
495  newHeader->Last = header->Last;
496 
497  header->Last = atom;
498 
499  /* Update the links */
500  (*getLinks)(atom)->Next = NULL;
501  (*getLinks)(newHeader->First)->Prev = NULL;
502  }
503 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
#define NULL
Definition: def_const.h:203
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
#define List_Next(header, RefAtom)
Definition: def_macro.h:156
#define List_Last(header)
Definition: def_macro.h:155
long List_Enum ( RefListHeader  header,
RefListEnumProc  proc,
Ref  closure 
)

List_Enum.

Parameters
RefListHeaderheader
RefListEnumProcproc
Refclosure

Definition at line 379 of file list.c.

References wl_ListHeader::First, and List_EnumFrom().

388 {
389  return (List_EnumFrom (header, header->First, proc, closure));
390 }
long List_EnumFrom(RefListHeader header, Ref atom, RefListEnumProc proc, Ref closure)
List_EnumFrom.
Definition: list.c:347
long List_EnumBack ( RefListHeader  header,
RefListEnumProc  proc,
Ref  closure 
)

List_EnumBack.

Parameters
RefListHeaderheader
RefListEnumProcproc
Refclosure

Definition at line 433 of file list.c.

References wl_ListHeader::Last, and List_EnumBackFrom().

434 {
435  return (List_EnumBackFrom (header, header->Last, proc, closure));
436 }
long List_EnumBackFrom(RefListHeader header, Ref atom, RefListEnumProc proc, Ref closure)
List_EnumBackFrom.
Definition: list.c:401
long List_EnumBackFrom ( RefListHeader  header,
Ref  atom,
RefListEnumProc  proc,
Ref  closure 
)

List_EnumBackFrom.

Parameters
RefListHeaderheader
Refatom
RefListEnumProcproc
Refclosure)

Definition at line 401 of file list.c.

References List_Prev, NULL, and TRUE.

402 {
403  Ref cur, prev;
404  int notInterrupted = TRUE;
405 
406 #ifdef prlDEBUG
407  header->Lock += 1;
408 #endif
409 
410  cur = atom;
411  while (cur != NULL && notInterrupted)
412  {
413  prev = List_Prev (header, cur);
414  notInterrupted = (*proc)(cur, closure);
415  cur = prev;
416  }
417 
418 #ifdef prlDEBUG
419  header->Lock -=1;
420 #endif
421 
422  return (notInterrupted);
423 }
#define List_Prev(header, RefAtom)
Definition: def_macro.h:157
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
void * Ref
Definition: def_struct.h:258
long List_EnumFrom ( RefListHeader  header,
Ref  atom,
RefListEnumProc  proc,
Ref  closure 
)

List_EnumFrom.

Parameters
RefListHeaderheader
Refatom
RefListEnumProcproc
Refclosure

Definition at line 347 of file list.c.

References List_Next, NULL, and TRUE.

348 {
349  Ref cur, next;
350  int notInterrupted = TRUE;
351 
352 #ifdef prlDEBUG
353  header->Lock += 1;
354 #endif
355 
356  cur = atom;
357  while (cur != NULL && notInterrupted)
358  {
359  next = List_Next (header, cur);
360  notInterrupted = (*proc)(cur, closure);
361  cur = next;
362  }
363 
364 #ifdef prlDEBUG
365  header->Lock -=1;
366 #endif
367 
368  return (notInterrupted);
369 }
#define NULL
Definition: def_const.h:203
#define List_Next(header, RefAtom)
Definition: def_macro.h:156
#define TRUE
Definition: def_const.h:127
void * Ref
Definition: def_struct.h:258
void List_InsertAfter ( RefListHeader  header,
Ref  atom,
Ref  mark 
)

List_InsertAfter.

Parameters
RefListHeaderheader
Refatom
Refmark)

Definition at line 134 of file list.c.

References wl_ListHeader::GetLinks, wl_ListHeader::Last, List_InsertAhead(), and NULL.

135 {
136  RefListGetLinksProc getLinks = header->GetLinks;
137 
138 #ifdef prlDEBUG
139  if (header->Lock > 1)
140  OS_PrintMessage ("List_InsertAfter: Warning insert after on recursive List_Enum call !!\n");
141 #endif
142 
143  if (mark != NULL)
144  {
145  (*getLinks)(atom)->Prev = mark;
146 
147  if (mark != header->Last)
148  {
149  (*getLinks)(atom)->Next = (*getLinks)(mark)->Next;
150  (*getLinks)((*getLinks)(mark)->Next)->Prev = atom;
151  }
152  else /* Insert at the end of the list */
153  {
154  (*getLinks)(atom)->Next = NULL;
155  header->Last = atom;
156  }
157 
158  (*getLinks)(mark)->Next = atom;
159  }
160  else /* Insert ahead the list */
161  List_InsertAhead (header, atom);
162 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
#define NULL
Definition: def_const.h:203
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
void List_InsertAhead(RefListHeader header, Ref atom)
List_InsertAhead.
Definition: list.c:44
void List_InsertAhead ( RefListHeader  header,
Ref  atom 
)

List_InsertAhead.

Parameters
RefListHeaderheader
Refatom

List functions

Definition at line 44 of file list.c.

References wl_ListHeader::First, wl_ListHeader::GetLinks, wl_ListHeader::Last, and NULL.

45 {
46  RefListGetLinksProc getLinks = header->GetLinks;
47 
48  /* Update links of atom to insert */
49 
50  (*getLinks)(atom)->Next = header->First;
51  (*getLinks)(atom)->Prev = NULL;
52 
53  /* Link to the head of list */
54 
55  if (header->First != NULL)
56  (*getLinks)(header->First)->Prev = atom;
57 
58  else /* The list is empty */
59  header->Last = atom;
60 
61  header->First = atom;
62 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
#define NULL
Definition: def_const.h:203
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
void List_InsertBefore ( RefListHeader  header,
Ref  atom,
Ref  mark 
)

List_InsertBefore.

Parameters
RefListHeaderheader
Refatom
Refmark

Definition at line 101 of file list.c.

References wl_ListHeader::First, wl_ListHeader::GetLinks, List_Append(), and NULL.

102 {
103  RefListGetLinksProc getLinks = header->GetLinks;
104 
105  if (mark != NULL)
106  {
107  (*getLinks)(atom)->Next = mark;
108 
109  if (mark != header->First)
110  {
111  (*getLinks)(atom)->Prev = (*getLinks)(mark)->Prev;
112  (*getLinks)((*getLinks)(mark)->Prev)->Next = atom;
113  }
114  else /* Insert ahead the list */
115  {
116  (*getLinks)(atom)->Prev = NULL;
117  header->First = atom;
118  }
119 
120  (*getLinks)(mark)->Prev = atom;
121  }
122  else /* Append to the list */
123  List_Append (header, atom);
124 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
#define NULL
Definition: def_const.h:203
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
void List_Append(RefListHeader header, Ref atom)
void List_Append
Definition: list.c:71
long List_IsUnlink ( RefListLinks  links)

List_IsUnlink.

Parameters
RefListLinkslinks

Definition at line 475 of file list.c.

References wl_ListLinks::Next, NULL, and wl_ListLinks::Prev.

476 {
477  return (links->Next == NULL && links->Prev == NULL);
478 }
#define NULL
Definition: def_const.h:203
psi_term list_nil ( ptr_definition  type)

list_nil

Parameters
ptr_definitiontype

LIST_NIL(type) Returns the atom NIL to mark the end of a list.

Definition at line 278 of file parser.c.

References wl_psi_term::attr_list, wl_psi_term::coref, disj_nil, disjunction, FALSE, wl_psi_term::flags, nil, NULL, wl_psi_term::resid, wl_psi_term::status, wl_psi_term::type, and wl_psi_term::value_3.

279 {
280  psi_term nihil;
281 
282  if(type==disjunction) /* RM: Feb 1 1993 */
283  nihil.type=disj_nil;
284  else
285  nihil.type=nil;
286 
287  nihil.status=0;
288  nihil.flags=FALSE; /* 14.9 */
289  nihil.attr_list=NULL;
290  nihil.resid=NULL;
291  nihil.value_3=NULL;
292  nihil.coref=NULL;
293 
294  return nihil;
295 }
ptr_residuation resid
Definition: def_struct.h:173
#define NULL
Definition: def_const.h:203
ptr_definition disj_nil
Definition: def_glob.h:85
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_definition disjunction
Definition: def_glob.h:84
ptr_psi_term coref
Definition: def_struct.h:172
ptr_definition nil
Definition: def_glob.h:97
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
void List_Remove ( RefListHeader  header,
Ref  atom 
)

List_Remove.

Parameters
RefListHeaderheader
Refatom)

Definition at line 258 of file list.c.

References wl_ListHeader::First, wl_ListHeader::GetLinks, wl_ListHeader::Last, and NULL.

259 {
260 /*-----------------------------------------------------------------------------
261 
262 WARNING
263  - The container is 'updated' two times if the first and last atom
264  of list is the only one to remove.
265 
266 -----------------------------------------------------------------------------*/
267 
268  RefListGetLinksProc getLinks = header->GetLinks;
269 
270 #ifdef prlDEBUG
271  if (header->Lock > 1)
272  OS_PrintMessage ("List_Remove: Warning remove on recursive List_Enum call !!\n");
273 #endif
274 
275  /* Update the DownStream links */
276 
277  if ((*getLinks)(atom)->Prev != NULL)
278  {
279  (*getLinks)((*getLinks)(atom)->Prev)->Next =
280  (*getLinks)(atom)->Next;
281  }
282  else /* Atom is the first of list */
283  header->First = (*getLinks)(atom)->Next;
284 
285  /* Update the UpStream links */
286 
287  if ((*getLinks)(atom)->Next != NULL)
288  {
289  (*getLinks)((*getLinks)(atom)->Next)->Prev =
290  (*getLinks)(atom)->Prev;
291  }
292  else /* Atom is the last of list */
293  header->Last = (*getLinks)(atom)->Prev;
294 
295  /* Reset the atom links */
296 
297  (*getLinks)(atom)->Prev = NULL;
298  (*getLinks)(atom)->Next = NULL;
299 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
#define NULL
Definition: def_const.h:203
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
void List_Reverse ( RefListHeader  header)

List_Reverse.

Parameters
RefListHeaderheader

Definition at line 230 of file list.c.

References wl_ListHeader::First, wl_ListHeader::GetLinks, wl_ListHeader::Last, List_SwapLinks(), and NULL.

231 {
232  Ref cur, next;
233  RefListGetLinksProc getLinks = header->GetLinks;
234 
235  /* This traverse cannot be done with function List_Enum() */
236 
237  cur = header->First;
238 
239  /* Swap the headers */
240  header->First = header->Last;
241  header->Last = cur;
242 
243  while (cur != NULL)
244  {
245  next = (*getLinks)(cur)->Next;
246  (void)List_SwapLinks (header, cur);
247  cur = next;
248  }
249 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
static long List_SwapLinks(RefListHeader header, Ref atom)
List_SwapLinks.
Definition: list.c:213
#define NULL
Definition: def_const.h:203
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
void * Ref
Definition: def_struct.h:258
void List_SetLinkProc ( RefListHeader  header,
RefListGetLinksProc  getLinks 
)

List_SetLinkProc.

Parameters
RefListHeaderheader
RefListGetLinksProcgetLinks

Set functions

Definition at line 24 of file list.c.

References wl_ListHeader::First, wl_ListHeader::GetLinks, wl_ListHeader::Last, and NULL.

25 {
26  header->First = NULL;
27  header->Last = NULL;
28 
29 #ifdef prlDEBUG
30  header->Lock = 0;
31 #endif
32 
33  header->GetLinks = getLinks;
34 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
#define NULL
Definition: def_const.h:203
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)
display_psi_stream
Definition: print.c:1564
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
void List_Swap ( RefListHeader  header,
Ref  first,
Ref  second 
)

List_Swap.

Parameters
RefListHeaderheader
Reffirst
Refsecond)

Definition at line 172 of file list.c.

References wl_ListHeader::First, wl_ListHeader::GetLinks, and wl_ListHeader::Last.

173 {
174  RefListGetLinksProc getLinks = header->GetLinks;
175 
176  /* Don't swap if the input is wrong */
177 
178  if ((*getLinks)(first)->Next != second)
179  {
180 #ifdef prlDEBUG
181  OS_PrintMessage ("List_Swap: WARNING wrong input data, swap not done..\n");
182 #endif
183  return;
184  }
185 
186  /* Special Cases */
187 
188  if (header->First == first)
189  header->First = second;
190  else
191  (*getLinks)((*getLinks)(first)->Prev)->Next = second;
192 
193  if (header->Last == second)
194  header->Last = first;
195  else
196  (*getLinks)((*getLinks)(second)->Next)->Prev = first;
197 
198  /* Swap the atoms */
199 
200  (*getLinks)(second)->Prev = (*getLinks)(first)->Prev;
201  (*getLinks)(first)->Next = (*getLinks)(second)->Next;
202  (*getLinks)(first)->Prev = second;
203  (*getLinks)(second)->Next = first;
204 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
void listing_pred_write ( ptr_node  n,
long  fflag 
)

listing_pred_write

Parameters
ptr_noden
longfflag

For the listing built-in

Definition at line 1438 of file print.c.

References const_quote, FALSE, func_flag, indent, listing_flag, main_pred_write(), outfile, output_stream, print_depth, PRINT_DEPTH, TRUE, write_canon, write_corefs, write_resids, and write_stderr.

1439 {
1440  long old_print_depth;
1441 
1443  func_flag=fflag;
1444  indent=TRUE;
1445  const_quote=TRUE;
1451  old_print_depth=print_depth;
1453  main_pred_write(n);
1454  print_depth=old_print_depth;
1455  (void)fflush(outfile);
1456 }
FILE * outfile
Definition: def_glob.h:333
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define PRINT_DEPTH
Definition: def_const.h:92
FILE * output_stream
Definition: def_glob.h:41
long load_aim ( )

load_aim

LOAD_AIM() Continue loading a file from the current psi-term up to the next query. Files are loaded in blocks of assertions that end with a query. Such a chunk is loaded by a 'load' goal on the goal_stack. This goal contains the input file state information. This guarantees that all queries in the input file are executed in the order they are encountered (which includes load operations).

Definition at line 2232 of file login.c.

References wl_goal::aaaa_1, abort_life(), aim, assert_clause(), assert_first, wl_goal::bbbb_1, wl_goal::cccc_1, choice_stack, CURRENT_MODULE, DEFRULES, encode_types(), eof, FACT, FALSE, file_date, find_module(), general_cut, get_attr(), input_state, input_stream, load, noisy, NULL, open_input_file(), parse(), prove, push_choice_point(), push_goal(), QUERY, restore_state(), save_state(), set_current_module(), stack_copy_psi_term(), TRUE, wl_psi_term::type, var_occurred, and var_tree.

2233 {
2234  long success=TRUE,exitloop;
2235  ptr_psi_term s;
2236  long sort;
2237  char *fn;
2238  long old_noisy,old_file_date;
2239  ptr_node old_var_tree;
2240  ptr_choice_point cutpt;
2241  long old_var_occurred; /* 18.8 */
2242  int end_of_file=FALSE; /* RM: Jan 27 1993 */
2243 
2244 
2248  old_file_date=file_date;
2249  file_date=(unsigned long)aim->bbbb_1;
2250  old_noisy=noisy;
2251  noisy=FALSE;
2252  fn=(char*)aim->cccc_1;
2253  exitloop=FALSE;
2254 
2255 
2256 
2257  do {
2258  /* Variables in queries in files are *completely independent* of top- */
2259  /* level variables. I.e.: top-level variables are *not* recognized */
2260  /* while loading files and variables in file queries are *not* added. */
2261  old_var_occurred=var_occurred; /* 18.8 */
2262  old_var_tree=var_tree;
2263  var_tree=NULL;
2264  s=stack_copy_psi_term(parse(&sort));
2265  var_tree=old_var_tree;
2266  var_occurred=old_var_occurred; /* 18.8 */
2267 
2268  if (s->type==eof) {
2269  encode_types();
2270  if (input_stream!=stdin) (void)fclose(input_stream);
2271  exitloop=TRUE;
2272  end_of_file=TRUE; /* RM: Jan 27 1993 */
2273  }
2274  else if (sort==FACT) {
2276  assert_clause(s);
2277  }
2278  else if (sort==QUERY) {
2279  encode_types();
2281  /* Handle both successful and failing queries correctly. */
2282  cutpt=choice_stack;
2287  exitloop=TRUE;
2288  }
2289  else {
2290  /* fprintf(stderr,"*** Error: in input file %c%s%c.\n",34,fn,34); */
2291  /* success=FALSE; */
2292  /* fail_all(); */
2293  if (input_stream!=stdin) (void)fclose(input_stream);
2294  (void)abort_life(TRUE);
2295  /* printf("\n*** Abort\n"); */
2296  /* main_loop_ok=FALSE; */
2297  }
2298  } while (success && !exitloop);
2299 
2300 
2301  /* RM: Jan 27 1993 */
2302  if(end_of_file || !success) {
2303  /*
2304  printf("END OF FILE %s, setting module to %s\n",
2305  ((ptr_psi_term)get_attr(input_state,
2306  INPUT_FILE_NAME))->value,
2307  ((ptr_psi_term)get_attr(input_state,
2308  CURRENT_MODULE))->value);
2309  */
2310 
2311  (void)set_current_module(
2312  find_module((char *)((ptr_psi_term)get_attr(input_state,
2313  CURRENT_MODULE))->value_3));
2314  }
2315 
2316 
2317  noisy=old_noisy;
2318  file_date=old_file_date;
2319  (void)open_input_file("stdin");
2320 
2321 
2322  return success;
2323 }
void assert_clause(ptr_psi_term t)
assert_clause
Definition: login.c:287
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long assert_first
Definition: def_glob.h:58
psi_term parse(long *q)
parse
Definition: parser.c:907
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
push_goal
Definition: login.c:600
GENERIC cccc_1
Definition: def_struct.h:226
#define general_cut
Definition: def_const.h:282
long file_date
Definition: def_glob.h:60
#define DEFRULES
Definition: def_const.h:138
#define CURRENT_MODULE
Definition: def_const.h:234
#define FACT
Definition: def_const.h:151
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
ptr_psi_term input_state
Definition: def_glob.h:199
#define QUERY
Definition: def_const.h:152
long noisy
Definition: def_glob.h:35
long abort_life(int nlflag)
abort_life
Definition: built_ins.c:2260
ptr_definition eof
Definition: def_glob.h:86
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
long var_occurred
Definition: def_glob.h:189
FILE * input_stream
Definition: def_glob.h:38
ptr_goal aim
Definition: def_glob.h:49
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
void restore_state(ptr_psi_term t)
restore_state
Definition: token.c:334
#define load
Definition: def_const.h:288
void encode_types()
encode_types
Definition: types.c:1091
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void save_state(ptr_psi_term t)
save_state
Definition: token.c:293
GENERIC get_attr(ptr_psi_term t, char *attrname)
get_attr
Definition: token.c:265
ptr_module find_module(char *module)
find_module
Definition: modules.c:54
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
long open_input_file(char *file)
open_input_file
Definition: token.c:594
ptr_module set_current_module(ptr_module module)
set_current_module
Definition: modules.c:100
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
push_choice_point
Definition: login.c:638
ptr_choice_point choice_stack
Definition: def_glob.h:51
long look ( )

look

LOOK() This function returns the precedence of the stack top.

Definition at line 163 of file parser.c.

References int_stack, and parser_stack_index.

164 {
166 }
long parser_stack_index
Definition: def_glob.h:24
long int_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:318
ptr_int_list lub ( ptr_psi_term  a,
ptr_psi_term  b,
ptr_psi_term pp 
)

Definition at line 173 of file lub.c.

References bfs(), wl_definition::code, copyTypeCode(), decode(), isSubTypeValue(), isValue(), makeUnitList(), NULL, or_codes(), stack_alloc(), sub_type(), top, wl_psi_term::type, and type_count.

174 {
175  ptr_definition ta; /* type of psi term a */
176  ptr_definition tb; /* type of psi term b */
177  long *flags; /* set to 1 if this type has been checked in
178  * the lub search.
179  */
180  ptr_int_list ans;
181  ptr_int_list pattern;
182  long found;
183 
184  ta = a->type;
185  tb = b->type;
186 
187  /* special cases first */
188 
189  if (isValue(a) && isValue(b) && sub_type(ta,tb) && sub_type(tb,ta))
190  {
191  /* special case of two values being of same type. Check that they
192  * might actually be same value before returning the type
193  */
194  if (isSubTypeValue(a, b))
195  {
196  /* since we alreadyuu know they are both values, isSubTypeValue
197  * returns TRUE if they are same value, else false
198  */
199 
200  *pp = a;
201  return NULL;
202  }
203  }
204 
205  if (sub_type(ta, tb)) return makeUnitList(tb);
206  if (sub_type(tb, ta)) return makeUnitList(ta);
207 
208  /* ta has the lub of tb&ta without the high bit set, search upwards for a
209  * type that has the same lower bits as ta
210  */
211 
212  /* get the pattern to search for */
213 
214  pattern = copyTypeCode(ta->code);
215  or_codes(pattern, tb->code); /* pattern to search for */
216  ans = copyTypeCode(pattern); /* resulting pattern */
217 
218  /* initialize the table to be non-searched */
219 
220  flags = (long *)stack_alloc(sizeof(unsigned long) * type_count);
221  memset(flags, 0, sizeof(unsigned long) * type_count);
222 
223  /* now do a breadth first search for each of arg1 and arg2 */
224 
225  found = bfs(ta, ans, pattern, flags);
226  found += bfs(tb, ans, pattern, flags);
227 
228  if (found)
229  ans = decode(ans);
230  else
231  ans = makeUnitList(top);
232 
233  return ans;
234 }
int isSubTypeValue(ptr_psi_term arg1, ptr_psi_term arg2)
isSubTypeValue
Definition: bi_type.c:180
long type_count
Definition: def_glob.h:46
ptr_int_list decode(ptr_int_list c)
decode
Definition: types.c:1784
static long bfs(ptr_definition p, ptr_int_list ans, ptr_int_list pattern, long *flags)
bfs
Definition: lub.c:88
void or_codes(ptr_int_list u, ptr_int_list v)
or_codes
Definition: types.c:831
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
ptr_int_list copyTypeCode(ptr_int_list u)
copyTypeCode
Definition: types.c:808
ptr_int_list code
Definition: def_struct.h:129
long isValue(ptr_psi_term p)
isValue(p)
Definition: bi_type.c:691
ptr_definition type
Definition: def_struct.h:165
static ptr_int_list makeUnitList(ptr_definition x)
makeUnitList
Definition: lub.c:152
GENERIC stack_alloc(long s)
stack_alloc
Definition: memory.c:1642
int main ( int  argc,
char *  argv[] 
)

main

int main(int argc,char *argv[])

Parameters
intargc
char*argv[]

MAIN(argc,argv) This routine contains the Read-Solve-Print loop.

Definition at line 34 of file life.c.

References arg_c, arg_v, assert, assert_clause(), assert_first, assert_ok, begin_terminal_io(), DEFRULES, encode_types(), end_terminal_io(), env, eof, Errorline(), exit_if_true(), exit_life(), FACT, FALSE, file_date, GetBoolOption(), goal_count, heap_copy_string(), ignore_eff, infoline(), init_built_in_types(), init_copy(), init_interrupt(), init_io(), init_memory(), init_modules(), init_print(), init_system(), init_trace(), input_state, load, main_prove(), mem_base, noisy, NULL, open_input_file(), other_base, parse(), prove, push_goal(), put_back_char(), QUERY, quietflag, rand_array, read_char(), reset_step(), set_current_module(), stack_copy_psi_term(), stack_pointer, start_chrono(), stdin_cleareof(), title(), TRUE, wl_psi_term::type, undo(), undo_stack, user_module, var_occurred, and what_next.

35 {
36  ptr_psi_term s;
37  ptr_stack save_undo_stack;
38  long sort,exitflag;
39  long c; /* 21.12 (prev. char) */
40 
41  int i;
42 #ifdef SOLARIS
43  for(i=0;i<256;i++)
44  rand_array[i]=rand_r(&lifeseed);
45 #else
46  for(i=0;i<256;i++)
47  rand_array[i]=random();
48 #endif
49 
50 
51  arg_c=argc;
52  if (argc < 10)
53  {
54  for (i = 0; i < argc;i++)
55  {
56  arg_v[i]=argv[i];
57  }
58  }
59  else
60  Errorline("Too many command line arguments\n");
61 
62  // arg_v=argv;
63  quietflag = GetBoolOption("q");
64  init_io();
65  init_memory();
67  assert(stack_pointer==mem_base); /* 8.10 */
68  init_copy();
69  assert(stack_pointer==mem_base); /* 8.10 */
70  init_print();
71  assert(stack_pointer==mem_base); /* 8.10 */
72 
73  /* Timekeeping initialization */
74  tzset();
75  (void)times(&life_start);
76  assert(stack_pointer==mem_base); /* 8.10 */
77 
78  init_modules(); /* RM: Jan 8 1993 */
79 
81  assert(stack_pointer==mem_base); /* 8.10 */
82 #ifdef X11
83  x_setup_builtins();
84  assert(stack_pointer==mem_base); /* 8.10 */
85 #endif
87 
88  assert(stack_pointer==mem_base); /* 8.10 */
89  title();
90  assert(stack_pointer==mem_base); /* 8.10 */
91  init_trace();
92  noisy=FALSE;
93 
94  assert(stack_pointer==mem_base); /* 8.10 */
95 
96 
97  (void)set_current_module(user_module); /* RM: Jan 27 1993 */
98 
99  /* Read in the .set_up file */
100  init_system();
101 
102 #ifdef ARITY /* RM: Mar 29 1993 */
103  arity_init();
104 #endif
105 
106 
107  (void)open_input_file("+SETUP+");
109  file_date+=2;
110  main_prove();
111 
112 
113  /* Main loop of interpreter */
114  do {
115  (void)setjmp(env);
116  /* printf("%ld\n",(long)(stack_pointer-mem_base)); */ /* 8.10 */
117  init_system();
118  init_trace();
119 
122  save_undo_stack=undo_stack;
123  stdin_cleareof();
124  c=read_char();
125  /* Wait until an EOF or a good character */
126  while (c!=EOF && !(c>32 && c!='.' && c!=';')) c=read_char();
127  if (c==EOF)
128  exitflag=TRUE;
129  else {
130  put_back_char(c);
131  s=stack_copy_psi_term(parse(&sort));
132  exitflag=(s->type==eof);
133  }
134  end_terminal_io();
135 
136  if (!exitflag) {
137  if (sort==QUERY) {
138 
139  // clear_already_loaded(symbol_table); RM: Feb 3 1993
140 
142 
144  goal_count=0;
146  reset_step();
147  start_chrono();
148  main_prove();
149  /* assert(goal_stack==NULL); */
150  /* assert(choice_stack==NULL); */
151  if (undo_stack) {
152  undo(NULL);
153  Errorline("non-NULL undo stack.\n");
154  }
155  /* assert(undo_stack==NULL); */
156  }
157  else if (sort==FACT) {
159  assert_clause(s);
160  undo(save_undo_stack); /* 17.8 */
161  var_occurred=FALSE; /* 18.8 */
162  encode_types();
163 
164  infoline(assert_ok?"\n*** Yes\n":"\n*** No\n"); /* 21.1 */
165  }
166  }
167  } while (!exitflag);
168 
169  /* hash_display(x_module->symbol_table); */
170 
171  exit_life(TRUE);
172  return 0;
173 }
#define prove
Definition: def_const.h:273
void init_trace()
Definition: error.c:587
void undo(ptr_stack limit)
undo
Definition: login.c:691
long assert_first
Definition: def_glob.h:58
void put_back_char(long c)
put_back_char
Definition: token.c:729
void exit_life(long nl_flag)
exit_life
Definition: built_ins.c:2220
void exit_if_true(long exitflag)
exit_if_true
Definition: lib.c:55
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)
parse
Definition: parser.c:907
void init_system()
init_system
Definition: lib.c:94
void reset_step()
Definition: error.c:596
long file_date
Definition: def_glob.h:60
#define DEFRULES
Definition: def_const.h:138
#define FACT
Definition: def_const.h:151
ptr_module user_module
Definition: def_glob.h:156
GENERIC other_base
Definition: def_glob.h:19
long quietflag
Definition: def_glob.h:271
#define NULL
Definition: def_const.h:203
ptr_psi_term input_state
Definition: def_glob.h:199
long ignore_eff
Definition: def_glob.h:151
#define QUERY
Definition: def_const.h:152
long noisy
Definition: def_glob.h:35
long assert_ok
Definition: def_glob.h:59
void init_io()
void init_io
Definition: lib.c:69
ptr_stack undo_stack
Definition: def_glob.h:53
void Errorline(char *format,...)
Definition: error.c:414
void end_terminal_io()
end_terminal_io
Definition: token.c:516
long goal_count
Definition: def_glob.h:152
void infoline(char *format,...)
Definition: error.c:245
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
void begin_terminal_io()
begin_terminal_io
Definition: token.c:493
ptr_definition eof
Definition: def_glob.h:86
#define TRUE
Definition: def_const.h:127
#define what_next
Definition: def_const.h:277
void start_chrono()
start_chrono
Definition: login.c:349
#define FALSE
Definition: def_const.h:128
int arg_c
Definition: def_glob.h:5
void init_print()
init_print
Definition: print.c:52
long var_occurred
Definition: def_glob.h:189
GENERIC mem_base
Definition: def_glob.h:11
void init_memory()
init_memory ()
Definition: memory.c:1671
char * arg_v[10]
Definition: def_glob.h:6
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
#define load
Definition: def_const.h:288
long rand_array[256]
Definition: def_glob.h:279
void encode_types()
encode_types
Definition: types.c:1091
jmp_buf env
Definition: def_glob.h:236
void main_prove()
main_prove
Definition: login.c:2335
void init_built_in_types()
init_built_in_types
Definition: built_ins.c:6150
long read_char()
read_char
Definition: token.c:680
GENERIC stack_pointer
Definition: def_glob.h:14
void init_modules()
init_modules
Definition: modules.c:34
ptr_definition type
Definition: def_struct.h:165
void stdin_cleareof()
stdin_cleareof
Definition: token.c:51
unsigned long * GENERIC
Definition: def_struct.h:17
void title()
TITLE.
Definition: info.c:39
void init_copy()
init_copy
Definition: copy.c:32
long open_input_file(char *file)
open_input_file
Definition: token.c:594
ptr_module set_current_module(ptr_module module)
set_current_module
Definition: modules.c:100
void assert_clause(ptr_psi_term t)
assert_clause
Definition: login.c:287
void init_interrupt()
INIT_INTERRUPT.
Definition: interrupt.c:36
int GetBoolOption(char *name)
GetBoolOption.
Definition: memory.c:64
#define assert(N)
Definition: memory.c:113
void main_display_psi_term ( ptr_psi_term  t)

main_display_psi_term

Parameters
ptr_psi_termt

Main loop for previous two entry points

Definition at line 1593 of file print.c.

References buffer, const_quote, deref_ptr, end_tab(), FALSE, gen_sym_counter, go_through(), heap_pointer, indent, indx, insert_variables(), listing_flag, mark_tab(), MAX_PRECEDENCE, new_tab(), NULL, pointer_names, pretty_output(), pretty_tag_or_psi_term(), pretty_things, printed_pointers, TRUE, var_tree, work_out_length(), write_canon, and write_resids.

1594 {
1595  GENERIC old_heap_pointer;
1596  ptr_tab_brk new;
1597 
1599  if(t) {
1600 
1601  deref_ptr(t);
1602 
1603  old_heap_pointer=heap_pointer;
1606  gen_sym_counter=0;
1607  go_through(t);
1609 
1610  indent=FALSE;
1611  const_quote=TRUE;
1614  *buffer=0;
1616 
1617  new_tab(&new);
1618  mark_tab(new);
1620  end_tab();
1621  if (indent) {
1622  work_out_length();
1623  pretty_output();
1624  }
1625 
1626  heap_pointer=old_heap_pointer;
1627  }
1628  else
1629  printf("*null psi_term*");
1630 }
ptr_node printed_pointers
Definition: def_glob.h:28
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
ptr_node pointer_names
Definition: def_glob.h:29
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_item indx
Definition: def_glob.h:329
#define FALSE
Definition: def_const.h:128
GENERIC heap_pointer
Definition: def_glob.h:12
#define MAX_PRECEDENCE
Definition: def_const.h:103
long gen_sym_counter
Definition: def_glob.h:30
unsigned long * GENERIC
Definition: def_struct.h:17
void main_pred_write ( ptr_node  n)

main_pred_write

Parameters
ptr_noden

Definition at line 1484 of file print.c.

References buffer, check_pointer(), wl_node::data, end_tab(), FALSE, gen_sym_counter, go_through_tree(), heap_pointer, indent, indx, insert_variables(), wl_node::left, mark_tab(), MAX_PRECEDENCE, new_tab(), NULL, pointer_names, pretty_output(), pretty_tag_or_psi_term(), pretty_things, printed_pointers, wl_node::right, var_tree, work_out_length(), write_attributes(), and write_corefs.

1485 {
1486  if (n) {
1487  GENERIC old_heap_pointer;
1488  ptr_tab_brk new;
1489 
1490  if (!write_corefs) main_pred_write(n->left);
1491 
1492  old_heap_pointer=heap_pointer;
1495  gen_sym_counter=0;
1496  if (write_corefs)
1497  go_through_tree(n);
1498  else
1501 
1502  *buffer=0;
1503 
1505  new_tab(&new);
1506 
1507  if (write_corefs) {
1508  write_attributes(n,new);
1509  }
1510  else {
1511  mark_tab(new);
1513  }
1514 
1515  end_tab();
1516 
1517  if (indent) {
1518  work_out_length();
1519  pretty_output();
1520  }
1521 
1522  heap_pointer=old_heap_pointer;
1523 
1525  }
1526 }
ptr_node printed_pointers
Definition: def_glob.h:28
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
ptr_node pointer_names
Definition: def_glob.h:29
ptr_node left
Definition: def_struct.h:183
ptr_item indx
Definition: def_glob.h:329
#define FALSE
Definition: def_const.h:128
GENERIC heap_pointer
Definition: def_glob.h:12
#define MAX_PRECEDENCE
Definition: def_const.h:103
long gen_sym_counter
Definition: def_glob.h:30
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node right
Definition: def_struct.h:184
void main_prove ( )

main_prove

MAIN_PROVE() This is the inference engine. It distributes sub-goals to the appropriate routines. It deals with backtracking. It fails if there is not enough memory available or if there is an interrupt that causes the current query to be aborted.

Definition at line 2335 of file login.c.

References wl_goal::aaaa_1, aim, backtrack(), wl_goal::bbbb_1, c_what_next, wl_goal::cccc_1, choice_stack, clause, clause_aim(), clean_trail(), curried, cut_to, del_clause, disj, disjunct_aim(), do_currying(), do_residuation_user(), Errorline(), eval, eval_aim(), eval_cut, fail, FALSE, freeze_cut, function_it, GC_THRESHOLD, general_cut, goal_count, goal_stack, handle_interrupt(), heap_pointer, i_check_out(), implies_cut, infoline(), interrupted, load, load_aim(), main_loop_ok, match, match_aim(), memory_check(), wl_goal::next, NULL, prove, prove_aim(), release_resid(), resid_aim, resid_vars, restore_resid(), retract, show_count(), stack_pointer, stepcount, stepflag, steptrace, traceline(), TRUE, wl_goal::type, type_disj, type_disj_aim(), undo(), unify, unify_aim(), unify_aim_noeval(), unify_noeval, warningline(), what_next, what_next_aim(), xcount, xevent_existing, XEVENTDELAY, and xeventdelay.

2336 {
2337  long success=TRUE;
2338  ptr_pair_list *p;
2339  ptr_psi_term unused_match_date; /* 13.6 */
2340 
2341  xcount=0;
2345 
2346  while (main_loop_ok && goal_stack) {
2347 
2348  /* RM: Oct 28 1993 For debugging a horrible mess.
2349  {
2350  ptr_choice_point c=choice_stack;
2351  while(c) {
2352  if((ptr_psi_term)stack_pointer<(ptr_psi_term)c) {
2353  printf("########### Choice stack corrupted! %x\n",c);
2354  trace=TRUE;
2355  c=NULL;
2356  }
2357  else
2358  c=c->next;
2359  }
2360  }
2361  */
2362 
2363 
2364  aim=goal_stack;
2365  switch(aim->type) {
2366 
2367  case unify:
2368  goal_stack=aim->next;
2369  goal_count++;
2370  success=unify_aim();
2371  break;
2372 
2373  /* Same as above, but do not evaluate top level */
2374  /* Used to bind with unbound variables */
2375  case unify_noeval:
2376  goal_stack=aim->next;
2377  goal_count++;
2378  success=unify_aim_noeval();
2379  break;
2380 
2381  case prove:
2382  success=prove_aim();
2383  break;
2384 
2385  case eval:
2386  goal_stack=aim->next;
2387  goal_count++;
2388  success=eval_aim();
2389  break;
2390 
2391  case load:
2392  goal_stack=aim->next;
2393  goal_count++;
2394  success=load_aim();
2395  break;
2396 
2397  case match:
2398  goal_stack=aim->next;
2399  goal_count++;
2400  success=match_aim();
2401  break;
2402 
2403  case disj:
2404  goal_stack=aim->next;
2405  goal_count++;
2406  success=disjunct_aim();
2407  break;
2408 
2409  case general_cut:
2410  goal_stack=aim->next;
2411  goal_count++;
2412  /* assert((ptr_choice_point)aim->aaaa_1 <= choice_stack); 12.7 */
2413  /* choice_stack=(ptr_choice_point)aim->aaaa_1; */
2414  cut_to(aim->aaaa_1); /* 12.7 */
2415 #ifdef CLEAN_TRAIL
2417 #endif
2418 #ifdef TS
2419  /* RESTORE_TIME_STAMP; */ /* 9.6 */
2420 #endif
2421  break;
2422 
2423  case eval_cut:
2424  /* RESID */ restore_resid((ptr_resid_block)aim->cccc_1, &unused_match_date);
2425  if (curried)
2426  do_currying();
2427  else if (resid_vars) {
2428  success=do_residuation_user(); /* 21.9 */ /* PVR 9.2.94 */
2429  } else {
2430  if (resid_aim)
2431  traceline("result of %P is %P\n", resid_aim->aaaa_1, aim->aaaa_1);
2432  goal_stack=aim->next;
2433  goal_count++;
2434  /* resid_aim=NULL; 21.9 */
2435  /* PVR 5.11 choice_stack=(ptr_choice_point)aim->bbbb_1; */
2436  (void)i_check_out(aim->aaaa_1);
2437  }
2438  resid_aim=NULL; /* 21.9 */
2439  resid_vars=NULL; /* 22.9 */
2440  /* assert((ptr_choice_point)aim->bbbb_1<=choice_stack); 12.7 */
2441  /* PVR 5.11 */ /* choice_stack=(ptr_choice_point)aim->bbbb_1; */
2442  if (success) { /* 21.9 */
2443  cut_to(aim->bbbb_1); /* 12.7 */
2444 #ifdef CLEAN_TRAIL
2446 #endif
2447  /* match_date=NULL; */ /* 13.6 */
2448 #ifdef TS
2449  /* RESTORE_TIME_STAMP; */ /* 9.6 */
2450 #endif
2451  }
2452  break;
2453 
2454  case freeze_cut:
2455  /* RESID */ restore_resid((ptr_resid_block)aim->cccc_1, &unused_match_date);
2456  if (curried) {
2457  warningline("frozen goal has a missing parameter '%P' and fails.\n",aim->aaaa_1);
2458  success=FALSE;
2459  }
2460  else if (resid_vars) {
2461  success=do_residuation_user(); /* 21.9 */ /* PVR 9.2.94 */
2462  } else {
2463  if (resid_aim) traceline("releasing frozen goal: %P\n", aim->aaaa_1);
2464  /* resid_aim=NULL; 21.9 */
2465  /* PVR 5.12 choice_stack=(ptr_choice_point)aim->bbbb_1; */
2466  goal_stack=aim->next;
2467  goal_count++;
2468  }
2469  resid_aim=NULL; /* 21.9 */
2470  resid_vars=NULL; /* 22.9 */
2471  if (success) { /* 21.9 */
2472  /* assert((ptr_choice_point)aim->bbbb_1<=choice_stack); 12.7 */
2473  /* PVR 5.12 */ /* choice_stack=(ptr_choice_point)aim->bbbb_1; */
2474  cut_to(aim->bbbb_1); /* 12.7 */
2475 #ifdef CLEAN_TRAIL
2477 #endif
2478  /* match_date=NULL; */ /* 13.6 */
2479 #ifdef TS
2480  /* RESTORE_TIME_STAMP; */ /* 9.6 */
2481 #endif
2482  }
2483  break;
2484 
2485  case implies_cut: /* 12.10 */
2486  /* This 'cut' is actually more like a no-op! */
2487  restore_resid((ptr_resid_block)aim->cccc_1, &unused_match_date);
2488  if (curried) {
2489  warningline("implied goal has a missing parameter '%P' and fails.\n",aim->aaaa_1);
2490  success=FALSE;
2491  }
2492  else if (resid_vars)
2493  success=FALSE;
2494  else {
2495  if (resid_aim) traceline("executing implied goal: %P\n", aim->aaaa_1);
2496  goal_stack=aim->next;
2497  goal_count++;
2498  }
2499  resid_aim=NULL; /* 21.9 */
2500  resid_vars=NULL; /* 22.9 */
2501  break;
2502 
2503  case fail:
2504  goal_stack=aim->next;
2505  success=FALSE;
2506  break;
2507 
2508  case what_next:
2509  goal_stack=aim->next;
2510  success=what_next_aim();
2511  break;
2512 
2513  case type_disj:
2514  goal_stack=aim->next;
2515  goal_count++;
2516  type_disj_aim();
2517  break;
2518 
2519  case clause:
2520  goal_stack=aim->next;
2521  goal_count++;
2522  success=clause_aim(0);
2523  break;
2524 
2525  case del_clause:
2526  goal_stack=aim->next;
2527  goal_count++;
2528  success=clause_aim(1);
2529  break;
2530 
2531  case retract:
2532  goal_stack=aim->next;
2533  goal_count++;
2534  p=(ptr_pair_list*)aim->aaaa_1;
2535  traceline("deleting clause (%P%s%P)\n",
2536  (*p)->aaaa_2,((*p)->aaaa_2->type->type_def==(def_type)function_it?"->":":-"),(*p)->bbbb_2);
2537  (*p)->aaaa_2=NULL;
2538  (*p)->bbbb_2=NULL;
2539  (*p)=(*p)->next; /* Remove retracted element from pairlist */
2540  break;
2541 
2542  case c_what_next: /* RM: Mar 31 1993 */
2543  main_loop_ok=FALSE; /* Exit the main loop */
2544  break;
2545 
2546  default:
2547  Errorline("bad goal on stack %d.\n",goal_stack->type);
2548  goal_stack=aim->next;
2549  }
2550 
2551  if (main_loop_ok) {
2552 
2553  if (success) {
2554 
2555 #ifdef X11
2556  /* Polling on external events */
2557  if (xcount<=0 && aim->type==prove) {
2558  if (x_exist_event()) {
2559  /* printf("At event, xeventdelay = %ld.\n",xeventdelay); */
2560  xeventdelay=0;
2562  } else {
2564  /* If XEVENTDELAY=1000 it takes 90000 goals to get back */
2565  /* from 100 at the pace of 1%. */
2566  xeventdelay=(xeventdelay*101)/100+2;
2567  else
2569  }
2571  }
2572  else
2573  xcount--;
2574 #endif
2575 
2576  }
2577  else {
2578  if (choice_stack) {
2579  backtrack();
2580  traceline("backtracking\n");
2581  success=TRUE;
2582  }
2583  else /* if (goal_stack) */ {
2584  undo(NULL); /* 8.10 */
2585  infoline("\n*** No");
2586  /* printf("\n*** No (in main_prove)."); */
2587  show_count();
2588 #ifdef TS
2589  /* global_time_stamp=INIT_TIME_STAMP; */ /* 9.6 */
2590 #endif
2592  }
2593  }
2594 
2596  (void)memory_check();
2597 
2598  if (interrupted || (stepflag && steptrace))
2599  handle_interrupt();
2600  else if (stepcount>0) {
2601  stepcount--;
2602  if (stepcount==0 && !stepflag) {
2603  stepflag=TRUE;
2604  handle_interrupt();
2605  }
2606  }
2607  }
2608  }
2609 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long load_aim()
load_aim
Definition: login.c:2232
#define function_it
Definition: def_const.h:362
long main_loop_ok
Definition: def_glob.h:48
long do_residuation_user()
do_residuation_user()
Definition: lefun.c:324
void restore_resid(ptr_resid_block rb, ptr_psi_term *match_date)
restore_resid
Definition: lefun.c:1417
void show_count()
show_count
Definition: login.c:1161
ptr_goal goal_stack
Definition: def_glob.h:50
void undo(ptr_stack limit)
undo
Definition: login.c:691
long unify_aim()
unify_aim
Definition: login.c:1344
GENERIC cccc_1
Definition: def_struct.h:226
#define general_cut
Definition: def_const.h:282
#define implies_cut
Definition: def_const.h:281
#define XEVENTDELAY
Definition: def_const.h:117
long interrupted
Definition: def_glob.h:146
#define NULL
Definition: def_const.h:203
long steptrace
Definition: def_glob.h:274
void type_disj_aim()
type_disj_aim
Definition: login.c:1845
ptr_goal resid_aim
Definition: def_glob.h:220
#define c_what_next
Definition: def_const.h:289
ptr_resid_list resid_vars
Definition: def_glob.h:221
#define eval
Definition: def_const.h:278
void release_resid(ptr_psi_term t)
release_resid
Definition: lefun.c:445
void traceline(char *format,...)
Definition: error.c:157
long stepcount
Definition: def_glob.h:275
void Errorline(char *format,...)
Definition: error.c:414
long clause_aim(long r)
clause_aim
Definition: login.c:1879
long goal_count
Definition: def_glob.h:152
void infoline(char *format,...)
Definition: error.c:245
goals type
Definition: def_struct.h:223
void do_currying()
do_currying
Definition: lefun.c:383
#define freeze_cut
Definition: def_const.h:280
#define TRUE
Definition: def_const.h:127
static void clean_trail(ptr_choice_point cutpt)
clean_trail
Definition: login.c:810
#define what_next
Definition: def_const.h:277
#define match
Definition: def_const.h:283
#define FALSE
Definition: def_const.h:128
long unify_aim_noeval()
unify_aim_noeval
Definition: login.c:1354
#define clause
Definition: def_const.h:285
long stepflag
Definition: def_glob.h:150
#define cut_to(C)
Definition: def_macro.h:80
#define fail
Definition: def_const.h:272
ptr_goal aim
Definition: def_glob.h:49
GENERIC heap_pointer
Definition: def_glob.h:12
#define retract
Definition: def_const.h:287
#define unify
Definition: def_const.h:274
long xeventdelay
Definition: def_glob.h:300
long eval_aim()
eval_aim
Definition: lefun.c:497
#define load
Definition: def_const.h:288
long prove_aim()
prove_aim
Definition: login.c:1645
#define unify_noeval
Definition: def_const.h:275
long curried
Definition: def_glob.h:223
#define del_clause
Definition: def_const.h:286
#define eval_cut
Definition: def_const.h:279
long disjunct_aim()
disjunct_aim
Definition: login.c:1621
void handle_interrupt()
HANDLE_INTERRUPT.
Definition: interrupt.c:52
void backtrack()
backtrack
Definition: login.c:772
#define GC_THRESHOLD
Definition: def_const.h:65
#define disj
Definition: def_const.h:276
GENERIC stack_pointer
Definition: def_glob.h:14
#define type_disj
Definition: def_const.h:284
void warningline(char *format,...)
Definition: error.c:327
long memory_check()
memory_check
Definition: memory.c:1723
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_psi_term xevent_existing
Definition: def_glob.h:208
long xcount
Definition: def_glob.h:301
long match_aim()
match_aim
Definition: lefun.c:770
long i_check_out(ptr_psi_term t)
i_check_out
Definition: lefun.c:1033
ptr_choice_point choice_stack
Definition: def_glob.h:51
long what_next_aim()
what_next_aim
Definition: login.c:2068
ptr_goal next
Definition: def_struct.h:227
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)
str_to_int
Definition: print.c:118
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)
update_feature
Definition: modules.c:1331
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
ptr_node right
Definition: def_struct.h:184
int make_feature_private ( ptr_psi_term  term)

make_feature_private

Parameters
ptr_psi_termterm

MAKE_FEATURE_PRIVATE(feature) Make a feature private.

Definition at line 1256 of file modules.c.

References wl_keyword::combined_name, wl_keyword::definition, deref_ptr, hash_lookup(), wl_definition::keyword, wl_keyword::private_feature, wl_keyword::public, wl_keyword::symbol, wl_module::symbol_table, TRUE, wl_psi_term::type, update_symbol(), and warningline().

1257 {
1258  int ok=TRUE;
1259  ptr_keyword key;
1260  ptr_definition def;
1261 
1262  deref_ptr(term);
1263 
1265 
1266  if(key) {
1267  /*
1268  if(key->definition->keyword->module!=current_module) {
1269  warningline("local definition of '%s' overrides '%s'\n",
1270  key->definition->keyword->symbol,
1271  key->definition->keyword->combined_name);
1272 
1273  new_definition(key);
1274  }
1275  */
1276 
1277  key->private_feature=TRUE;
1278  def=key->definition;
1279  }
1280  else {
1283  }
1284 
1285 
1286  if(ok && def->keyword->public) {
1287  warningline("feature '%s' is now private, but was also declared public\n",
1288  def->keyword->combined_name);
1289  }
1290 
1291  return ok;
1292 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
char * combined_name
Definition: def_struct.h:92
ptr_definition definition
Definition: def_struct.h:96
ptr_hash_table symbol_table
Definition: def_struct.h:79
ptr_keyword keyword
Definition: def_struct.h:124
ptr_module current_module
Definition: modules.c:15
char * symbol
Definition: def_struct.h:91
ptr_definition update_symbol(ptr_module module, char *symbol)
update_symbol
Definition: modules.c:270
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
int private_feature
Definition: def_struct.h:95
void warningline(char *format,...)
Definition: error.c:327
int public
Definition: def_struct.h:94
ptr_definition type
Definition: def_struct.h:165
psi_term make_life_form ( ptr_psi_term  tok,
ptr_psi_term  arg1,
ptr_psi_term  arg2 
)

make_life_form

Parameters
ptr_psi_termtok
ptr_psi_termarg1
ptr_psi_termarg2

MAKE_LIFE_FORM(tok,arg1,arg2) This routine inserts ARG1 and ARG2 as the first and second attributes of psi_term TOK, thus creating the term TOK(1=>arg1,2=>arg2).

If TOK is ':' then a conjunction is created if necessary. Example: a:V:b:5:long => V: <a,b,5,int> (= conjunction list).

Definition at line 571 of file parser.c.

References wl_psi_term::attr_list, wl_psi_term::coref, deref_ptr, equ_tokch, error_psi_term, FEATCMP, heap_alloc(), integer, minus_symbol, NULL, one, push_psi_ptr_value(), REAL, real, wl_psi_term::resid, stack_copy_psi_term(), stack_insert(), Syntaxerrorline(), top, two, wl_psi_term::type, and wl_psi_term::value_3.

572 {
573  ptr_psi_term a1,a2;
574 
575  deref_ptr(tok);
576  tok->attr_list=NULL;
577  tok->resid=NULL;
578 
579  /* Here beginneth a terrible FIX,
580  I will have to rewrite the tokeniser and the parser to handle
581  POINTERS to psi-terms instead of PSI_TERMS !!!
582  */
583 
584  a1=arg1;
585  a2=arg2;
586 
587  if (a1)
588  deref_ptr(a1);
589  if (a2)
590  deref_ptr(a2);
591 
592  /* End of extremely ugly fix. */
593 
594  if (/* UNI FALSE */ equ_tokch((*tok),':') && arg1 && arg2) {
595 
596  if (a1!=a2) {
597  if (a1->type==top &&
598  !a1->attr_list &&
599  !a1->resid) {
600  if (a1!=arg1)
601  /* push_ptr_value(psi_term_ptr,&(a1->coref)); 9.6 */
602  push_psi_ptr_value(a1,(GENERIC *)&(a1->coref));
603  a1->coref=stack_copy_psi_term(*arg2);
604  tok=arg1;
605  }
606  else
607  if(a2->type==top &&
608  !a2->attr_list &&
609  !a2->resid) {
610  if(a2!=arg2)
611  /* push_ptr_value(psi_term_ptr,&(a2->coref)); 9.6 */
612  push_psi_ptr_value(a2,(GENERIC *)&(a2->coref));
613  a2->coref=stack_copy_psi_term(*arg1);
614  tok=arg2;
615  }
616  else { /* RM: Feb 22 1993 Now reports an error */
617  Syntaxerrorline("':' occurs where '&' required (%E)\n");
618  *tok= *error_psi_term;
619  /* make_unify_pair(tok,arg1,arg2); Old code */
620  }
621  }
622  else
623  tok=arg1;
624  }
625  else {
626 
627  /* RM: Jun 21 1993 */
628  /* And now for another nasty hack: reading negative numbers */
629  if(tok->type==minus_symbol &&
630  a1 &&
631  !a2 &&
632  a1->value_3 &&
633  (a1->type==integer || a1->type==real)) {
634 
635  tok->type=a1->type;
636  tok->value_3=(GENERIC)heap_alloc(sizeof(REAL));
637  *(REAL *)tok->value_3 = - *(REAL *)a1->value_3;
638 
639  return *tok;
640  }
641  /* End of other nasty hack */
642 
644  if (arg2)
646  }
647 
648  return *tok;
649 }
ptr_residuation resid
Definition: def_struct.h:173
#define FEATCMP
Definition: def_const.h:257
char * two
Definition: def_glob.h:251
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
ptr_definition minus_symbol
Definition: def_glob.h:96
ptr_definition real
Definition: def_glob.h:102
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
#define deref_ptr(P)
Definition: def_macro.h:95
void Syntaxerrorline(char *format,...)
Definition: error.c:498
ptr_psi_term error_psi_term
Definition: def_glob.h:23
ptr_definition integer
Definition: def_glob.h:93
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
ptr_psi_term coref
Definition: def_struct.h:172
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
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
#define equ_tokch(A, B)
Definition: def_macro.h:66
char * make_module_token ( ptr_module  module,
char *  str 
)

make_module_token

Parameters
ptr_modulemodule
char*str

MAKE_MODULE_TOKEN(module,string) Write 'module::string' in module_buffer. If string is a qualified reference to a given module, then modify the calling module variable to reflect this.

The result must be immediately stored in a newly allocated string.

Definition at line 191 of file modules.c.

References extract_module_from_name(), module_buffer, and wl_module::module_name.

192 {
193  ptr_module explicit;
194 
195 
196  /* Check if the string already contains a module */
197  explicit=extract_module_from_name(str);
198  if(explicit)
199  strcpy(module_buffer,str);
200  else
201  if(module!=no_module) {
202  strcpy(module_buffer,module->module_name);
203  strcat(module_buffer,"#");
204  strcat(module_buffer,str);
205  }
206  else
207  strcpy(module_buffer,str);
208 
209  return module_buffer;
210 }
string module_buffer
Definition: def_glob.h:312
char * module_name
Definition: def_struct.h:75
ptr_module no_module
Definition: modules.c:16
ptr_module extract_module_from_name(char *str)
extract_module_from_name
Definition: modules.c:116
long make_public ( ptr_psi_term  term,
long  bool 
)

make_public

Parameters
ptr_psi_termterm
longbool

MAKE_PUBLIC(term,bool) Make a term public.

Definition at line 613 of file modules.c.

References wl_keyword::combined_name, wl_keyword::definition, deref_ptr, hash_lookup(), wl_definition::keyword, wl_keyword::module, new_definition(), wl_keyword::public, wl_keyword::symbol, wl_module::symbol_table, TRUE, wl_psi_term::type, update_symbol(), and warningline().

614 {
615  int ok=TRUE;
616  ptr_keyword key;
617  ptr_definition def;
618 
619  deref_ptr(term);
620 
622  if(key) {
623 
624  if(key->definition->keyword->module!=current_module && !bool) {
625  warningline("local definition of '%s' overrides '%s'\n",
626  key->definition->keyword->symbol,
628 
629  (void)new_definition(key);
630  }
631 
632  key->public=bool;
633  }
634  else {
636  def->keyword->public=bool;
637  }
638 
639  return ok;
640 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
char * combined_name
Definition: def_struct.h:92
ptr_definition new_definition(ptr_keyword key)
new_definition
Definition: modules.c:220
ptr_definition definition
Definition: def_struct.h:96
ptr_hash_table symbol_table
Definition: def_struct.h:79
ptr_keyword keyword
Definition: def_struct.h:124
ptr_module current_module
Definition: modules.c:15
char * symbol
Definition: def_struct.h:91
ptr_definition update_symbol(ptr_module module, char *symbol)
update_symbol
Definition: modules.c:270
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_module module
Definition: def_struct.h:90
void warningline(char *format,...)
Definition: error.c:327
int public
Definition: def_struct.h:94
ptr_definition type
Definition: def_struct.h:165
void make_sys_type_links ( )

make_sys_type_links

INITIALIZATION FUNCTIONS

Definition at line 2174 of file sys.c.

References built_in, make_type_link(), sys_bitvector, sys_bytedata, sys_file_stream, sys_regexp, sys_socket_stream, and sys_stream.

2175 {
2176 #ifdef LIFE_NDBM
2177  make_ndbm_type_links();
2178 #endif
2184  make_type_link(sys_bytedata ,built_in); /* DENYS: BYTEDATA */
2185 }
ptr_definition sys_regexp
Definition: def_glob.h:131
ptr_definition sys_file_stream
Definition: def_glob.h:133
ptr_definition sys_stream
Definition: def_glob.h:132
ptr_definition sys_bitvector
Definition: def_glob.h:130
ptr_definition built_in
Definition: def_glob.h:75
void make_type_link(ptr_definition t1, ptr_definition t2)
make_type_link
Definition: types.c:901
ptr_definition sys_bytedata
Definition: def_glob.h:336
ptr_definition sys_socket_stream
Definition: def_glob.h:134
void make_type_link ( ptr_definition  t1,
ptr_definition  t2 
)

make_type_link

Parameters
ptr_definitiont1
ptr_definitiont2

MAKE_TYPE_LINK(t1,t2) Assert that T1 <| T2, this is used to initialise the built_in type relations so that nothing really horrible happens if the user modifies built-in types such as INT or LIST. This routine also makes sure that top has no links.

Definition at line 901 of file types.c.

References wl_definition::children, cons(), wl_definition::parents, top, and type_member().

902 {
903  if (t2!=top && !type_member(t2,t1->parents))
904  t1->parents=cons((GENERIC)t2,t1->parents);
905  if (t2!=top && !type_member(t1,t2->children))
906  t2->children=cons((GENERIC)t1,t2->children);
907 }
ptr_int_list cons(GENERIC v, ptr_int_list l)
cons
Definition: types.c:179
ptr_definition top
Definition: def_glob.h:106
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_int_list children
Definition: def_struct.h:131
long type_member(ptr_definition t, ptr_int_list tlst)
type_member
Definition: types.c:918
ptr_int_list parents
Definition: def_struct.h:130
ptr_goal makeGoal ( ptr_psi_term  p)

makeGoal

Definition at line 644 of file bi_sys.c.

References DEFRULES, goal_stack, wl_goal::next, NULL, prove, and push_goal().

645 {
646  ptr_goal old = goal_stack;
647  ptr_goal g;
648 
650  g = goal_stack;
651  g->next=NULL;
652  goal_stack = old;
653  return g;
654 }
#define prove
Definition: def_const.h:273
ptr_goal goal_stack
Definition: def_glob.h:50
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
push_goal
Definition: login.c:600
#define DEFRULES
Definition: def_const.h:138
#define NULL
Definition: def_const.h:203
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_goal next
Definition: def_struct.h:227
ptr_psi_term makePsiList ( GENERIC  head,
ptr_psi_term(*)()  valueFunc,
GENERIC(*)()  nextFunc 
)

makePsiList

Parameters
GENERIChead
ptr_psi_term(*valueFunc)()
GENERIC(*nextFunc)()

Definition at line 589 of file bi_sys.c.

References stack_cons(), and stack_nil().

590 {
591  ptr_psi_term result;
592 
593 
594  /* RM: Dec 14 1992: Added the new list representation */
595  result=stack_nil();
596 
597  while (head) {
598  result=stack_cons((*valueFunc)(head),result);
599  head=(*nextFunc)(head);
600  }
601  return result;
602 }
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
stack_cons
Definition: built_ins.c:46
ptr_psi_term stack_nil()
stack_nil
Definition: built_ins.c:26
ptr_psi_term makePsiTerm ( ptr_definition  x)
Parameters
ptr_definitionx

Definition at line 572 of file bi_sys.c.

References stack_psi_term(), and wl_psi_term::type.

573 {
574  ptr_psi_term p;
575 
576  p = stack_psi_term(4);
577  p->type = x;
578  return p;
579 }
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
ptr_definition type
Definition: def_struct.h:165
void mark_ancestors ( ptr_definition  def,
long *  flags 
)

mark_ancestors

Parameters
ptr_definitiondef
long*flags

Set flags bit for all ancestors (i.e., higher up) of head

Definition at line 60 of file lub.c.

References bit_length(), wl_definition::code, wl_int_list::next, wl_definition::parents, and wl_int_list::value_1.

61 {
62  ptr_int_list par;
63 
64  par=def->parents;
65  while (par) {
67  long len;
68 
69  p=(ptr_definition)par->value_1;
70  len=bit_length(p->code);
71  if (!flags[len]) {
72  flags[len]=1;
73  mark_ancestors(p, flags);
74  }
75  par=par->next;
76  }
77 }
long bit_length(ptr_int_list c)
bit_length
Definition: types.c:1753
void mark_ancestors(ptr_definition def, long *flags)
mark_ancestors
Definition: lub.c:60
struct wl_definition * ptr_definition
Definition: def_struct.h:31
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
ptr_int_list parents
Definition: def_struct.h:130
void mark_eval ( ptr_psi_term  t)

mark_eval

Parameters
ptr_psi_termt

A (possibly) correct mark_eval and its companion mark_quote.

The translation table is used to record whether a subgraph has already been quoted or not. Mark a psi-term as to be evaluated (i.e. strict), except for arguments of a nonstrict term, which are marked quoted. Set status correctly and propagate zero status upwards. Avoid doing superfluous work: non-shared terms are traversed once; shared terms are traversed at most twice (this only occurs if the first occurrence encountered is strict and a later occurrence is nonstrict). The translation table is used to indicate (1) whether a term has already been traversed, and if so, (2) whether there was a nonstrict traversal (in that case, the info field is FALSE).

Definition at line 498 of file copy.c.

References clear_copy(), FALSE, mark_eval_new(), and mark_nonstrict_flag.

499 {
500  clear_copy();
502  mark_eval_new(t);
503 }
void mark_eval_new(ptr_psi_term t)
mark_eval_new
Definition: copy.c:541
void clear_copy()
clear_copy
Definition: copy.c:53
#define FALSE
Definition: def_const.h:128
static long mark_nonstrict_flag
Definition: copy.c:479
void mark_eval_new ( ptr_psi_term  t)

mark_eval_new

Parameters
ptr_psi_termt

Definition at line 541 of file copy.c.

References wl_psi_term::attr_list, curr_status, deref_ptr, wl_definition::evaluate_args, FALSE, wl_psi_term::flags, function_it, global, insert_translation(), mark_eval_tree_new(), mark_nonstrict_flag, mark_quote_new(), mark_quote_tree_new(), wl_definition::properties, QUOTED_TRUE, wl_psi_term::status, translate(), TRUE, wl_psi_term::type, wl_definition::type_def, and type_it.

542 {
543  long *infoptr,flag;
544  ptr_psi_term u;
545  long old_status;
546 
547  if (t) {
548  deref_ptr(t);
549  flag = t->type->evaluate_args;
550  u=translate(t,&infoptr);
551  if (u) {
552  /* Quote the subgraph if it was already copied as to be evaluated. */
553  if (!flag && *infoptr) {
554  mark_quote_new(t);
555  *infoptr=FALSE;
556  }
557  /* If any subterm has zero curr_status (i.e., if t->status==0),
558  then so does the whole term: PVR 14.2.94 */
559  old_status=curr_status;
560  curr_status=(long)t->status;
561  if (curr_status) curr_status=old_status;
562  }
563  else {
565  old_status=curr_status;
566  curr_status=4;
567 
568  if (flag) /* 16.9 */
570  else
572 
573  switch((long)t->type->type_def) {
574  case type_it:
575  if (t->type->properties)
576  curr_status=0;
577  break;
578 
579  case function_it:
580  curr_status=0;
581  break;
582 
583  case global: /* RM: Feb 8 1993 */
584  curr_status=0;
585  break;
586 
587  default:
588  break;
589  }
590  if (mark_nonstrict_flag) { /* 25.8 */
591  if (curr_status) {
592  /* Only increase the status, never decrease it: */
593  t->status=curr_status;
594  }
595  }
596  else {
597  t->status=curr_status;
598  t->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
599  }
600  /* If any subterm has zero curr_status, then so does the whole term: */
601  if (curr_status) curr_status=old_status;
602  }
603  }
604 }
#define function_it
Definition: def_const.h:362
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
translate
Definition: copy.c:108
char evaluate_args
Definition: def_struct.h:136
#define global
Definition: def_const.h:364
def_type type_def
Definition: def_struct.h:133
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
insert_translation
Definition: copy.c:67
void mark_eval_tree_new(ptr_node n)
mark_eval_tree_new
Definition: copy.c:612
#define type_it
Definition: def_const.h:363
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
void mark_quote_tree_new(ptr_node n)
mark_quote_tree_new
Definition: copy.c:654
static long curr_status
Definition: copy.c:209
#define FALSE
Definition: def_const.h:128
void mark_quote_new(ptr_psi_term t)
mark_quote_new
Definition: copy.c:627
static long mark_nonstrict_flag
Definition: copy.c:479
ptr_definition type
Definition: def_struct.h:165
ptr_triple_list properties
Definition: def_struct.h:127
#define QUOTED_TRUE
Definition: def_const.h:123
ptr_node attr_list
Definition: def_struct.h:171
void mark_eval_tree_new ( ptr_node  n)

mark_eval_tree_new

Parameters
ptr_noden

Definition at line 612 of file copy.c.

References wl_node::data, wl_node::left, mark_eval_new(), mark_eval_tree_new(), and wl_node::right.

613 {
614  if (n) {
618  }
619 }
void mark_eval_new(ptr_psi_term t)
mark_eval_new
Definition: copy.c:541
GENERIC data
Definition: def_struct.h:185
void mark_eval_tree_new(ptr_node n)
mark_eval_tree_new
Definition: copy.c:612
ptr_node left
Definition: def_struct.h:183
ptr_node right
Definition: def_struct.h:184
void mark_nonstrict ( ptr_psi_term  t)

mark_nonstrict

ptr_psi_term t

Parameters
ptr_psi_termt

Same as above, except that the status is only changed from 0 to 4 when needed; it is never changed from 4 to 0.

Definition at line 514 of file copy.c.

References clear_copy(), mark_eval_new(), mark_nonstrict_flag, and TRUE.

515 {
516  clear_copy();
518  mark_eval_new(t);
519 }
void mark_eval_new(ptr_psi_term t)
mark_eval_new
Definition: copy.c:541
void clear_copy()
clear_copy
Definition: copy.c:53
#define TRUE
Definition: def_const.h:127
static long mark_nonstrict_flag
Definition: copy.c:479
void mark_quote ( ptr_psi_term  t)

mark_quote

Parameters
ptr_psi_termt

A more efficient version of mark_quote This version avoids using the translation table by setting a 'visited' in the status field. Mark a psi-term as completely evaluated.

Definition at line 675 of file copy.c.

References wl_psi_term::attr_list, wl_psi_term::coref, wl_psi_term::flags, mark_quote(), mark_quote_tree(), QUOTED_TRUE, RMASK, and wl_psi_term::status.

676 {
677  if (t && !(t->status&RMASK)) {
678  t->status = 4;
679  t->flags=QUOTED_TRUE; /* 14.9 */
680  t->status |= RMASK;
681  mark_quote(t->coref);
683  t->status &= ~RMASK;
684  }
685 }
#define RMASK
Definition: def_const.h:159
ptr_psi_term coref
Definition: def_struct.h:172
void mark_quote(ptr_psi_term t)
mark_quote
Definition: copy.c:675
#define QUOTED_TRUE
Definition: def_const.h:123
ptr_node attr_list
Definition: def_struct.h:171
void mark_quote_tree()
void mark_quote_c ( ptr_psi_term  t,
long  heap_flag 
)

mark_quote_c

Parameters
ptr_psi_termt
longheap_flag

The new mark_quote to be used from copy.

Meaning of the info field in the translation table: With u=translate(t,&infoptr): If infoptr==QUOTE_FLAG then the whole subgraph from u is quoted. If infoptr==EVAL_FLAG then anything is possible. If infoptr==QUOTE_STUB then the term does not exist yet, e.g., there is a cycle in the term & copy(...) has not created it yet, for example X:s(L,t(X),R), where non_strict(t), in which R does not exist when the call to mark_quote_c is done. When the term is later created, it must be created as quoted.

Mark a psi-term u (which is a copy of t) as completely evaluated. Only t is given as the argument. Assumes the psi-term is a copy of another psi-term t, which is made through eval_copy. Therefore the copy is accessible through the translation table. Assumes all translation table entries already exist. The infoptr field is updated so that each subgraph is only traversed once. This routine is called only from the main copy routine.

Definition at line 434 of file copy.c.

References wl_psi_term::attr_list, deref_ptr, EVAL_FLAG, wl_psi_term::flags, insert_translation(), mark_quote_tree_c(), NEW, QUOTE_FLAG, QUOTE_STUB, QUOTED_TRUE, wl_psi_term::status, and translate().

435 {
436  // ptr_list l;
437  long *infoptr;
438  ptr_psi_term u;
439 
440  if (t) {
441  deref_ptr(t);
442  u=translate(t,&infoptr);
443  /* assert(u!=NULL); 15.9 */
444  if (u) {
445  if (*infoptr==EVAL_FLAG) {
446  *infoptr=QUOTE_FLAG;
447  u->status=4;
448  u->flags=QUOTED_TRUE; /* 14.9 */
449  mark_quote_tree_c(t->attr_list,heap_flag);
450  }
451  }
452  else { /* u does not exist yet */ /* 15.9 */
453  /* Create a stub & mark it as to-be-quoted. */
454  u=NEW(t,psi_term);
456  }
457  }
458 }
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
translate
Definition: copy.c:108
void mark_quote_tree_c(ptr_node n, long heap_flag)
mark_quote_tree_c
Definition: copy.c:467
#define QUOTE_STUB
Definition: def_const.h:329
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
insert_translation
Definition: copy.c:67
#define NEW(A, TYPE)
Definition: def_macro.h:279
#define EVAL_FLAG
Definition: def_const.h:327
#define deref_ptr(P)
Definition: def_macro.h:95
#define QUOTE_FLAG
Definition: def_const.h:326
#define QUOTED_TRUE
Definition: def_const.h:123
ptr_node attr_list
Definition: def_struct.h:171
void mark_quote_new ( ptr_psi_term  t)

mark_quote_new

Parameters
ptr_psi_termt

Definition at line 627 of file copy.c.

References wl_psi_term::attr_list, deref_ptr, FALSE, wl_psi_term::flags, insert_translation(), mark_quote_tree_new(), QUOTED_TRUE, wl_psi_term::status, translate(), and TRUE.

628 {
629  long *infoptr;
630  ptr_psi_term u;
631 
632  if (t) {
633  deref_ptr(t);
634  u=translate(t,&infoptr);
635 
636  /* Return if the subgraph is already quoted. */
637  if (u && !*infoptr) return;
638 
639  /* Otherwise quote the subgraph */
641  else *infoptr = FALSE; /* sanjay */
642  t->status= 4;
643  t->flags=QUOTED_TRUE; /* 14.9 */
645  }
646 }
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
translate
Definition: copy.c:108
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
insert_translation
Definition: copy.c:67
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
void mark_quote_tree_new(ptr_node n)
mark_quote_tree_new
Definition: copy.c:654
#define FALSE
Definition: def_const.h:128
#define QUOTED_TRUE
Definition: def_const.h:123
ptr_node attr_list
Definition: def_struct.h:171
void mark_quote_new2 ( ptr_psi_term  t)

mark_quote_new2

Parameters
ptr_psi_termt

Mark a term as quoted.

Definition at line 528 of file copy.c.

References clear_copy(), FALSE, mark_nonstrict_flag, and mark_quote_new().

529 {
530  clear_copy();
532  mark_quote_new(t);
533 }
void clear_copy()
clear_copy
Definition: copy.c:53
#define FALSE
Definition: def_const.h:128
void mark_quote_new(ptr_psi_term t)
mark_quote_new
Definition: copy.c:627
static long mark_nonstrict_flag
Definition: copy.c:479
void mark_quote_tree ( ptr_node  t)

mark_quote_tree

Parameters
ptr_nodet

Definition at line 693 of file copy.c.

References wl_node::data, wl_node::left, mark_quote(), mark_quote_tree(), and wl_node::right.

694 {
695  if (t) {
696  mark_quote_tree(t->left);
697  mark_quote((ptr_psi_term) (t->data));
699  }
700 }
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
void mark_quote(ptr_psi_term t)
mark_quote
Definition: copy.c:675
void mark_quote_tree()
ptr_node right
Definition: def_struct.h:184
void mark_quote_tree_c ( ptr_node  n,
long  heap_flag 
)

mark_quote_tree_c

Parameters
ptr_noden
longheap_flag

Definition at line 467 of file copy.c.

References wl_node::data, wl_node::left, mark_quote_c(), mark_quote_tree_c(), and wl_node::right.

468 {
469  if (n) {
470  mark_quote_tree_c(n->left,heap_flag);
471  mark_quote_c((ptr_psi_term) (n->data),heap_flag);
472  mark_quote_tree_c(n->right,heap_flag);
473  }
474 }
void mark_quote_tree_c(ptr_node n, long heap_flag)
mark_quote_tree_c
Definition: copy.c:467
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
void mark_quote_c(ptr_psi_term t, long heap_flag)
mark_quote_c
Definition: copy.c:434
ptr_node right
Definition: def_struct.h:184
void mark_quote_tree_new ( ptr_node  n)

mark_quote_tree_new

void mark_quote_tree_new(ptr_node n)

Parameters
ptr_noden

Definition at line 654 of file copy.c.

References wl_node::data, wl_node::left, mark_quote_new(), mark_quote_tree_new(), and wl_node::right.

655 {
656  if (n) {
660  }
661 }
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
void mark_quote_tree_new(ptr_node n)
mark_quote_tree_new
Definition: copy.c:654
void mark_quote_new(ptr_psi_term t)
mark_quote_new
Definition: copy.c:627
ptr_node right
Definition: def_struct.h:184
void mark_tab ( ptr_tab_brk  t)

mark_tab

Parameters
ptr_tab_brkt

MARK_TAB(t) Mark a tabbing position T. Make the current item point to tabbing position T.

Definition at line 573 of file print.c.

References end_tab(), indx, and wl_item::tab.

574 {
575  end_tab();
576  indx->tab=t;
577 }
ptr_tab_brk tab
Definition: def_struct.h:312
ptr_item indx
Definition: def_glob.h:329
long match_aim ( )

match_aim

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

Definition at line 770 of file lefun.c.

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

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

match_attr

Parameters
ptr_node*u
ptr_nodev
ptr_resid_blockrb

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

Definition at line 752 of file lefun.c.

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

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

void match_attr1

Parameters
ptr_node*u
ptr_nodev
ptr_resid_blockrb

Match the corresponding arguments

Definition at line 599 of file lefun.c.

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

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

match_attr2

Parameters
ptr_node*u
ptr_nodev
ptr_resid_blockrb

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

Definition at line 644 of file lefun.c.

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

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

match_attr3

Parameters
ptr_node*u
ptr_nodev
ptr_resid_blockrb

Evaluate the corresponding arguments

Definition at line 700 of file lefun.c.

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

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

matches

Parameters
ptr_definitiont1
ptr_definitiont2
long*smaller

MATCHES(t1,t2,s) Returns TRUE if GLB(t1,t2)!=bottom. Sets S to TRUE if type T1 is <| than type T2, that is if T1 matches T2.

Definition at line 1666 of file types.c.

References wl_definition::code, FALSE, wl_int_list::next, NOT_CODED, top, TRUE, and wl_int_list::value_1.

1667 {
1668  ptr_int_list c1,c2;
1669  long result=TRUE;
1670 
1671  *smaller=TRUE;
1672 
1673  if (t1!=t2)
1674  if (t2!=top)
1675  if (t1==top)
1676  *smaller=FALSE;
1677  else {
1678  c1=t1->code;
1679  c2=t2->code;
1680  result=FALSE;
1681 
1682  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1683  while (c1 && c2) {
1684  if ((unsigned long)c1->value_1 & (unsigned long)c2->value_1) result=TRUE;
1685  if ((unsigned long)c1->value_1 & ~(unsigned long)c2->value_1) *smaller=FALSE;
1686  c1=c1->next;
1687  c2=c2->next;
1688  }
1689  }
1690  else
1691  *smaller=FALSE;
1692  }
1693 
1694  return result;
1695 }
#define NOT_CODED
Definition: def_const.h:134
ptr_definition top
Definition: def_glob.h:106
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
long memory_check ( )

memory_check

MEMORY_CHECK() This function tests to see whether enough memory is available to allow execution to continue. It causes a garbage collection if not, and if that fails to release enough memory it returns FALSE.

Definition at line 1723 of file memory.c.

References fail_all(), FALSE, garbage(), GC_THRESHOLD, heap_pointer, stack_pointer, TRUE, and verbose.

1724 {
1725  long success=TRUE;
1726 
1728  if(verbose) fprintf(stderr,"\n"); /* RM: Feb 1 1993 */
1729  garbage();
1730  /* Abort if didn't recover at least GC_THRESHOLD/10 of memory */
1732  fprintf(stderr,"*********************\n");
1733  fprintf(stderr,"*** OUT OF MEMORY ***\n");
1734  fprintf(stderr,"*********************\n");
1735  fail_all();
1736  success=FALSE;
1737  }
1738  }
1739  return success;
1740 }
void fail_all()
fail_all
Definition: memory.c:188
long verbose
Definition: def_glob.h:273
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC heap_pointer
Definition: def_glob.h:12
void garbage()
garbage
Definition: memory.c:1529
#define GC_THRESHOLD
Definition: def_const.h:65
GENERIC stack_pointer
Definition: def_glob.h:14
void merge ( ptr_node u,
ptr_node  v 
)

merge

Parameters
ptr_node*u
ptr_nodev

MERGE(u,v) U and V are two binary trees containing the attributes fields of psi-terms. U and V are merged together, that is U becomes the union of U and V: For each label L in V and L->Vpsi_term: If L is in U Then With L->Upsi_term Do unify(Upsi_term,Vpsi_term) Else merge L->Vpsi_term in U. Unification is simply done by appending the 2 psi_terms to the unification stack. All effects must be recorded in the trail so that they can be undone on backtracking.

Definition at line 1131 of file login.c.

References merge1(), merge2(), and merge3().

1132 {
1133  merge1(u,v); /* Unify corresponding arguments */
1134  merge2(u,v); /* Evaluate lone arguments (lazy failure + eager success) */
1135  merge3(u,v); /* Merge v's loners into u & evaluate corresponding arguments */
1136 }
void merge2(ptr_node *u, ptr_node v)
merge2
Definition: login.c:949
void merge3(ptr_node *u, ptr_node v)
merge3
Definition: login.c:1004
void merge1(ptr_node *u, ptr_node v)
merge1
Definition: login.c:893
void merge1 ( ptr_node u,
ptr_node  v 
)

merge1

Parameters
ptr_node*u
ptr_nodev

Unify the corresponding arguments

Definition at line 893 of file login.c.

References wl_node::data, featcmp(), wl_node::key, wl_node::left, NULL, push_goal(), wl_node::right, and unify.

894 {
895  long cmp;
896  ptr_node temp;
897 
898  if (v) {
899  if (*u==NULL) {
900  /* push_ptr_value(int_ptr,u); */
901  /* (*u)=STACK_ALLOC(node); */
902  /* **u= *v; */
903  /* more_v_attr=TRUE; */
904  }
905  else {
906  cmp=featcmp((*u)->key,v->key);
907  if (cmp==0) {
908  if (v->right)
909  merge1(&((*u)->right),v->right);
910 
912 
913  if (v->left)
914  merge1(&((*u)->left),v->left);
915  }
916  else if (cmp>0) {
917  temp=v->right;
918  v->right=NULL;
919  merge1(&((*u)->left),v);
920  merge1(u,temp);
921  v->right=temp;
922  }
923  else {
924  temp=v->left;
925  v->left=NULL;
926  merge1(&((*u)->right),v);
927  merge1(u,temp);
928  v->left=temp;
929  }
930  }
931  }
932  else if (*u!=NULL) {
933  /* more_u_attr=TRUE; */
934  }
935 }
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
push_goal
Definition: login.c:600
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
#define unify
Definition: def_const.h:274
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
ptr_node right
Definition: def_struct.h:184
void merge1(ptr_node *u, ptr_node v)
merge1
Definition: login.c:893
merge2 ( ptr_node u,
ptr_node  v 
)

merge2

Parameters
ptr_node*u
ptr_nodev

Evaluate the lone arguments (For LAZY failure + EAGER success) Evaluate low numbered lone arguments first. For each lone argument in either u or v, create a new psi-term to put the (useless) result: This is needed so that all arguments of a uni- unified psi-term are evaluated, which avoids incorrect 'Yes' answers.

Definition at line 949 of file login.c.

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

950 {
951  long cmp;
952  ptr_node temp;
953 
954  if (v) {
955  if (*u==NULL) {
956  ptr_psi_term t;
957  merge2(u,v->right);
958  t = (ptr_psi_term) v->data;
959  deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
960  merge2(u,v->left);
961  }
962  else {
963  cmp=featcmp((*u)->key,v->key);
964  if (cmp==0) {
965  /* if (v->right) */
966  merge2(&((*u)->right),v->right);
967 
968  /* if (v->left) */
969  merge2(&((*u)->left),v->left);
970  }
971  else if (cmp>0) {
972  temp=v->right;
973  v->right=NULL;
974  merge2(&((*u)->left),v);
975  merge2(u,temp);
976  v->right=temp;
977  }
978  else {
979  temp=v->left;
980  v->left=NULL;
981  merge2(&((*u)->right),v);
982  merge2(u,temp);
983  v->left=temp;
984  }
985  }
986  }
987  else if (*u!=NULL) {
988  ptr_psi_term t;
989  merge2(&((*u)->right),v);
990  t = (ptr_psi_term) (*u)->data;
991  deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
992  merge2(&((*u)->left),v);
993  }
994 }
void deref2_rec_eval(ptr_psi_term t)
deref2_rec_eval
Definition: lefun.c:1382
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
void merge2(ptr_node *u, ptr_node v)
merge2
Definition: login.c:949
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_node right
Definition: def_struct.h:184
void merge3 ( ptr_node u,
ptr_node  v 
)

merge3

Parameters
ptr_node*u
ptr_nodev

Merge v's loners into u and evaluate the corresponding arguments

Definition at line 1004 of file login.c.

References deref2_eval(), featcmp(), int_ptr, wl_node::key, wl_node::left, more_u_attr, more_v_attr, NULL, push_ptr_value(), wl_node::right, STACK_ALLOC, and TRUE.

1005 {
1006  long cmp;
1007  ptr_node temp;
1008 
1009  if (v) {
1010  if (*u==NULL) {
1012  (*u)=STACK_ALLOC(node);
1013  **u= *v;
1014  more_v_attr=TRUE;
1015  }
1016  else {
1017  ptr_psi_term t1; // ,t2;
1018 
1019  cmp=featcmp((*u)->key,v->key);
1020  if (cmp==0) {
1021  if (v->right)
1022  merge3(&((*u)->right),v->right);
1023 
1024  t1 = (ptr_psi_term) (*u)->data;
1025  /* t2 = (ptr_psi_term) v->data; */
1026  deref2_eval(t1);
1027  /* deref2_eval(t2); */
1028  /* push_goal(unify,(ptr_psi_term)(*u)->data,(ptr_psi_term)v->data,NULL); */
1029 
1030  if (v->left)
1031  merge3(&((*u)->left),v->left);
1032  }
1033  else if (cmp>0) {
1034  temp=v->right;
1035  v->right=NULL;
1036  merge3(&((*u)->left),v);
1037  merge3(u,temp);
1038  v->right=temp;
1039  }
1040  else {
1041  temp=v->left;
1042  v->left=NULL;
1043  merge3(&((*u)->right),v);
1044  merge3(u,temp);
1045  v->left=temp;
1046  }
1047  }
1048  }
1049  else if (*u!=NULL) {
1050  more_u_attr=TRUE;
1051  }
1052 }
long more_u_attr
Definition: def_glob.h:303
void deref2_eval(ptr_psi_term t)
deref2_eval
Definition: lefun.c:1356
#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
void merge3(ptr_node *u, ptr_node v)
merge3
Definition: login.c:1004
#define STACK_ALLOC(A)
Definition: def_macro.h:16
long featcmp(char *str1, char *str2)
featcmp
Definition: trees.c:106
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
unsigned long * GENERIC
Definition: def_struct.h:17
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
long more_v_attr
Definition: def_glob.h:304
ptr_node right
Definition: def_struct.h:184
#define int_ptr
Definition: def_const.h:172
void merge_unify ( ptr_node u,
ptr_node  v 
)
Parameters
merge_unify
ptr_node*u
ptr_nodev

For built-ins.c

Definition at line 1146 of file login.c.

References merge1(), and merge3().

1147 {
1148  merge1(u,v); /* Unify corresponding arguments */
1149  merge3(u,v); /* Merge v's loners into u & evaluate corresponding arguments */
1150 }
void merge3(ptr_node *u, ptr_node v)
merge3
Definition: login.c:1004
void merge1(ptr_node *u, ptr_node v)
merge1
Definition: login.c:893
long mod_warning ( ptr_psi_term  arg,
REAL  val,
int  zero 
)

Definition at line 852 of file error.c.

References Errorline(), nonint_warning(), and TRUE.

856 {
857  int err;
858 
859  err=nonint_warning(arg,val,"of modulo operation is not an integer");
860  if(!err && zero && val==0) {
861  Errorline("division by 0 in modulo operation\n");
862  err=TRUE;
863  }
864  return err;
865 }
long nonint_warning(ptr_psi_term arg, REAL val, char *msg)
Definition: error.c:810
void Errorline(char *format,...)
Definition: error.c:414
#define TRUE
Definition: def_const.h:127
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)
update_symbol
Definition: modules.c:270
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)
set_current_module
Definition: modules.c:100
ptr_definition new_definition ( ptr_keyword  key)

new_definition

Parameters
ptr_keywordkey

NEW_DEFINITION(key) Create a definition for a key.

Definition at line 220 of file modules.c.

References wl_definition::already_loaded, wl_definition::always_check, wl_definition::children, wl_definition::code, wl_definition::date, wl_keyword::definition, wl_definition::evaluate_args, FALSE, first_definition, wl_definition::global_value, HEAP_ALLOC, wl_definition::init_value, wl_definition::keyword, wl_definition::next, NOT_CODED, NULL, wl_definition::op_data, wl_definition::parents, wl_definition::properties, wl_definition::protected, wl_definition::rule, TRUE, wl_definition::type_def, and undef.

221 {
222  ptr_definition result;
223 
224 
225  /* printf("*** New definition: %s\n",key->combined_name); */
226 
227  /* Create a new definition */
228  result=HEAP_ALLOC(struct wl_definition);
229 
230  /* RM: Feb 3 1993 */
231  result->next=first_definition; /* Linked list of all definitions */
232  first_definition=result;
233 
234  result->keyword=key;
235  result->rule=NULL;
236  result->properties=NULL;
237  result->date=0;
238  result->type_def=(def_type)undef;
239  result->always_check=TRUE;
240  result->protected=TRUE;
241  result->evaluate_args=TRUE;
242  result->already_loaded=FALSE;
243  result->children=NULL;
244  result->parents=NULL;
245  result->code=NOT_CODED;
246  result->op_data=NULL;
247  result->global_value=NULL; /* RM: Feb 8 1993 */
248  result->init_value=NULL; /* RM: Mar 23 1993 */
249  key->definition=result;
250 
251  return result;
252 }
char already_loaded
Definition: def_struct.h:137
ptr_psi_term init_value
Definition: def_struct.h:142
struct wl_definition * def_type
Definition: def_struct.h:32
char evaluate_args
Definition: def_struct.h:136
#define NOT_CODED
Definition: def_const.h:134
#define undef
Definition: def_const.h:360
ptr_definition definition
Definition: def_struct.h:96
def_type type_def
Definition: def_struct.h:133
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
char always_check
Definition: def_struct.h:134
ptr_definition next
Definition: def_struct.h:148
#define TRUE
Definition: def_const.h:127
ptr_definition first_definition
Definition: def_glob.h:3
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
ptr_int_list code
Definition: def_struct.h:129
ptr_triple_list properties
Definition: def_struct.h:127
ptr_int_list children
Definition: def_struct.h:131
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_operator_data op_data
Definition: def_struct.h:139
ptr_int_list parents
Definition: def_struct.h:130
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
void new_state ( ptr_psi_term t)

new_state

Parameters
ptr_psi_term*t

Create a new file state psi-term that reflects the current global state

Definition at line 372 of file token.c.

References current_module, CURRENT_MODULE, eof_flag, EOF_FLAG, heap_add_int_attr(), heap_add_psi_attr(), heap_add_str_attr(), heap_psi_term(), input_file_name, INPUT_FILE_NAME, input_stream, inputfilesym, lf_false, lf_true, line_count, LINE_COUNT, wl_module::module_name, null_psi_term, old_saved_char, OLD_SAVED_CHAR, old_saved_psi_term, OLD_SAVED_PSI_TERM, saved_char, SAVED_CHAR, saved_psi_term, SAVED_PSI_TERM, start_of_line, START_OF_LINE, stream, STREAM, wl_psi_term::type, and wl_psi_term::value_3.

373 {
374  ptr_psi_term t1;
375 
376  *t=heap_psi_term(4);
377  (*t)->type=inputfilesym;
378 
379  t1=heap_psi_term(4);
380  t1->type=stream;
382  heap_add_psi_attr(*t,STREAM,t1);
383 
384  /* RM: Jan 27 1993 */
386 
387  /*
388  printf("Creating new state for file '%s', module '%s'\n",
389  input_file_name,
390  current_module->module_name);
391  */
392 
397 
400 
403 
404  t1=heap_psi_term(4);
407 
408  t1=heap_psi_term(4);
411 }
#define LINE_COUNT
Definition: def_const.h:227
ptr_module current_module
Definition: def_glob.h:161
long eof_flag
Definition: def_glob.h:196
ptr_definition stream
Definition: def_glob.h:103
long start_of_line
Definition: def_glob.h:191
string input_file_name
Definition: def_glob.h:40
#define SAVED_PSI_TERM
Definition: def_const.h:231
ptr_psi_term heap_psi_term(long stat)
heap_psi_term
Definition: lefun.c:75
#define OLD_SAVED_CHAR
Definition: def_const.h:230
ptr_psi_term null_psi_term
Definition: def_glob.h:140
#define CURRENT_MODULE
Definition: def_const.h:234
long old_saved_char
Definition: def_glob.h:193
long saved_char
Definition: def_glob.h:192
long line_count
Definition: def_glob.h:39
#define STREAM
Definition: def_const.h:225
#define START_OF_LINE
Definition: def_const.h:228
void heap_add_str_attr(ptr_psi_term t, char *attrname, char *str)
heap_add_str_attr
Definition: token.c:151
void heap_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
heap_add_psi_attr
Definition: token.c:226
ptr_definition lf_true
Definition: def_glob.h:107
FILE * input_stream
Definition: def_glob.h:38
ptr_definition lf_false
Definition: def_glob.h:89
GENERIC value_3
Definition: def_struct.h:170
#define INPUT_FILE_NAME
Definition: def_const.h:226
char * module_name
Definition: def_struct.h:75
#define OLD_SAVED_PSI_TERM
Definition: def_const.h:232
void heap_add_int_attr(ptr_psi_term t, char *attrname, long value)
heap_add_int_attr
Definition: token.c:74
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
#define EOF_FLAG
Definition: def_const.h:233
ptr_definition type
Definition: def_struct.h:165
#define SAVED_CHAR
Definition: def_const.h:229
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_definition inputfilesym
Definition: def_glob.h:120
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
void new_step ( long  newstep)

Definition at line 629 of file error.c.

References FALSE, new_trace(), stepflag, and steptrace.

631 {
632  stepflag = newstep;
633  printf("*** Single stepping is turned ");
634  printf(stepflag?"on.\n":"off.\n");
637 }
long steptrace
Definition: error.c:21
void new_trace(long newtrace)
Definition: error.c:619
#define FALSE
Definition: def_const.h:128
long stepflag
Definition: error.c:20
void new_tab ( ptr_tab_brk t)

new_tab

Parameters
ptr_tab_brk*t

NEW_TAB(t) Create a new tabulation mark T.

Definition at line 587 of file print.c.

References FALSE, and HEAP_ALLOC.

588 {
589  (*t)=HEAP_ALLOC(tab_brk);
590  (*t)->broken=FALSE;
591  (*t)->printed=FALSE;
592  (*t)->column=0;
593 }
#define FALSE
Definition: def_const.h:128
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
void new_trace ( long  newtrace)

Definition at line 619 of file error.c.

References trace.

621 {
622  trace = newtrace;
623  printf("*** Tracing is turned ");
624  printf(trace?"on.":"off.");
625  if (trace == 2) printf(" Only for Proves");
626  printf("\n");
627 }
long trace
Definition: error.c:18
long no_choices ( )

no_choices

Return TRUE iff the top choice point is a what_next choice point or if there are no choice points.

Definition at line 1945 of file login.c.

References choice_stack, wl_choice_point::goal_stack, NULL, wl_goal::type, and what_next.

1946 {
1948 }
#define NULL
Definition: def_const.h:203
goals type
Definition: def_struct.h:223
#define what_next
Definition: def_const.h:277
ptr_goal goal_stack
Definition: def_struct.h:234
ptr_choice_point choice_stack
Definition: def_glob.h:51
long no_quote ( char *  s)

no_quote

Parameters
char*s

Return TRUE if s does not have to be quoted, i.e., s starts with '_' or a lowercase symbol and contains all digits, letters, and '_'.

Definition at line 470 of file print.c.

References all_symbol(), FALSE, ISALPHA, LOWER, SINGLE, and TRUE.

471 {
472  if (!s[0]) return FALSE;
473 
474  if (s[0]=='%') return FALSE;
475  if (SINGLE(s[0]) && s[1]==0) return TRUE;
476  if (s[0]=='_' && s[1]==0) return FALSE;
477  if (all_symbol(s)) return TRUE;
478 
479  if (!LOWER(s[0])) return FALSE;
480  s++;
481  while (*s) {
482  if (!ISALPHA(*s)) return FALSE;
483  s++;
484  }
485  return TRUE;
486 }
#define ISALPHA(C)
Definition: def_macro.h:43
#define LOWER(C)
Definition: def_macro.h:41
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define SINGLE(C)
Definition: def_macro.h:47
long nonint_warning ( ptr_psi_term  arg,
REAL  val,
char *  msg 
)

Definition at line 810 of file error.c.

References FALSE, report_warning2(), and TRUE.

814 {
815  long err=FALSE;
816 
817  if (val!=floor(val)) {
818  report_warning2(arg, msg);
819  err=TRUE;
820  }
821  return err;
822 }
void report_warning2(ptr_psi_term g, char *s)
Definition: error.c:785
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
void nonnum_warning ( ptr_psi_term  t,
ptr_psi_term  arg1,
ptr_psi_term  arg2 
)

Definition at line 796 of file error.c.

References curried, overlap_type(), real, and report_warning().

798 {
799  if (!curried && /* PVR 15.9.93 */
800  ((arg1 && !overlap_type(arg1->type,real)) ||
801  (arg2 && !overlap_type(arg2->type,real)))) {
802  report_warning(t,"non-numeric argument(s)");
803  }
804 }
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
ptr_definition real
Definition: def_glob.h:102
long curried
Definition: def_glob.h:223
ptr_definition type
Definition: def_struct.h:165
void report_warning(ptr_psi_term g, char *s)
Definition: error.c:746
long num_choices ( )

num_choices

Return the number of choice points on the choice point stack

Definition at line 1956 of file login.c.

References choice_stack, and wl_choice_point::next.

1957 {
1958  long num;
1959  ptr_choice_point cp;
1960 
1961  num=0;
1962  cp=choice_stack;
1963  while (cp) {
1964  num++;
1965  cp=cp->next;
1966  }
1967  return num;
1968 }
ptr_choice_point next
Definition: def_struct.h:235
ptr_choice_point choice_stack
Definition: def_glob.h:51
long num_vars ( ptr_node  vt)

num_vars

Parameters
ptr_nodevt

Return the number of variables in the variable tree.

Definition at line 1976 of file login.c.

References wl_node::left, and wl_node::right.

1977 {
1978  return (vt?(num_vars(vt->left)+1+num_vars(vt->right)):0);
1979 }
long num_vars(ptr_node vt)
num_vars
Definition: login.c:1976
ptr_node left
Definition: def_struct.h:183
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
void one_pass_always_check ( long *  ch)

one_pass_always_check

Parameters
long*ch
    ONE_PASS_ALWAYS_CHECK(ch)
Go through the symbol table & propagate all FALSE always_check flags of all sorts to their children. Return a TRUE flag if a change was made somewhere (for the closure calculation).

Definition at line 1049 of file types.c.

References wl_definition::always_check, first_definition, wl_definition::next, propagate_always_check(), wl_definition::type_def, and type_it.

1050 {
1051  ptr_definition d;
1052 
1053 
1054  for(d=first_definition;d;d=d->next)
1055  if (d->type_def==(def_type)type_it && !d->always_check)
1056  propagate_always_check(d,ch);
1057 }
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
ptr_definition next
Definition: def_struct.h:148
void propagate_always_check(ptr_definition d, long *ch)
propagate_always_check
Definition: types.c:1022
ptr_definition first_definition
Definition: def_glob.h:3
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)
featcmp
Definition: trees.c:106
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
long opcheck ( ptr_psi_term  t,
long *  prec,
long *  type 
)

opcheck

Parameters
ptr_psi_termt
long*prec
long*type)

Get information about an operator. If t is an operator with the correct arguments, return one of {INFIX, PREFIX, POSTFIX} and also its precedence and type. If t is not an operator, or it has wrong arguments, return NOTOP and prec=0.

Definition at line 913 of file print.c.

References wl_psi_term::attr_list, check_opargs(), fx, fy, INFIX, wl_operator_data::next, NOTOP, NULL, wl_definition::op_data, POSTFIX, wl_operator_data::precedence, PREFIX, wl_psi_term::type, xf, xfx, xfy, yf, and yfx.

914 {
915  long op;
916  long result=NOTOP;
917  long numarg=check_opargs(t->attr_list);
918  ptr_operator_data opdat=t->type->op_data;
919 
920  *prec=0;
921  if (numarg!=1 && numarg!=3) return NOTOP;
922  while (opdat) {
923  op=opdat->type;
924  if (numarg==1) {
925  if (op==xf || op==yf) { result=POSTFIX; break; }
926  if (op==fx || op==fy) { result=PREFIX; break; }
927  }
928  if (numarg==3)
929  if (op==xfx || op==xfy || op==yfx) { result=INFIX; break; }
930  opdat=opdat->next;
931  }
932  if (opdat==NULL) return NOTOP;
933  *prec=opdat->precedence;
934  *type=op;
935  return result;
936 }
#define yfx
Definition: def_const.h:268
#define xfx
Definition: def_const.h:265
#define POSTFIX
Definition: def_const.h:340
ptr_operator_data next
Definition: def_struct.h:49
#define fx
Definition: def_const.h:262
#define NULL
Definition: def_const.h:203
#define xfy
Definition: def_const.h:267
#define PREFIX
Definition: def_const.h:339
#define xf
Definition: def_const.h:261
#define INFIX
Definition: def_const.h:338
#define yf
Definition: def_const.h:263
#define NOTOP
Definition: def_const.h:337
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
ptr_operator_data op_data
Definition: def_struct.h:139
#define fy
Definition: def_const.h:264
long open_input_file ( char *  file)

open_input_file

Parameters
char*file

OPEN_INPUT_FILE(file) Open the input file specified by the string FILE. If the file is "stdin", restore the stdin state. Otherwise, open the file and create a new global state for it. If the file can't be opened, print an error and open "stdin" instead.

Definition at line 594 of file token.c.

References Errorline(), expand_file_name(), FALSE, init_parse_state(), input_file_name, input_state, input_stream, new_state(), noisy, NULL, restore_state(), save_state(), stdin_state, and TRUE.

595 {
596  long ok=TRUE;
597  long stdin_flag;
598 
599  /* Save global input file state */
601 
602  file=expand_file_name(file);
603 
604  if ((stdin_flag=(!strcmp(file,"stdin")))) {
605  input_stream=stdin;
606  noisy=TRUE;
607  }
608  else {
609  input_stream=fopen(file,"r");
610  noisy=FALSE;
611  }
612 
613  if (input_stream==NULL) {
614  Errorline("file '%s' does not exist.\n",file);
615  file="stdin";
616  input_stream=stdin;
617  noisy=TRUE;
618  ok=FALSE;
619  }
620 
621  if (!stdin_flag || stdin_state==NULL) {
622  /* Initialize a new global input file state */
623  strcpy(input_file_name,file);
625  /* Create a new state containing the new global values */
627  if (stdin_flag) stdin_state=input_state;
628  }
629  else {
632  }
633 
634  return ok;
635 }
void init_parse_state()
init_parse_state
Definition: token.c:464
ptr_psi_term stdin_state
Definition: def_glob.h:200
string input_file_name
Definition: def_glob.h:40
void save_state(ptr_psi_term t)
save_state
Definition: token.c:293
#define NULL
Definition: def_const.h:203
ptr_psi_term input_state
Definition: def_glob.h:199
long noisy
Definition: def_glob.h:35
void Errorline(char *format,...)
Definition: error.c:414
void restore_state(ptr_psi_term t)
restore_state
Definition: token.c:334
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
FILE * input_stream
Definition: def_glob.h:38
char * expand_file_name(char *s)
expand_file_name
Definition: token.c:537
void new_state(ptr_psi_term *t)
new_state
Definition: token.c:372
void open_module_one ( ptr_psi_term  t,
int *  onefailed 
)

open_module_one

Parameters
ptr_psi_termt
int*onefailed

Definition at line 562 of file modules.c.

References wl_keyword::combined_name, wl_keyword::definition, Errorline(), FALSE, find_module(), hash_lookup(), HEAP_ALLOC, wl_int_list::next, wl_module::open_modules, wl_keyword::public, string_val(), wl_keyword::symbol, wl_module::symbol_table, TRUE, and wl_int_list::value_1.

563 {
564  ptr_module open_module;
565  ptr_int_list opens;
566  ptr_keyword key1,key2;
567  int i;
568  int found=FALSE;
569 
570  open_module=find_module(string_val(t));
571  if (open_module) {
572 
573  for (opens=current_module->open_modules;opens;opens=opens->next)
574  if (opens->value_1 == (GENERIC)open_module) {
575  /* warningline("module \"%s\" is already open\n",
576  open_module->module_name); */ /* RM: Jan 27 1993 */
577  found=TRUE;
578  }
579 
580  if (!found) {
581  opens=HEAP_ALLOC(struct wl_int_list);
582  opens->value_1=(GENERIC)open_module;
585 
586  /* Check for name conflicts */
587  /* RM: Feb 23 1993 */
588  for (i=0;i<open_module->symbol_table->size;i++)
589  if ((key1=open_module->symbol_table->data[i]) && key1->public) {
591  if (key2 && key1->definition!=key2->definition)
592  Errorline("symbol clash '%s' and '%s'\n",
593  key1->combined_name,
594  key2->combined_name);
595  }
596  }
597  }
598  else {
599  Errorline("module \"%s\" not found\n",string_val(t));
600  *onefailed=TRUE;
601  }
602 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
char * combined_name
Definition: def_struct.h:92
ptr_definition definition
Definition: def_struct.h:96
ptr_hash_table symbol_table
Definition: def_struct.h:79
ptr_module current_module
Definition: modules.c:15
char * symbol
Definition: def_struct.h:91
void Errorline(char *format,...)
Definition: error.c:414
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_int_list open_modules
Definition: def_struct.h:77
char * string_val(ptr_psi_term term)
string_val
Definition: modules.c:169
ptr_module find_module(char *module)
find_module
Definition: modules.c:54
int public
Definition: def_struct.h:94
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
void open_module_tree ( ptr_node  n,
int *  onefailed 
)

open_module_tree

Parameters
ptr_noden
int*onefailed

Definition at line 542 of file modules.c.

References wl_node::data, wl_node::left, open_module_one(), and wl_node::right.

543 {
544  if (n) {
545  ptr_psi_term t;
546  open_module_tree(n->left,onefailed);
547 
548  t=(ptr_psi_term)n->data;
549  open_module_one(t,onefailed);
550 
551  open_module_tree(n->right,onefailed);
552  }
553 }
void open_module_tree(ptr_node n, int *onefailed)
open_module_tree
Definition: modules.c:542
GENERIC data
Definition: def_struct.h:185
void open_module_one(ptr_psi_term t, int *onefailed)
open_module_one
Definition: modules.c:562
ptr_node left
Definition: def_struct.h:183
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_node right
Definition: def_struct.h:184
long open_output_file ( char *  file)
void or_codes ( ptr_int_list  u,
ptr_int_list  v 
)

or_codes

Parameters
ptr_int_listu
ptr_int_listv

OR_CODES(code1,code2) Performs CODE1 := CODE1 or CODE2, 'or' being the binary logical operator on bits.

Definition at line 831 of file types.c.

References HEAP_ALLOC, wl_int_list::next, NULL, and wl_int_list::value_1.

832 {
833  while (v) {
834  u->value_1= (GENERIC)(((unsigned long)(u->value_1)) | ((unsigned long)(v->value_1)));
835  v=v->next;
836  if (u->next==NULL && v) {
838  u=u->next;
839  u->value_1=0;
840  u->next=NULL;
841  }
842  else
843  u=u->next;
844  }
845 }
#define NULL
Definition: def_const.h:203
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
void outputline ( char *  format,
  ... 
)

Definition at line 79 of file error.c.

References assert, display_psi(), FALSE, input_file_name, output_stream, parse_ok, perr_i(), perr_s(), print_code(), print_def_type(), print_operator_kind(), and psi_term_line_number.

80 {
81  va_list VarArg;
82  // int l;
83  char buffer_loc[5];
84  char *p;
85  unsigned long lng2;
86  char *cptr;
87  ptr_int_list pil;
88  ptr_psi_term psi;
89  operator kind;
90  def_type t ;
91  va_start(VarArg,format);
92  // vinfoline(format,output_stream, VarArg);
93  // #define vinfoline(format, outfile, xxxx) {
94  for (p=format;p && *p; p++)
95  {
96  if (*p == '%')
97  {
98  p++;
99  switch (*p)
100  {
101  case 'd':
102  case 'x':
103  buffer_loc[0] = '%';
104  buffer_loc[1] = 'l';
105  buffer_loc[2] = *p;
106  buffer_loc[3] = 0;
107  lng2 = va_arg(VarArg, long);
108  fprintf(output_stream, buffer_loc, lng2);
109  break;
110  case 's':
111  buffer_loc[0] = '%';
112  buffer_loc[1] = *p;
113  buffer_loc[2] = 0;
114  cptr = va_arg(VarArg,char *);
115  fprintf(output_stream, buffer_loc, cptr);
116  break;
117  case 'C':
118  /* type coding as bin string */
119  pil = va_arg(VarArg,ptr_int_list);
121  break;
122  case 'P':
123  psi = va_arg(VarArg,ptr_psi_term);
125  break;
126  case 'O':
127  kind = va_arg(VarArg,operator);
129  break;
130  case 'T':
131  assert(output_stream==stderr);
132  t = va_arg(VarArg,def_type);
133  print_def_type(t);
134  break;
135  case 'E':
136  assert(output_stream==stderr);
137  perr_i("near line %ld",psi_term_line_number);
138  if (strcmp(input_file_name,"stdin")) {
139  perr_s(" in file \042%s\042",input_file_name);
140  }
141  parse_ok=FALSE;
142  break;
143  case '%':
144  (void)putc(*p,output_stream);
145  break;
146  default:
147  fprintf(output_stream,"<%c follows %% : report bug >", *p);
148  break;
149  }
150  }
151  else
152  (void)putc(*p,output_stream);
153  }
154  va_end(VarArg);
155 }
void perr_i(char *str, long i)
Definition: error.c:677
long psi_term_line_number
Definition: def_glob.h:268
string input_file_name
Definition: def_glob.h:40
void display_psi(FILE *s, ptr_psi_term t)
display_psi
Definition: print.c:1579
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
print_code
Definition: print.c:167
void print_def_type(def_type t)
print_def_type
Definition: types.c:24
#define FALSE
Definition: def_const.h:128
FILE * output_stream
Definition: def_glob.h:41
long parse_ok
Definition: def_glob.h:171
void print_operator_kind(FILE *s, long kind)
print_operator_kind
Definition: print.c:192
#define assert(N)
Definition: memory.c:113
long overlap_type ( ptr_definition  t1,
ptr_definition  t2 
)

overlap_type

Parameters
ptr_definitiont1
ptr_definitiont2

OVERLAP_TYPE(t1,t2) This function returns TRUE if GLB(t1,t2)!=bottom. This is essentially the same thing as GLB, only it's faster 'cause we don't care about the resulting code.

Definition at line 1579 of file types.c.

References wl_definition::code, FALSE, wl_int_list::next, NOT_CODED, top, TRUE, and wl_int_list::value_1.

1580 {
1581  ptr_int_list c1,c2;
1582  long result=TRUE;
1583 
1584  if (t1!=t2 && t1!=top && t2!=top) {
1585 
1586  c1=t1->code;
1587  c2=t2->code;
1588  result=FALSE;
1589 
1590  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1591  while (!result && c1 && c2) {
1592  result=(((unsigned long)(c1->value_1)) & ((unsigned long)(c2->value_1)));
1593  c1=c1->next;
1594  c2=c2->next;
1595  }
1596  }
1597  }
1598 
1599  /*
1600  printf("overlap_type(%s,%s) => %ld\n",t1->def->keyword->symbol,t2->def->keyword->symbol,result);
1601  */
1602 
1603  return result;
1604 }
#define NOT_CODED
Definition: def_const.h:134
ptr_definition top
Definition: def_glob.h:106
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
psi_term parse ( long *  q)

parse

Parameters
long*q

PARSE(is_it_a_clause) This returns one clause or query from the input stream. It also indicates the type psi-term read, that is whether it was a clause or a query in the IS_IT_A_CLAUSE variable. This is the top level of the parser.

The whole parser is, rather like the psi_termiser, not too well written. It handles psi_terms rather than pointers which causes a lot of messy code and is somewhat slower.

Definition at line 907 of file parser.c.

References eof, EOLN, ERROR, FACT, FALSE, final_dot, final_question, mark_nonstrict(), NULL, parse_ok, parser_stack_index, prompt, put_back_char(), QUERY, read_char(), read_life_form(), read_token(), saved_char, saved_psi_term, stringparse, Syntaxerrorline(), TRUE, and wl_psi_term::type.

908 {
909  psi_term s,t,u;
910  long c;
911 
913  parse_ok=TRUE;
914 
915  /*s=read_life_form('.','?');*/
916  s=read_life_form(0,0);
917 
918  if (parse_ok) {
919  if (s.type!=eof) {
920  read_token(&t);
921 
922  /*
923  if (equ_tokch(t,'?'))
924  *q=QUERY;
925  else if (equ_tokch(t,'.'))
926  *q=FACT;
927  */
928 
929  /* RM: Jul 7 1993 */
930  if (t.type==final_question)
931  {
932  *q=QUERY;
933  }
934  else if (t.type==final_dot)
935  {
936  *q=FACT;
937  }
938  else
939  {
941  else {
942 
943  /*
944  perr("*** Syntax error ");psi_term_error();perr(": ");
945  display_psi_stderr(&t);
946  perr(".\n");
947  */
948 
949  /* RM: Feb 1 1993 */
950  Syntaxerrorline("'%P' (%E)\n",&t);
951 
952  }
953  *q=ERROR;
954  }
955  }
956  }
957 
958 
959  if (!parse_ok) {
960 
961  while (saved_psi_term!=NULL) read_token(&u);
962 
963  prompt="error>";
964  while((c=read_char()) && c!=EOF && c!='.' && c!='?' && c!=EOLN) {}
965 
966  *q=ERROR;
967  }
968  else if (saved_char)
969  do {
970  c=read_char();
971  if (c==EOLN)
972  c=0;
973  else if (c<0 || c>32) {
974  put_back_char(c);
975  c=0;
976  }
977  } while(c && c!=EOF);
978 
979  /* Make sure arguments of nonstrict terms are marked quoted. */
980  if (parse_ok) mark_nonstrict(&s); /* 25.8 */
981 
982  /* mark_eval(&s); 24.8 XXX */
983 
984  /* Mark all the psi-terms corresponding to variables in the var_tree as */
985  /* quoted. This is needed for correct parsing of inputs; otherwise vars */
986  /* that occur in an increment of a query are marked to be evaluated again! */
987  /* mark_quote_tree(var_tree); 24.8 XXX */
988 
989 
990  return s;
991 }
void put_back_char(long c)
put_back_char
Definition: token.c:729
void read_token(ptr_psi_term tok)
read_token
Definition: token.c:1186
#define FACT
Definition: def_const.h:151
void mark_nonstrict(ptr_psi_term t)
mark_nonstrict
Definition: copy.c:514
#define NULL
Definition: def_const.h:203
long saved_char
Definition: def_glob.h:192
#define QUERY
Definition: def_const.h:152
#define ERROR
Definition: def_const.h:153
psi_term read_life_form(char ch1, char ch2)
read_life_form
Definition: parser.c:728
#define EOLN
Definition: def_const.h:140
ptr_definition eof
Definition: def_glob.h:86
void Syntaxerrorline(char *format,...)
Definition: error.c:498
#define TRUE
Definition: def_const.h:127
ptr_definition final_dot
Definition: def_glob.h:137
#define FALSE
Definition: def_const.h:128
ptr_definition final_question
Definition: def_glob.h:138
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
char * prompt
Definition: def_glob.h:42
long read_char()
read_char
Definition: token.c:680
long parser_stack_index
Definition: def_glob.h:24
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
ptr_definition type
Definition: def_struct.h:165
psi_term parse_list ( ptr_definition  typ,
char  e,
char  s 
)

parse_list

Parameters
ptr_definitiontyp
chare
chars

PARSE_LIST(type,end,separator)

This function provides a replacement for the function 'read_list'. It does not create the old (slightly more compact and a lot more complicated) list structure, but instead creates a generic psi-term with 2 features. The list is terminated by the atom 'nil'.

Example:

[a,b,c|d] -> cons(a,cons(b,cons(c,d))). [] -> nil {a;b;c} -> disj(a,disj(b,disj(c,{}))). {} -> {} = bottom

Example: TYP=disjunction, END="}", SEPARATOR=";" will read in disjunctions.

Example: TYP=list, END="]", SEPARATOR="," will read lists such as [1,2,a,b,c|d]

Definition at line 329 of file parser.c.

References wl_psi_term::attr_list, display_psi_stderr(), equ_tokc, equ_tokch, FALSE, FEATCMP, list_nil(), NULL, one, parse_ok, perr(), psi_term_error(), put_back_token(), read_life_form(), read_token(), stack_copy_psi_term(), stack_insert(), stringparse, two, and wl_psi_term::type.

330 {
331  ptr_psi_term car=NULL;
332  ptr_psi_term cdr=NULL;
333  psi_term result;
334  psi_term t;
335  char a;
336 
337  result=list_nil(typ); /* RM: Feb 1 1993 */
338 
339  if (parse_ok) {
340 
341  /* Character used for building cons pairs */
342  a='|'; /* RM: Jan 11 1993 */
343 
344 
345  read_token(&t);
346 
347  if(!equ_tokc(t,e)) {
348 
349  /* Read the CAR of the list */
350  put_back_token(t);
352 
353  /* Read the CDR of the list */
354  read_token(&t);
355  if(equ_tokch(t,s))
356  cdr=stack_copy_psi_term(parse_list(typ,e,s));
357  else if(equ_tokch(t,e))
358  cdr=stack_copy_psi_term(list_nil(typ));
359  else if(equ_tokch(t,'|')) {
361  read_token(&t);
362  if(!equ_tokch(t,e)) {
364  else {
365  perr("*** Syntax error ");psi_term_error();
366  perr(": bad symbol for end of list '");
367  display_psi_stderr(&t);
368  perr("'.\n");
369  put_back_token(t);
370  }
371  }
372  }
373  else
375  else {
376  perr("*** Syntax error ");psi_term_error();
377  perr(": bad symbol in list '");
378  display_psi_stderr(&t);
379  perr("'.\n");
380  put_back_token(t);
381  }
382 
383  result.type=typ;
384  if(car)
385  (void)stack_insert(FEATCMP,one,&(result.attr_list),(GENERIC)car);
386  if(cdr)
387  (void)stack_insert(FEATCMP,two,&(result.attr_list),(GENERIC)cdr);
388  }
389  }
390 
391  return result;
392 }
void psi_term_error()
psi_term_error
Definition: token.c:761
#define FEATCMP
Definition: def_const.h:257
void perr(char *str)
Definition: error.c:659
#define equ_tokc(A, B)
Definition: def_macro.h:71
void read_token(ptr_psi_term tok)
read_token
Definition: token.c:1186
char * two
Definition: def_glob.h:251
#define NULL
Definition: def_const.h:203
psi_term parse_list(ptr_definition typ, char e, char s)
parse_list
Definition: parser.c:329
void display_psi_stderr(ptr_psi_term t)
display_psi_stderr
Definition: print.c:1550
void put_back_token(psi_term t)
put_back_token
Definition: token.c:746
psi_term read_life_form(char ch1, char ch2)
read_life_form
Definition: parser.c:728
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
#define FALSE
Definition: def_const.h:128
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
char * one
Definition: def_glob.h:250
psi_term list_nil(ptr_definition type)
list_nil
Definition: parser.c:278
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
#define equ_tokch(A, B)
Definition: def_macro.h:66
void pchoices ( )

pchoices

for debugging

Definition at line 93 of file memory.c.

References choice_stack, wl_choice_point::next, stack_pointer, and wl_choice_point::stack_top.

94 {
96  printf("stack pointer is: %lx\n",(unsigned long)stack_pointer);
97  for(c=choice_stack;c;c=c->next)
98  printf("\tc=%lx\ts=%lx\tg=%lx\tu=%lx\n",(unsigned long)c,(unsigned long)c->stack_top,(unsigned long)c->goal_stack,(unsigned long)c->undo_point);
99 }
GENERIC stack_top
Definition: def_struct.h:236
ptr_choice_point next
Definition: def_struct.h:235
GENERIC stack_pointer
Definition: def_glob.h:14
ptr_choice_point choice_stack
Definition: def_glob.h:51
void perr ( char *  str)

Definition at line 659 of file error.c.

661 {
662  (void)fputs(str, stderr);
663 }
void perr_i ( char *  str,
long  i 
)

Definition at line 677 of file error.c.

680 {
681  fprintf(stderr,str,i);
682 }
void perr_s ( char *  s1,
char *  s2 
)

Definition at line 665 of file error.c.

667 {
668  fprintf(stderr,s1,s2);
669 }
void perr_s2 ( char *  s1,
char *  s2,
char *  s3 
)

Definition at line 671 of file error.c.

673 {
674  fprintf(stderr,s1,s2,s3);
675 }
void perr_sort ( ptr_definition  d)

perr_sort

Parameters
ptr_definitiond

Definition at line 933 of file types.c.

References wl_definition::keyword, perr_s(), and wl_keyword::symbol.

934 {
935  perr_s("%s",d->keyword->symbol);
936 }
ptr_keyword keyword
Definition: def_struct.h:124
void perr_s(char *s1, char *s2)
Definition: error.c:665
char * symbol
Definition: def_struct.h:91
void perr_sort_cycle ( ptr_int_list  anc)

perr_sort_cycle

Parameters
ptr_int_listanc

Definition at line 959 of file types.c.

References perr(), perr_sort(), perr_sort_list(), and wl_int_list::value_1.

960 {
962  perr(" <| ");
963  perr_sort_list(anc);
964 }
void perr(char *str)
Definition: error.c:659
void perr_sort_list(ptr_int_list anc)
perr_sort_list
Definition: types.c:944
void perr_sort(ptr_definition d)
perr_sort
Definition: types.c:933
GENERIC value_1
Definition: def_struct.h:54
void perr_sort_list ( ptr_int_list  anc)

perr_sort_list

Parameters
ptr_int_listanc

Definition at line 944 of file types.c.

References wl_int_list::next, perr(), perr_sort(), and wl_int_list::value_1.

945 {
946  if (anc) {
947  perr_sort_list(anc->next);
948  if (anc->next) perr(" <| ");
950  }
951 }
void perr(char *str)
Definition: error.c:659
void perr_sort_list(ptr_int_list anc)
perr_sort_list
Definition: types.c:944
void perr_sort(ptr_definition d)
perr_sort
Definition: types.c:933
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
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 pop ( ptr_psi_term  tok,
long *  op 
)

pop

Parameters
ptr_psi_termtok
long*op

POP(psi_term,op); This function pops PSI_TERM and OP off the parser stack and returns its precedence.

Definition at line 132 of file parser.c.

References error_psi_term, FALSE, int_stack, parse_ok, parser_stack_index, and psi_term_stack.

133 {
134  long r=0;
135 
136  if (parser_stack_index==0) {
137  /*
138  perr("*** Parser error ");
139  psi_term_error();
140  perr(": stack empty.\n");
141  */
142 
143  (*tok)= *error_psi_term;
144  parse_ok=FALSE;
145  }
146  else {
148  (*op)=op_stack[parser_stack_index];
151  }
152 
153  return r;
154 }
ptr_psi_term error_psi_term
Definition: def_glob.h:23
#define FALSE
Definition: def_const.h:128
long parser_stack_index
Definition: def_glob.h:24
long parse_ok
Definition: def_glob.h:171
long int_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:318
psi_term psi_term_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:317
long precedence ( psi_term  tok,
long  typ 
)

precedence

Parameters
psi_termtok
longtyp

PRECEDENCE(tok,typ) This function returns the precedence of TOK if it is an operator of type TYP where TYP is FX XFX XF etc... Note that this allows both a binary and unary minus. The result is NOP if tok is not an operator.

Definition at line 180 of file parser.c.

References wl_operator_data::next, NOP, wl_definition::op_data, wl_operator_data::precedence, and wl_psi_term::type.

181 {
182  long r=NOP;
184 
185  o=tok.type->op_data;
186  while(o && r==NOP) {
187  if(typ==o->type)
188  r=o->precedence;
189  else
190  o=o->next;
191  }
192 
193  return r;
194 }
ptr_operator_data next
Definition: def_struct.h:49
#define NOP
Definition: def_const.h:332
ptr_definition type
Definition: def_struct.h:165
ptr_operator_data op_data
Definition: def_struct.h:139
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)
redefine
Definition: types.c:104
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
void pred_write ( ptr_node  n)

pred_write

Parameters
ptr_noden

PRED_WRITE(n) N is an attribute tree to be printed in one lump. This is called by WRITE.

For all write builtins I.e: write, writeq, pretty_write, pretty_writeq, write_err, writeq_err.

Definition at line 1469 of file print.c.

References FALSE, listing_flag, main_pred_write(), outfile, output_stream, and write_stderr.

1470 {
1472  /* write_stderr=FALSE; */
1474  main_pred_write(n);
1475  (void)fflush(outfile);
1476 }
FILE * outfile
Definition: def_glob.h:333
#define FALSE
Definition: def_const.h:128
FILE * output_stream
Definition: def_glob.h:41
void pretty_attr ( ptr_node  t,
long  depth 
)

pretty_attr

Parameters
ptr_nodet
longdepth

PRETTY_ATTR(t,depth) Pretty print the attributes. This calls DO_PRETTY_ATTR which does the real work.

Definition at line 1273 of file print.c.

References do_pretty_attr(), new_tab(), prettyf(), and two_or_more().

1274 {
1275  ptr_tab_brk new;
1276  long cnt=1;
1277 
1278  prettyf("(");
1279  new_tab(&new);
1280 
1281  do_pretty_attr(t,new,&cnt,two_or_more(t),depth);
1282 
1283  prettyf(")");
1284 }
void pretty_list ( ptr_psi_term  t,
long  depth 
)

pretty_list

Parameters
ptr_psi_termt
longdepth

PRETTY_LIST(t,depth) Pretty print a list. On entry we know that T is a legal CONS pair, so we can immediately print the opening bracket etc...

Definition at line 734 of file print.c.

References alist, wl_psi_term::attr_list, check_legal_cons(), COMMA_PREC, wl_node::data, deref_ptr, disj_nil, disjunction, DOTDOT, equal_types, FALSE, find(), get_two_args(), INTCMP, wl_definition::keyword, mark_tab(), MAX_PRECEDENCE, new_tab(), nil, overlap_type(), pointer_names, pretty_symbol(), pretty_tag_or_psi_term(), prettyf(), print_depth, TRUE, and wl_psi_term::type.

735 {
736  ptr_tab_brk new;
737  ptr_definition t_type;
738  ptr_psi_term car,cdr;
739  ptr_node n;
740  char sep[4],end[3];
741  long list_depth; /* 20.8 */
742  long done=FALSE; /* RM: Dec 11 1992 */
743 
744  strcpy(sep,"ab");
745  strcpy(end,"cd");
746  t_type=t->type;
747 
748  if (overlap_type(t_type,alist)) {
749  if (!equal_types(t_type,alist)) {
750  pretty_symbol(t_type->keyword); /* RM: Jan 13 1993 */
751  prettyf(DOTDOT);
752  }
753  prettyf("[");
754  strcpy(sep,",");
755  strcpy(end,"]");
756  }
757 
758  /*
759  else if (equal_types(t_type,conjunction)) {
760  prettyf("(");
761  strcpy(sep,DOTDOT);
762  strcpy(end,")");
763  }
764  */
765 
766  else if (equal_types(t_type,disjunction)) {
767  prettyf("{");
768  strcpy(sep,";");
769  strcpy(end,"}");
770  }
771 
772 
773  /* RM: Dec 11 1992 New code for printing lists */
774 
775  new_tab(&new);
776  list_depth=0; /* 20.8 */
777  while(!done) {
778  mark_tab(new);
779  if(list_depth==print_depth)
780  prettyf("...");
781 
782  get_two_args(t->attr_list,&car,&cdr);
783  deref_ptr(car);
784  deref_ptr(cdr);
785 
786 
787  if(list_depth<print_depth)
789 
790  /* Determine how to print the CDR */
791  n=find(INTCMP,(char *)cdr,pointer_names);
792 
793  if(n && n->data) {
794  prettyf("|");
796  done=TRUE;
797  }
798  else
799  if(( /* RM: Feb 1 1993 */
800  (cdr->type==nil && overlap_type(t_type,alist)) ||
801  (cdr->type==disj_nil && t_type==disjunction)
802  )
803  && !cdr->attr_list)
804  done=TRUE;
805  else
806  if(!check_legal_cons(cdr,t_type)) {
807  prettyf("|");
809  done=TRUE;
810  }
811  else {
812  if(list_depth<print_depth)
813  prettyf(sep);
814  t=cdr;
815  }
816 
817  list_depth++;
818  }
819 
820  prettyf(end);
821 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
#define INTCMP
Definition: def_const.h:256
void pretty_symbol(ptr_keyword k)
pretty_symbol
Definition: modules.c:452
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
#define DOTDOT
Definition: def_const.h:335
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
ptr_node pointer_names
Definition: def_glob.h:29
ptr_definition disj_nil
Definition: def_glob.h:85
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition alist
Definition: def_glob.h:94
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_definition disjunction
Definition: def_glob.h:84
#define equal_types(A, B)
Definition: def_macro.h:106
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
#define MAX_PRECEDENCE
Definition: def_const.h:103
ptr_definition nil
Definition: def_glob.h:97
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
void pretty_output ( )

pretty_output

PRETTY_OUTPUT() Final output of all these pretty things which have been built up.

Definition at line 1293 of file print.c.

References wl_tab_brk::broken, wl_tab_brk::column, indx, outfile, wl_tab_brk::printed, wl_item::str, wl_item::tab, and TRUE.

1294 {
1295  ptr_item i;
1296  long j;
1297 
1298  for(i=pretty_things+1;(unsigned long)i<(unsigned long)indx;i++) {
1299  if(i->tab->broken && i->tab->printed) {
1300  fprintf(outfile,"\n");
1301  for(j=0;j<i->tab->column;j++)
1302  fprintf(outfile," ");
1303  }
1304  fprintf(outfile,"%s",i->str);
1305  i->tab->printed=TRUE;
1306  }
1307 }
long printed
Definition: def_struct.h:307
long column
Definition: def_struct.h:305
ptr_tab_brk tab
Definition: def_struct.h:312
char * str
Definition: def_struct.h:311
FILE * outfile
Definition: def_glob.h:333
long broken
Definition: def_struct.h:306
#define TRUE
Definition: def_const.h:127
ptr_item indx
Definition: def_glob.h:329
void pretty_psi_term ( ptr_psi_term  t,
long  sprec,
long  depth 
)

pretty_psi_term

Parameters
ptr_psi_termt
longsprec
longdepth

PRETTY_PSI_TERM(t,sprec,depth) Pretty print a psi_term T with sugar for lists.

Definition at line 1058 of file print.c.

References wl_goal::aaaa_1, alist, wl_psi_term::attr_list, check_legal_cons(), cut, deref_ptr, disj_nil, disjunction, display_persistent, DOTDOT, eof, equal_types, FALSE, wl_residuation::goal, heap_pointer, integer, wl_definition::keyword, wl_residuation::next, nil, wl_goal::pending, pretty_attr(), pretty_list(), pretty_psi_with_ops(), pretty_quote_symbol(), pretty_symbol(), prettyf(), prettyf_quoted_string(), print_depth, PRINT_POWER, PRINT_SPLIT, quoted_string, REAL, real, wl_psi_term::resid, seg_format, stream, STRLEN, sub_type(), sys_bytedata, wl_psi_term::type, wl_psi_term::value_3, WL_MAXINT, and write_canon.

1059 {
1060  char buf[STRLEN]; /* Big enough for a long number */
1061  ptr_residuation r;
1062  long argswritten;
1063  // double fmod();
1064 
1065  if (t) {
1066  deref_ptr(t); /* PVR */
1067 
1068  /* if (trace) printf("<%ld>",t->status); For brunobug.lf PVR 14.2.94 */
1069 
1070  /* RM: Feb 12 1993 */
1071  if(display_persistent &&
1072  (GENERIC)t>heap_pointer)
1073  prettyf(" $");
1074 
1075  if((t->type==alist || t->type==disjunction) && check_legal_cons(t,t->type))
1076  pretty_list(t,depth+1); /* RM: Dec 11 1992 */
1077  else
1078  if(t->type==nil && !t->attr_list)
1079  prettyf("[]");
1080  else
1081  if(t->type==disj_nil && !t->attr_list) /* RM: Feb 1 1993 */
1082  prettyf("{}");
1083  else {
1084  argswritten=FALSE;
1085  if (t->value_3) {
1086 #ifdef CLIFE
1087  if(t->type->type==block) { /* RM 20 Jan 1993 */
1088  pretty_block(t); /* AA 21 Jan 1993 */
1089  }
1090  else
1091 #endif /* CLIFE */
1092  if (sub_type(t->type,integer)) {
1093  /* Print integers in chunks up to the full precision of the REAL */
1094  long seg,neg,i;
1095  REAL val;
1096  char segbuf[100][PRINT_POWER+3];
1097 
1098  val = *(REAL *)t->value_3;
1099  neg = (val<0.0);
1100  if (neg) val = -val;
1101  if (val>WL_MAXINT) goto PrintReal;
1102  seg=0;
1103  while (val>=(double)PRINT_SPLIT) {
1104  double tmp;
1105  tmp=(REAL)fmod((double)val,(double)PRINT_SPLIT);
1106  (void)snprintf(segbuf[seg],100,seg_format,(unsigned long)tmp);
1107  val=floor(val/(double)PRINT_SPLIT);
1108  seg++;
1109  }
1110  (void)snprintf(segbuf[seg],100,"%s%ld",(neg?"-":""),(unsigned long)val);
1111  for (i=seg; i>=0; i--) prettyf(segbuf[i]);
1112  if (!equal_types(t->type,integer)) {
1113  prettyf(DOTDOT);
1114  pretty_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1115  }
1116  }
1117  else if (sub_type(t->type,real)) {
1118  PrintReal:
1119  (void)snprintf(buf,STRLEN,"%lg",*(REAL *)t->value_3);
1120  prettyf(buf);
1121  if (!equal_types(t->type,real) &&
1122  !equal_types(t->type,integer)) {
1123  prettyf(DOTDOT);
1124  pretty_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1125  }
1126  }
1127  else if (sub_type(t->type,quoted_string)) {
1128  prettyf_quoted_string((char *)t->value_3);
1129  if(!equal_types(t->type,quoted_string)) {
1130  prettyf(DOTDOT);
1131  pretty_quote_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1132  }
1133  }
1134  /* DENYS: BYTEDATA */
1135  else if (sub_type(t->type,sys_bytedata)) {
1137  }
1138  else if (equal_types(t->type,stream)) {
1139  (void)snprintf(buf,STRLEN,"stream(%ld)",(long)t->value_3);
1140  prettyf(buf);
1141  }
1142  else if (equal_types(t->type,eof))
1143  pretty_quote_symbol(eof->keyword); /* RM: Jan 13 1993 */
1144  else if (equal_types(t->type,cut))
1145  pretty_quote_symbol(cut->keyword); /* RM: Jan 13 1993 */
1146  else {
1147  prettyf("*** bad object '");
1148  pretty_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1149  prettyf("'***");
1150  }
1151  }
1152  else {
1153  if (depth<print_depth) /* 20.8 */
1154  argswritten=pretty_psi_with_ops(t,sprec,depth+1);
1155  /* RM: Jan 13 1993 */
1156  if (!argswritten) pretty_quote_symbol(t->type->keyword);
1157  }
1158 
1159  /* write_canon -- PVR 24.2.94 */
1160  if (!argswritten && t->attr_list &&
1161  (depth<print_depth || write_canon)) /* 20.8 */
1162  pretty_attr(t->attr_list,depth+1);
1163 
1164  if (depth>=print_depth && !write_canon && t->attr_list) /* 20.8 */
1165  prettyf("(...)");
1166  }
1167  if ((r=t->resid))
1168  while (r) {
1169  if (r->goal->pending) {
1170  if (FALSE /* write_resids 11.8 */) {
1171  prettyf("\\");
1172  pretty_psi_term(r->goal->aaaa_1,0,depth);
1173  }
1174  else
1175  prettyf("~");
1176  }
1177  r=r->next;
1178  }
1179  }
1180 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_residuation resid
Definition: def_struct.h:173
ptr_goal goal
Definition: def_struct.h:156
ptr_definition stream
Definition: def_glob.h:103
ptr_residuation next
Definition: def_struct.h:157
void pretty_symbol(ptr_keyword k)
pretty_symbol
Definition: modules.c:452
ptr_keyword keyword
Definition: def_struct.h:124
#define DOTDOT
Definition: def_const.h:335
#define REAL
Definition: def_const.h:72
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
void pretty_quote_symbol(ptr_keyword k)
pretty_quote_symbol
Definition: modules.c:470
ptr_definition disj_nil
Definition: def_glob.h:85
ptr_definition real
Definition: def_glob.h:102
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition alist
Definition: def_glob.h:94
ptr_definition eof
Definition: def_glob.h:86
#define PRINT_POWER
Definition: def_const.h:96
ptr_definition integer
Definition: def_glob.h:93
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
GENERIC value_3
Definition: def_struct.h:170
ptr_definition disjunction
Definition: def_glob.h:84
GENERIC heap_pointer
Definition: def_glob.h:12
#define equal_types(A, B)
Definition: def_macro.h:106
ptr_definition sys_bytedata
Definition: def_glob.h:336
#define PRINT_SPLIT
Definition: def_const.h:95
#define WL_MAXINT
Definition: def_const.h:76
ptr_definition cut
Definition: def_glob.h:83
ptr_definition nil
Definition: def_glob.h:97
#define STRLEN
Definition: def_const.h:86
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 pending
Definition: def_struct.h:228
long pretty_psi_with_ops ( ptr_psi_term  t,
long  sprec,
long  depth 
)

pretty_psi_with_ops

Parameters
ptr_psi_termt
longsprec
longdepth

Write an expression with its operators. Return TRUE iff the arguments of t are written here (i.e. t was indeed a valid operator, and is therefore taken care of here).

Definition at line 949 of file print.c.

References wl_psi_term::attr_list, deref_ptr, FALSE, func_flag, fx, fy, get_two_args(), INFIX, wl_definition::keyword, listing_flag, MAX_PRECEDENCE, opcheck(), POSTFIX, PREFIX, pretty_quote_symbol(), pretty_tag_or_psi_term(), prettyf(), wl_keyword::symbol, TRUE, wl_psi_term::type, write_canon, xf, xfx, xfy, yf, and yfx.

950 {
951  // ptr_tab_brk new;
952  ptr_psi_term arg1, arg2;
953  long ttype, a1type, a2type;
954  long tprec, a1prec, a2prec;
955  long tkind, a1kind, a2kind;
956  long p1, p2, argswritten;
957  long sp; /* surrounding parentheses */
958 
959  if (write_canon) return FALSE; /* PVR 24.2.94 */
960 
961  argswritten=TRUE;
962  tkind=opcheck(t, &tprec, &ttype);
963  sp=(tkind==INFIX||tkind==PREFIX||tkind==POSTFIX) && tprec>=sprec;
964  if (sp) prettyf("(");
965  if (tkind==INFIX) {
966  get_two_args(t->attr_list, &arg1, &arg2);
967  deref_ptr(arg1); /* 16.9 */
968  deref_ptr(arg2); /* 16.9 */
969  a1kind = opcheck(arg1, &a1prec, &a1type);
970  a2kind = opcheck(arg2, &a2prec, &a2type);
971 
972  /* The p1 and p2 flags tell whether to put parens around t's args */
973  /* Calculate p1 flag: */
974  if (a1prec>tprec) p1=TRUE;
975  else if (a1prec<tprec) p1=FALSE;
976  else /* equal priority */
977  if (ttype==xfy || ttype==xfx) p1=TRUE;
978  else /* yfx */
979  if (a1type==yfx || a1type==fx || a1type==fy) p1=FALSE;
980  else p1=TRUE;
981 
982  /* Calculate p2 flag: */
983  if (a2prec>tprec) p2=TRUE;
984  else if (a2prec<tprec) p2=FALSE;
985  else /* equal priority */
986  if (ttype==yfx || ttype==xfx) p2=TRUE;
987  else /* xfy */
988  if (a2type==xfy || a2type==xf || a2type==yf) p2=FALSE;
989  else p2=TRUE;
990 
991  /* Write the expression */
992  if (p1) prettyf("(");
994  if (p1) prettyf(")");
995  if (!p1 && strcmp(t->type->keyword->symbol,",")) {
996  prettyf(" ");
997  }
998  pretty_quote_symbol(t->type->keyword); /* RM: Jan 13 1993 */
999  if (listing_flag && !func_flag &&
1000  (!strcmp(t->type->keyword->symbol,",") ||
1001  !strcmp(t->type->keyword->symbol,":-"))) {
1002  prettyf("\n ");
1003  }
1004  else {
1005  if (!p2 && strcmp(t->type->keyword->symbol,".")) prettyf(" ");
1006  }
1007  if (p2) prettyf("(");
1008  pretty_tag_or_psi_term(arg2,MAX_PRECEDENCE+1,depth);
1009  if (p2) prettyf(")");
1010  }
1011  else if (tkind==PREFIX) {
1012  get_two_args(t->attr_list, &arg1, &arg2); /* arg2 does not exist */
1013  a1kind = opcheck(arg1, &a1prec, &a1type);
1014 
1015  /* Calculate p1 flag: */
1016  if (a1type==fx || a1type==fy) p1=FALSE;
1017  else p1=(tprec<=a1prec);
1018 
1019  pretty_quote_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1020  if (!p1) prettyf(" ");
1021  if (p1) prettyf("(");
1022  pretty_tag_or_psi_term(arg1,MAX_PRECEDENCE+1,depth);
1023  if (p1) prettyf(")");
1024  }
1025  else if (tkind==POSTFIX) {
1026  get_two_args(t->attr_list, &arg1, &arg2); /* arg2 does not exist */
1027  a1kind = opcheck(arg1, &a1prec, &a1type);
1028 
1029  /* Calculate p1 flag: */
1030  if (a1type==xf || a1type==yf) p1=FALSE;
1031  else p1=(tprec<=a1prec);
1032 
1033  if (p1) prettyf("(");
1034  pretty_tag_or_psi_term(arg1,MAX_PRECEDENCE+1,depth);
1035  if (p1) prettyf(")");
1036  if (!p1) prettyf(" ");
1037  pretty_quote_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1038  }
1039  else {
1040  argswritten=FALSE;
1041  }
1042  if (sp) prettyf(")");
1043  return argswritten;
1044 }
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 xfx
Definition: def_const.h:265
#define POSTFIX
Definition: def_const.h:340
#define fx
Definition: def_const.h:262
ptr_keyword keyword
Definition: def_struct.h:124
#define xfy
Definition: def_const.h:267
char * symbol
Definition: def_struct.h:91
void pretty_quote_symbol(ptr_keyword k)
pretty_quote_symbol
Definition: modules.c:470
#define PREFIX
Definition: def_const.h:339
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
#define xf
Definition: def_const.h:261
#define yf
Definition: def_const.h:263
#define INFIX
Definition: def_const.h:338
#define MAX_PRECEDENCE
Definition: def_const.h:103
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
#define fy
Definition: def_const.h:264
void pretty_quote_symbol ( ptr_keyword  k)

pretty_quote_symbol

Parameters
ptr_keywordk

PRETTY_QUOTE_SYMBOL(k) Prints the string to be used to display keyword K, with quotes if required.

Definition at line 470 of file modules.c.

References wl_keyword::definition, display_modules, wl_definition::keyword, wl_keyword::module, wl_module::module_name, prettyf(), prettyf_quote(), and wl_keyword::symbol.

471 {
472  k=k->definition->keyword;
473  if(display_modules) {
475  prettyf("#");
476  }
477  prettyf_quote(k->symbol);
478 }
long display_modules
Definition: modules.c:25
ptr_definition definition
Definition: def_struct.h:96
ptr_keyword keyword
Definition: def_struct.h:124
char * symbol
Definition: def_struct.h:91
char * module_name
Definition: def_struct.h:75
ptr_module module
Definition: def_struct.h:90
void prettyf(char *s)
prettyf
Definition: print.c:496
void prettyf_quote(char *s)
prettyf_quote
Definition: print.c:529
void pretty_symbol ( ptr_keyword  k)

pretty_symbol

Parameters
ptr_keywordk

PRETTY_SYMBOL(k) Prints the string to be used to display keyword K.

Definition at line 452 of file modules.c.

References wl_keyword::definition, display_modules, wl_definition::keyword, wl_keyword::module, wl_module::module_name, prettyf(), and wl_keyword::symbol.

453 {
454  k=k->definition->keyword;
455  if(display_modules) {
457  prettyf("#");
458  }
459  prettyf(k->symbol);
460 }
long display_modules
Definition: modules.c:25
ptr_definition definition
Definition: def_struct.h:96
ptr_keyword keyword
Definition: def_struct.h:124
char * symbol
Definition: def_struct.h:91
char * module_name
Definition: def_struct.h:75
ptr_module module
Definition: def_struct.h:90
void prettyf(char *s)
prettyf
Definition: print.c:496
void pretty_tag_or_psi_term ( ptr_psi_term  p,
long  sprec,
long  depth 
)

pretty_tag_or_psi_term

Parameters
ptr_psi_termp
longsprec
longdepth

PRETTY_TAG_OR_PSI_TERM(p,depth) Print a psi-term, but first precede it with the appropriate TAG. Don't reprint the same psi-term twice.

Definition at line 834 of file print.c.

References COLON_PREC, wl_node::data, deref_ptr, DOTDOT, FALSE, find(), heap_insert(), INTCMP, is_top, no_name, NULL, pointer_names, pretty_psi_term(), prettyf(), printed_pointers, and unique_name().

835 {
836  ptr_node n,n2;
837 
838  if (p==NULL) {
839  prettyf("<VOID>");
840  return;
841  }
842  if (FALSE /*depth>=print_depth*/) { /* 20.8 */
843  prettyf("...");
844  return;
845  }
846  deref_ptr(p);
847 
848  n=find(INTCMP,(char *)p,pointer_names);
849 
850  if (n && n->data) {
851  if (n->data==(GENERIC)no_name) {
852  n->data=(GENERIC)unique_name();
853  /* sprintf(name,"_%ld%c",++gen_sym_counter,0); */
854  /* n->data=(GENERIC)heap_copy_string(name); */
855  }
856  n2=find(INTCMP,(char *)p,printed_pointers);
857  if(n2==NULL) {
858  prettyf((char *)n->data);
859  (void)heap_insert(INTCMP,(char *)p,&printed_pointers,(GENERIC)n->data);
860  if (!is_top(p)) {
861  prettyf(DOTDOT);
862  pretty_psi_term(p,COLON_PREC,depth);
863  }
864  }
865  else
866  prettyf((char *)n2->data);
867  }
868  else
869  pretty_psi_term(p,sprec,depth);
870 }
ptr_node printed_pointers
Definition: def_glob.h:28
#define is_top(T)
Definition: def_macro.h:108
#define INTCMP
Definition: def_const.h:256
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
#define DOTDOT
Definition: def_const.h:335
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
heap_insert
Definition: trees.c:320
ptr_node pointer_names
Definition: def_glob.h:29
#define deref_ptr(P)
Definition: def_macro.h:95
#define FALSE
Definition: def_const.h:128
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
unsigned long * GENERIC
Definition: def_struct.h:17
void pretty_variables ( ptr_node  n,
ptr_tab_brk  tab 
)

pretty_variables

Parameters
ptr_noden
ptr_tab_brktab

PRETTY_VARIABLES(n,tab) Pretty print the variables at position TAB.

Definition at line 1318 of file print.c.

References wl_node::data, deref_ptr, eqsym, find(), INTCMP, wl_node::key, wl_node::left, mark_tab(), MAX_PRECEDENCE, wl_definition::op_data, opcheck(), wl_operator_data::precedence, pretty_psi_term(), prettyf(), printed_pointers, and wl_node::right.

1319 {
1320  ptr_psi_term tok;
1321  ptr_node n2;
1322 
1323  if(n->left) {
1324  pretty_variables(n->left,tab);
1325  prettyf(", ");
1326  }
1327 
1328  mark_tab(tab);
1329  prettyf(n->key);
1330  prettyf(" = ");
1331 
1332  tok=(ptr_psi_term )n->data;
1333  deref_ptr(tok);
1334  n2=find(INTCMP,(char *)tok,printed_pointers);
1335  if(strcmp((char *)n2->data,n->key)<0)
1336  /* Reference to previously printed variable */
1337  prettyf((char *)n2->data);
1338  else {
1339  if (eqsym->op_data) {
1340  long tkind, tprec, ttype, eqprec;
1341  eqprec=eqsym->op_data->precedence;
1342  tkind=opcheck(tok, &tprec, &ttype);
1343  if (tprec>=eqprec) prettyf("(");
1345  if (tprec>=eqprec) prettyf(")");
1346  }
1347  else
1349  }
1350 
1351  if(n->right) {
1352  prettyf(", ");
1353  pretty_variables(n->right,tab);
1354  }
1355 }
ptr_node printed_pointers
Definition: def_glob.h:28
#define INTCMP
Definition: def_const.h:256
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition eqsym
Definition: def_glob.h:87
char * key
Definition: def_struct.h:182
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
#define MAX_PRECEDENCE
Definition: def_const.h:103
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_operator_data op_data
Definition: def_struct.h:139
ptr_node right
Definition: def_struct.h:184
void prettyf ( char *  s)

prettyf

Parameters
char*s

PRETTYF(s) This prints the string S into the BUFFER.

Definition at line 496 of file print.c.

References FALSE, and prettyf_inner().

497 {
498  prettyf_inner(s,FALSE,'\'');
499 }
#define FALSE
Definition: def_const.h:128
void prettyf_inner ( char *  s,
long  q,
char  c 
)

prettyf_inner

Parameters
char*s
longq
charc the quote character

PRINTING ROUTINES.

These routines allow the correct printing in minimal form of a set of possibly cyclic psi-terms with coreferences from one to another.

First the term to be printed is explored to locate any cyclic terms or coreferences. Then is printed into memory where is it formatted to fit within PAGE_WIDTH of the output page. Then it is effectively printed to the output stream.

Printing into memory involves the use of an array containing a TAB position on which to align things then a string to print. The routine WORK_OUT_LENGTH tries (by trial and error) to print the psi_term into PAGE_WIDTH columns by inserting line feeds whereever possible

Does the work of prettyf and prettyf_quote The q argument is a flag telling whether to quote or not.

Definition at line 374 of file print.c.

References buffer, indent, and outfile.

375 {
376  char *sb=buffer;
377 
378  if (indent) {
379  while (*sb) sb++;
380  if (q) { *sb = c; sb++; }
381  while (*s) {
382  if (q && *s==c) { *sb = *s; sb++; }
383  *sb = *s; sb++; s++;
384  }
385  if (q) { *sb = c; sb++; }
386  *sb=0;
387  }
388  else {
389  if (q) (void)putc(c,outfile);
390  while (*s) {
391  if (q && *s==c) { (void)putc(*s,outfile); }
392  (void)putc(*s,outfile);
393  s++;
394  }
395  if (q) (void)putc(c,outfile);
396  }
397 }
FILE * outfile
Definition: def_glob.h:333
void prettyf_quote ( char *  s)

prettyf_quote

Parameters
char*s

PRETTYF_QUOTE(s) This prints the string S into the buffer. S is surrounded by quotes if: (1) const_quote==TRUE, and (2) S does not represent an integer, and (2) S contains a non-alphanumeric character or starts with a non-lowercase character, and (3) if S is longer than one character, it is not true that S has only non-SINGLE SYMBOL characters (in that case, S does not need quotes),and (4) if S has only one character, it is a single space or underscore. When S is surrounded by quotes, a quote inside S is printed as two quotes.

Definition at line 529 of file print.c.

References const_quote, no_quote(), and prettyf_inner().

530 {
531  prettyf_inner(s, const_quote && !no_quote(s), '\'');
532 }
void prettyf_quoted_string ( char *  s)

prettyf_quoted_string

Parameters
char*s

Definition at line 507 of file print.c.

References const_quote, and prettyf_inner().

508 {
509  prettyf_inner((char *)s,const_quote,'"');
510 }
void print_bin ( long  b)

print_bin

Parameters
longb

PRINT_BIN(b) Print the integer B under binary format (currently 26 is printed **-*-). This is used to print the binary codes used in type encryption.

Definition at line 147 of file print.c.

References INT_SIZE, and outfile.

148 {
149  long p;
150 
151  for (p=INT_SIZE;p--;p>0)
152  {
153  fprintf(outfile,(b&1?"X":" "));
154  b = b>>1;
155  }
156 }
#define INT_SIZE
Definition: def_const.h:144
FILE * outfile
Definition: def_glob.h:333
void print_code ( FILE *  s,
ptr_int_list  c 
)

print_code

Parameters
FILE*s
ptr_int_listc

PRINT_CODE(s,c) Print a binary code C to a stream s (as used in type encoding).

Definition at line 167 of file print.c.

References wl_int_list::next, NOT_CODED, outfile, print_bin(), and wl_int_list::value_1.

168 {
169  outfile=s;
170 
171  if (c==NOT_CODED)
172  fprintf(outfile," (not coded) ");
173  else {
174  fprintf(outfile," [");
175  while (c) {
176  print_bin((long)c->value_1);
177  c=c->next;
178  }
179  fprintf(outfile,"]");
180  }
181 }
#define NOT_CODED
Definition: def_const.h:134
FILE * outfile
Definition: def_glob.h:333
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
void print_codes ( )

print_codes

PRINT_CODES() Print all the codes.

Definition at line 1256 of file types.c.

References outputline(), and type_count.

1257 {
1258  long i;
1259 
1260  for (i=0; i<type_count; i++) {
1261  outputline("%C = %s\n",
1262  gamma_table[i]->code,
1263  gamma_table[i]->keyword->combined_name);
1264  }
1265 }
ptr_definition * gamma_table
Definition: types.c:14
long type_count
Definition: def_glob.h:46
void outputline(char *format,...)
Definition: error.c:79
void print_def_type ( def_type  t)

print_def_type

Parameters
def_typet

PRINT_DEF_TYPE(t) This prints type T to stderr, where T=predicate, function or type.

Definition at line 24 of file types.c.

References function_it, global, perr(), predicate, and type_it.

25 {
26  switch ((long)t) {
27  case (long)predicate:
28  perr("predicate");
29  break;
30  case (long)function_it:
31  perr("function");
32  break;
33  case (long)type_it:
34  perr("sort");
35  break;
36  case (long)global: /* RM: Feb 8 1993 */
37  perr("global variable");
38  break;
39  default:
40  perr("undefined");
41  }
42 }
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
void perr(char *str)
Definition: error.c:659
#define global
Definition: def_const.h:364
#define type_it
Definition: def_const.h:363
void print_gc_info ( long  timeflag)

print_gc_info

Parameters
longtimeflag

Definition at line 1492 of file memory.c.

References gc_time, heap_pointer, life_time, mem_base, mem_limit, mem_size, and stack_pointer.

1493 {
1494  fprintf(stderr," [%ld%% free (%ldK), %ld%% heap, %ld%% stack",
1495  (100*((unsigned long)heap_pointer-(unsigned long)stack_pointer)+mem_size/2)/mem_size,
1496  ((unsigned long)heap_pointer-(unsigned long)stack_pointer+512)/1024,
1497  (100*((unsigned long)mem_limit-(unsigned long)heap_pointer)+mem_size/2)/mem_size,
1498  (100*((unsigned long)stack_pointer-(unsigned long)mem_base)+mem_size/2)/mem_size);
1499  if (timeflag) {
1500  fprintf(stderr,", %1.3fs cpu (%ld%%)",
1501  gc_time,
1502  (unsigned long)(0.5+100*gc_time/(life_time+gc_time)));
1503  }
1504  fprintf(stderr,"]\n");
1505 }
GENERIC mem_limit
Definition: def_glob.h:13
static float gc_time
Definition: memory.c:27
int mem_size
Definition: def_glob.h:9
static float life_time
Definition: memory.c:27
GENERIC mem_base
Definition: def_glob.h:11
GENERIC heap_pointer
Definition: def_glob.h:12
GENERIC stack_pointer
Definition: def_glob.h:14
void print_operator_kind ( FILE *  s,
long  kind 
)

print_operator_kind

Parameters
FILE*s
longkind

PRINT_OPERATOR_KIND(s,kind) Print the kind of an operator.

Definition at line 192 of file print.c.

References fx, fy, xf, xfx, xfy, yf, and yfx.

193 {
194  switch (kind) {
195  case xf:
196  fprintf(s,"xf");
197  break;
198  case fx:
199  fprintf(s,"fx");
200  break;
201  case yf:
202  fprintf(s,"yf");
203  break;
204  case fy:
205  fprintf(s,"fy");
206  break;
207  case xfx:
208  fprintf(s,"xfx");
209  break;
210  case xfy:
211  fprintf(s,"xfy");
212  break;
213  case yfx:
214  fprintf(s,"yfx");
215  break;
216  default:
217  fprintf(s,"illegal");
218  break;
219  }
220 }
#define yfx
Definition: def_const.h:268
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
#define xfy
Definition: def_const.h:267
#define xf
Definition: def_const.h:261
#define yf
Definition: def_const.h:263
#define fy
Definition: def_const.h:264
void print_resid_message ( ptr_psi_term  t,
ptr_resid_list  r 
)

print_resid_message

Parameters
ptr_psi_termt
ptr_resid_listr

PRINT_RESID_MESSAGE This is called in trace mode to print the residuated goal along with the RV set.

Definition at line 1690 of file print.c.

References buffer, check_pointer(), const_quote, end_tab(), FALSE, gen_sym_counter, heap_pointer, indent, indx, insert_variables(), listing_flag, mark_tab(), MAX_PRECEDENCE, new_tab(), wl_resid_list::next, NULL, outfile, pointer_names, pretty_tag_or_psi_term(), pretty_things, prettyf(), printed_pointers, TRUE, wl_resid_list::var, var_tree, write_canon, and write_resids.

1691 {
1692  GENERIC old_heap_pointer;
1693  ptr_tab_brk new;
1694  ptr_resid_list r2; /* 21.9 */
1695 
1696  outfile=stdout;
1698  old_heap_pointer=heap_pointer;
1699 
1702  gen_sym_counter=0;
1703 
1704  check_pointer(t);
1705 
1706  r2=r;
1707  while(r2) {
1708  check_pointer(r2->var);
1709  r2=r2->next;
1710  }
1711 
1713 
1714  indent=FALSE;
1715  const_quote=TRUE;
1718  *buffer=0;
1720  new_tab(&new);
1721  mark_tab(new);
1722 
1723  prettyf("residuating ");
1725  prettyf(" on variable(s) {");
1726 
1727  r2=r;
1728  while(r2) {
1730  r2=r2->next;
1731  if(r2)
1732  prettyf(",");
1733  }
1734 
1735  prettyf("}\n");
1736  end_tab();
1737 
1738  heap_pointer=old_heap_pointer;
1739 }
ptr_node printed_pointers
Definition: def_glob.h:28
ptr_resid_list next
Definition: def_struct.h:62
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
FILE * outfile
Definition: def_glob.h:333
ptr_node pointer_names
Definition: def_glob.h:29
#define TRUE
Definition: def_const.h:127
ptr_item indx
Definition: def_glob.h:329
#define FALSE
Definition: def_const.h:128
ptr_psi_term var
Definition: def_struct.h:60
GENERIC heap_pointer
Definition: def_glob.h:12
#define MAX_PRECEDENCE
Definition: def_const.h:103
long gen_sym_counter
Definition: def_glob.h:30
unsigned long * GENERIC
Definition: def_struct.h:17
char * print_symbol ( ptr_keyword  k)

print_symbol

OBSOLETE ptr_psi_term get_function_value(module,symbol)

ptr_module module; char *symbol;

{ ptr_node n; ptr_definition def; ptr_psi_term result=NULL; ptr_pair_list rule;

n=find(STRCMP,make_module_token(module,symbol),symbol_table); if(n) def=(ptr_definition)n->data; if(def && def->type==function) { rule=def->rule; while (rule && (!rule->aaaa_1 || !rule->bbbb_1)) rule=rule->next; if(rule) { result=(ptr_psi_term)rule->bbbb_1; deref_ptr(result); } } }

if(!result) Errorline("error in definition of '%s'\n",module_buffer);

return result; }

Parameters
ptr_keywordk

PRINT_SYMBOL(k) Returns the string to be used to display keyword K.

Definition at line 435 of file modules.c.

References wl_keyword::combined_name, wl_keyword::definition, display_modules, wl_definition::keyword, and wl_keyword::symbol.

436 {
437  k=k->definition->keyword;
438  if(display_modules)
439  return k->combined_name;
440  else
441  return k->symbol;
442 }
long display_modules
Definition: modules.c:25
char * combined_name
Definition: def_struct.h:92
ptr_definition definition
Definition: def_struct.h:96
ptr_keyword keyword
Definition: def_struct.h:124
char * symbol
Definition: def_struct.h:91
void print_undo_stack ( )

print_undo_stack

Definition at line 121 of file memory.c.

References wl_stack::aaaa_3, wl_stack::bbbb_3, mem_base, mem_limit, wl_stack::next, wl_stack::type, and undo_stack.

122 {
124 
125  while (u) {
126  if ((GENERIC)u->aaaa_3<mem_base || (GENERIC)u->aaaa_3>mem_limit ||
127  (GENERIC)u->next<mem_base || (GENERIC)u->next>mem_limit) {
128  printf("UNDO: type:%ld a:%lx b:%lx next:%lx\n",u->type,(unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3,(unsigned long)u->next);
129  (void)fflush(stdout);
130  }
131  u=u->next;
132  }
133 }
GENERIC mem_limit
Definition: def_glob.h:13
GENERIC * bbbb_3
Definition: def_struct.h:218
ptr_stack undo_stack
Definition: def_glob.h:53
type_ptr type
Definition: def_struct.h:216
GENERIC mem_base
Definition: def_glob.h:11
GENERIC * aaaa_3
Definition: def_struct.h:217
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
long print_variables ( long  printflag)

print_variables

Parameters
longprintflag

PRINT_VARIABLES This prints all the query variables. Symbols generated to print one variable are coherent with those used in other variables. Returns TRUE iff the set of query variables is nonempty.

Definition at line 1368 of file print.c.

References buffer, const_quote, end_tab(), FALSE, forbid_variables(), gen_sym_counter, go_through_tree(), heap_pointer, indent, indx, insert_variables(), listing_flag, mark_tab(), new_tab(), NULL, outfile, output_stream, pointer_names, pretty_output(), pretty_things, pretty_variables(), prettyf(), printed_pointers, TRUE, var_tree, work_out_length(), write_canon, and write_resids.

1369 {
1370  ptr_tab_brk new;
1371  GENERIC old_heap_pointer;
1372  if (!printflag) return FALSE; /* 21.1 */
1373 
1376  old_heap_pointer=heap_pointer;
1377 
1380  gen_sym_counter=0;
1384 
1385  indent=TRUE;
1386  const_quote=TRUE;
1389  *buffer=0;
1391 
1392  if (var_tree) {
1393  new_tab(&new);
1395  prettyf(".");
1396  mark_tab(new);
1397  prettyf("\n");
1398  end_tab();
1399 
1400  if (indent) {
1401  work_out_length();
1402  pretty_output();
1403  }
1404  }
1405  heap_pointer=old_heap_pointer;
1406  return (var_tree!=NULL);
1407 }
ptr_node printed_pointers
Definition: def_glob.h:28
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
FILE * outfile
Definition: def_glob.h:333
ptr_node pointer_names
Definition: def_glob.h:29
#define TRUE
Definition: def_const.h:127
ptr_item indx
Definition: def_glob.h:329
#define FALSE
Definition: def_const.h:128
GENERIC heap_pointer
Definition: def_glob.h:12
long gen_sym_counter
Definition: def_glob.h:30
FILE * output_stream
Definition: def_glob.h:41
unsigned long * GENERIC
Definition: def_struct.h:17
void propagate_always_check ( ptr_definition  d,
long *  ch 
)

propagate_always_check

Parameters
ptr_definitiond
long*ch

PROPAGATE_ALWAYS_CHECK(d,ch) Recursively set the always_check flag to 'FALSE' for all d's children. Continue until encountering only 'FALSE' values. Return a TRUE flag if a change was made somewhere (for the closure calculation).

Definition at line 1022 of file types.c.

References wl_definition::always_check, wl_definition::children, FALSE, wl_int_list::next, TRUE, and wl_int_list::value_1.

1023 {
1024  ptr_int_list child_list;
1025  ptr_definition child;
1026 
1027  child_list = d->children;
1028  while (child_list) {
1029  child = (ptr_definition)child_list->value_1;
1030  if (child->always_check) {
1031  child->always_check = FALSE;
1032  *ch = TRUE;
1033  propagate_always_check(child,ch);
1034  }
1035  child_list = child_list->next;
1036  }
1037 }
char always_check
Definition: def_struct.h:134
#define TRUE
Definition: def_const.h:127
void propagate_always_check(ptr_definition d, long *ch)
propagate_always_check
Definition: types.c:1022
#define FALSE
Definition: def_const.h:128
struct wl_definition * ptr_definition
Definition: def_struct.h:31
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list children
Definition: def_struct.h:131
ptr_int_list next
Definition: def_struct.h:55
void propagate_definitions ( )

propagate_definitions

PROPAGATE_DEFINITIONS() This routine propagates the definition (attributes,predicates) of a type to all its sons.

Definition at line 662 of file types.c.

References adults, wl_definition::children, children, find_adults(), insert_own_prop(), insert_prop(), wl_int_list::next, NULL, wl_definition::properties, and wl_int_list::value_1.

663 {
664  ptr_int_list kids;
665  ptr_definition d;
666 
667  adults=NULL;
668  find_adults();
669 
670  while (adults) {
671 
672  children=NULL;
673 
674  while (adults) {
676 
677  insert_own_prop(d);
679 
680  kids=d->children;
681 
682  while(kids) {
684  /* if (d->always_check && kids->value_1)
685  ((ptr_definition)kids->value_1)->always_check=TRUE; */
686  kids=kids->next;
687  }
688  adults=adults->next;
689  }
691  }
692 }
void find_adults()
find_adults
Definition: types.c:549
#define NULL
Definition: def_const.h:203
void insert_prop(ptr_definition d, ptr_triple_list prop)
insert_prop
Definition: types.c:620
struct wl_definition * ptr_definition
Definition: def_struct.h:31
void insert_own_prop(ptr_definition d)
insert_own_prop
Definition: types.c:575
ptr_int_list children
Definition: def_glob.h:354
ptr_int_list adults
Definition: def_glob.h:354
GENERIC value_1
Definition: def_struct.h:54
ptr_triple_list properties
Definition: def_struct.h:127
ptr_int_list children
Definition: def_struct.h:131
ptr_int_list next
Definition: def_struct.h:55
long prove_aim ( )

prove_aim

PROVE_AIM() This is the proving routine. It performs one proof step, that is: finding the definition to use to prove AIM, and unifying the HEAD with the GOAL before proving. It all works by pushing sub-goals onto the goal_stack. Special cases are CUT and AND (","). Built-in predicates written in C are called.

Definition at line 1645 of file login.c.

References wl_goal::aaaa_1, wl_pair_list::aaaa_2, aim, and, wl_psi_term::attr_list, wl_goal::bbbb_1, wl_pair_list::bbbb_2, boolpredsym, c_rule, call_handlersym, can_curry, choice_stack, clean_trail(), clear_copy(), wl_psi_term::coref, curried, cut, cut_to, wl_node::data, DEFRULES, deref_args, deref_ptr, do_currying(), do_residuation_user(), eval_copy(), FALSE, function_it, get_two_args(), goal_count, goal_stack, i_check_out(), i_eval_args(), wl_node::key, wl_node::left, lf_false, lf_true, life_or, MAX_BUILT_INS, merge(), wl_pair_list::next, wl_goal::next, NULL, one, predicate, wl_definition::protected, prove, push_choice_point(), push_goal(), push_psi_ptr_value(), quote_copy(), resid_aim, resid_vars, wl_node::right, wl_definition::rule, set_empty, STACK, stack_add_psi_attr(), STACK_ALLOC, stack_psi_term(), wl_psi_term::status, sub_type(), succeed, traceline(), tracesym, TRUE, wl_psi_term::type, wl_definition::type_def, type_it, undef, and wl_psi_term::value_3.

1646 {
1647  long success=TRUE;
1648  ptr_psi_term thegoal,head,body,arg1,arg2;
1649  ptr_pair_list rule;
1650 
1651  thegoal=(ptr_psi_term )aim->aaaa_1;
1652  rule=(ptr_pair_list )aim->bbbb_1;
1653 
1654  if (thegoal && rule) {
1655 
1656  deref_ptr(thegoal); /* Evaluation is explicitly handled later. */
1657 
1658  if (thegoal->type!=and) {
1659  if (thegoal->type!=cut)
1660  if(thegoal->type!=life_or) {
1661  /* User-defined predicates with unevaluated arguments */
1662  /* Built-ins do this themselves (see built_ins.c). */
1663  /* if (!thegoal->type->evaluate_args) mark_quote(thegoal); 24.8 25.8 */
1664 
1665  if(i_check_out(thegoal)) { /* RM: Apr 6 1993 */
1666 
1667  goal_stack=aim->next;
1668  goal_count++;
1669 
1670  if ((unsigned long)rule==DEFRULES) {
1671  rule=(ptr_pair_list)thegoal->type->rule;
1672  if (thegoal->type->type_def==(def_type)predicate) {
1673  if (!rule) /* This can happen when RETRACT is used */
1674  success=FALSE;
1675  }
1676  else if ( thegoal->type->type_def==(def_type)function_it
1677  || ( thegoal->type->type_def==(def_type)type_it
1678  && sub_type(boolean,thegoal->type)
1679  )
1680  ) {
1681  if (thegoal->type->type_def==(def_type)function_it && !rule)
1682  /* This can happen when RETRACT is used */
1683  success=FALSE;
1684  else {
1685  ptr_psi_term bool_pred;
1686  ptr_node a;
1687  /* A function F in pred. position is called as */
1688  /* '*bool_pred*'(F), which succeeds if F returns true */
1689  /* and fails if it returns false. It can residuate too. */
1690  bool_pred=stack_psi_term(0);
1691  bool_pred->type=boolpredsym;
1692  bool_pred->attr_list=(a=STACK_ALLOC(node));
1693  a->key=one;
1694  a->left=a->right=NULL;
1695  a->data=(GENERIC) thegoal;
1697  return success; /* We're done! */
1698  }
1699  }
1700  else if (!thegoal->type->protected && thegoal->type->type_def==(def_type)undef) {
1701  /* Don't give an error message for undefined dynamic objects */
1702  /* that do not yet have a definition */
1703  success=FALSE;
1704  }
1705  else if (thegoal->type==lf_true || thegoal->type==lf_false) {
1706  /* What if the 'lf_true' or 'lf_false' have arguments? */
1707  success=(thegoal->type==lf_true);
1708  return success; /* We're done! */
1709  }
1710  else {
1711  /* Error: undefined predicate. */
1712  /* Call the call_handler (which may do an auto-load). */
1713  ptr_psi_term call_handler;
1714  /* mark_quote(thegoal); */
1715 
1716  /* RM: Jan 27 1993 */
1717  /* warningline("call handler invoked for %P\n",thegoal); */
1718 
1719  call_handler=stack_psi_term(0);
1720  call_handler->type=call_handlersym;
1721  stack_add_psi_attr(call_handler,"1",thegoal);
1723  return success; /* We're done! */
1724  }
1725  }
1726 
1727  if (success) {
1728 
1729  if ((unsigned long)rule<=MAX_BUILT_INS) {
1730 
1731  /* For residuation (RESPRED) */
1732  curried=FALSE;
1733  can_curry=TRUE;
1734  resid_vars=NULL;
1735  /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
1736 
1737  if (thegoal->type!=tracesym) /* 26.1 */
1738  traceline("prove built-in %P\n", thegoal);
1739 
1740  /* RESPRED */ resid_aim=aim;
1741  /* Residuated predicate must return success=TRUE */
1742  success=c_rule[(unsigned long)rule]();
1743 
1744  /* RESPRED */ if (curried)
1745  /* RESPRED */ do_currying();
1746  /* RESPRED */ else if (resid_vars)
1747  /* RESPRED */ success=do_residuation_user(); /* 21.9 */ /* PVR 9.2.94 */
1748  }
1749  else {
1750 
1751  /* Evaluate arguments of a predicate call before the call. */
1752  deref_args(thegoal,set_empty);
1753 
1754  traceline("prove %P\n", thegoal);
1755 
1756  /* For residuation (RESPRED) */
1757  curried=FALSE;
1758  can_curry=TRUE;
1759  resid_vars=NULL;
1760  /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
1761 
1762  while (rule && (rule->aaaa_2==NULL || rule->bbbb_2==NULL)) {
1763  rule=rule->next;
1764  traceline("alternative clause has been retracted\n");
1765  }
1766  if (rule) {
1767 
1768  clear_copy();
1769  if (TRUE) /* 8.9 */
1770  /* if (thegoal->type->evaluate_args) 8.9 */
1771  head=eval_copy(rule->aaaa_2,STACK);
1772  else
1773  head=quote_copy(rule->aaaa_2,STACK);
1774 
1775  body=eval_copy(rule->bbbb_2,STACK);
1776 
1777  /* What does this do?? */
1778  /* if (body->type==built_in) */
1779  /* body->coref=head; */
1780 
1781  if (rule->next)
1782  push_choice_point(prove,thegoal,(ptr_psi_term)rule->next,NULL);
1783 
1784  if (body->type!=succeed)
1786 
1787  /* push_ptr_value(psi_term_ptr,&(head->coref)); 9.6 */
1788  push_psi_ptr_value(head,(GENERIC *)&(head->coref));
1789  head->coref=thegoal;
1790  merge(&(thegoal->attr_list),head->attr_list);
1791  if (!head->status) {
1792  (void)i_eval_args(head->attr_list);
1793  }
1794  }
1795  else {
1796  success=FALSE;
1797  }
1798  }
1799  }
1800  }
1801  }
1802  else { /* ';' built-in */
1803  /* RM: Apr 6 1993 */
1804  goal_stack=aim->next;
1805  goal_count++;
1806  get_two_args(thegoal->attr_list,&arg1,&arg2);
1809  }
1810  else { /* 'Cut' built-in*/
1811  goal_stack=aim->next;
1812  goal_count++;
1813  /* assert((ptr_choice_point)(thegoal->value)<=choice_stack); 12.7 */
1814  cut_to(thegoal->value_3); /* 12.7 */
1815 #ifdef CLEAN_TRAIL
1817 #endif
1818  traceline("cut all choice points back to %x\n",choice_stack);
1819  }
1820  }
1821  else { /* 'And' built-in */
1822  goal_stack=aim->next;
1823  goal_count++;
1824  get_two_args(thegoal->attr_list,&arg1,&arg2);
1827  }
1828  }
1829  else
1830  success=FALSE;
1831 
1832  /* RESPRED */ resid_aim=NULL;
1833  return success;
1834 }
#define prove
Definition: def_const.h:273
ptr_definition boolpredsym
Definition: def_glob.h:74
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 clear_copy()
clear_copy
Definition: copy.c:53
struct wl_definition * def_type
Definition: def_struct.h:32
long do_residuation_user()
do_residuation_user()
Definition: lefun.c:324
ptr_goal goal_stack
Definition: def_glob.h:50
ptr_pair_list next
Definition: def_struct.h:191
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
push_goal
Definition: login.c:600
#define undef
Definition: def_const.h:360
long(* c_rule[MAX_BUILT_INS])()
Definition: def_glob.h:247
def_type type_def
Definition: def_struct.h:133
#define set_empty
Definition: def_const.h:193
#define DEFRULES
Definition: def_const.h:138
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
void merge(ptr_node *u, ptr_node v)
merge
Definition: login.c:1131
ptr_resid_list resid_vars
Definition: def_glob.h:221
void stack_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
stack_add_psi_attr
Definition: token.c:239
ptr_node left
Definition: def_struct.h:183
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
void traceline(char *format,...)
Definition: error.c:157
#define type_it
Definition: def_const.h:363
ptr_psi_term quote_copy(ptr_psi_term t, long heap_flag)
quote_copy
Definition: copy.c:186
long goal_count
Definition: def_glob.h:152
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
#define deref_ptr(P)
Definition: def_macro.h:95
void do_currying()
do_currying
Definition: lefun.c:383
char * key
Definition: def_struct.h:182
#define TRUE
Definition: def_const.h:127
static void clean_trail(ptr_choice_point cutpt)
clean_trail
Definition: login.c:810
ptr_definition lf_true
Definition: def_glob.h:107
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
ptr_definition succeed
Definition: def_glob.h:104
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
ptr_definition and
Definition: def_glob.h:71
GENERIC value_3
Definition: def_struct.h:170
ptr_definition lf_false
Definition: def_glob.h:89
struct wl_pair_list * ptr_pair_list
Definition: def_struct.h:36
#define cut_to(C)
Definition: def_macro.h:80
ptr_psi_term bbbb_2
Definition: def_struct.h:190
ptr_goal aim
Definition: def_glob.h:49
ptr_psi_term coref
Definition: def_struct.h:172
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
get_two_args
Definition: login.c:47
char * one
Definition: def_glob.h:250
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_definition life_or
Definition: def_glob.h:95
long can_curry
Definition: def_glob.h:224
long i_eval_args(ptr_node n)
i_eval_args
Definition: lefun.c:874
ptr_definition tracesym
Definition: def_glob.h:109
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
ptr_definition cut
Definition: def_glob.h:83
#define MAX_BUILT_INS
Definition: def_const.h:82
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
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
ptr_definition call_handlersym
Definition: def_glob.h:121
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
push_choice_point
Definition: login.c:638
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define STACK
Definition: def_const.h:148
ptr_node right
Definition: def_struct.h:184
ptr_goal next
Definition: def_struct.h:227
void psi_term_error ( )

psi_term_error

PSI_TERM_ERROR Print the line number at which the current psi_term started.

Definition at line 761 of file token.c.

References FALSE, input_file_name, parse_ok, perr_i(), perr_s(), and psi_term_line_number.

762 {
763  perr_i("near line %ld",psi_term_line_number);
764  if (strcmp(input_file_name,"stdin")) {
765  perr_s(" in file \042%s\042",input_file_name);
766  }
767  /* prompt="error>"; 20.8 */
768  parse_ok=FALSE;
769 }
long psi_term_line_number
Definition: def_glob.h:268
string input_file_name
Definition: def_glob.h:40
void perr_s(char *s1, char *s2)
Definition: error.c:665
#define FALSE
Definition: def_const.h:128
long parse_ok
Definition: def_glob.h:171
void perr_i(char *str, long i)
Definition: error.c:677
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
void push ( psi_term  tok,
long  prec,
long  op 
)

push

Parameters
psi_termtok
longprec
longop

PUSH(tok,prec,op) Push psi_term and precedence and operator onto parser stack.

Definition at line 107 of file parser.c.

References int_stack, parser_stack_index, PARSER_STACK_SIZE, perr(), psi_term_error(), and psi_term_stack.

108 {
110  perr("*** Parser error ");
111  psi_term_error();
112  perr(": stack full.\n");
113  }
114  else {
118  op_stack[parser_stack_index]=op;
119  }
120 }
void psi_term_error()
psi_term_error
Definition: token.c:761
void perr(char *str)
Definition: error.c:659
#define PARSER_STACK_SIZE
Definition: def_const.h:100
long parser_stack_index
Definition: def_glob.h:24
long int_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:318
psi_term psi_term_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:317
void push2_ptr_value ( type_ptr  t,
GENERIC p,
GENERIC  v 
)

push2_ptr_value

Parameters
type_ptrt
GENERIC*p
GENERICv

PUSH2_PTR_VALUE(t,*p,v) Push the pair (P,V) onto the stack of things to be undone (trail). It needn't be done if P is greater than the latest choice point because in that case memory is reclaimed.

Definition at line 573 of file login.c.

References wl_stack::aaaa_3, wl_stack::bbbb_3, choice_stack, wl_stack::next, STACK_ALLOC, stack_pointer, wl_stack::type, and undo_stack.

574 {
575  ptr_stack n;
576 
577  if (p<(GENERIC *)choice_stack || p>(GENERIC *)stack_pointer) {
578  n=STACK_ALLOC(stack);
579  n->type=t;
580  n->aaaa_3= (GENERIC *)p;
581  n->bbbb_3= (GENERIC *)v;
582  n->next=undo_stack;
583  undo_stack=n;
584  }
585 }
GENERIC * bbbb_3
Definition: def_struct.h:218
ptr_stack undo_stack
Definition: def_glob.h:53
type_ptr type
Definition: def_struct.h:216
#define STACK_ALLOC(A)
Definition: def_macro.h:16
GENERIC * aaaa_3
Definition: def_struct.h:217
GENERIC stack_pointer
Definition: def_glob.h:14
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
ptr_choice_point choice_stack
Definition: def_glob.h:51
void push_choice_point ( goals  t,
ptr_psi_term  aaaa_6,
ptr_psi_term  bbbb_6,
GENERIC  cccc_6 
)

push_choice_point

Parameters
goalst
ptr_psi_termaaaa_6
ptr_psi_termbbbb_6
GENERICcccc_6)

PUSH_CHOICE_POINT(t,a,b,c) T,A,B,C is an alternative goal to try. T is the type of the goal: unify or prove.

If T=prove then a=goal to prove b=definition to use if b=DEFRULES then that means it's a first call.

If T=unify then a and b are the terms to unify.

etc...

Definition at line 638 of file login.c.

References wl_goal::aaaa_1, wl_goal::bbbb_1, wl_goal::cccc_1, choice_stack, FALSE, global_time_stamp, goal_stack, wl_choice_point::goal_stack, wl_goal::next, wl_choice_point::next, wl_goal::pending, STACK_ALLOC, stack_pointer, wl_choice_point::stack_top, wl_choice_point::time_stamp, wl_goal::type, wl_choice_point::undo_point, and undo_stack.

639 {
640  ptr_goal alternative;
641  ptr_choice_point choice;
642  GENERIC top_loc;
643 
644  alternative=STACK_ALLOC(goal);
645 
646  alternative->type=t;
647  alternative->aaaa_1=aaaa_6;
648  alternative->bbbb_1=bbbb_6;
649  alternative->cccc_1=cccc_6;
650  alternative->next=goal_stack;
651  alternative->pending=FALSE;
652 
653  top_loc=stack_pointer;
654 
655  choice=STACK_ALLOC(choice_point);
656 
657  choice->undo_point=undo_stack;
658  choice->goal_stack=alternative;
659  choice->next=choice_stack;
660  choice->stack_top=top_loc;
661 
662 #ifdef TS
663  choice->time_stamp=global_time_stamp; /* 9.6 */
664  global_time_stamp++; /* 9.6 */
665 #endif
666 
667  choice_stack=choice;
668 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_goal goal_stack
Definition: def_glob.h:50
GENERIC cccc_1
Definition: def_struct.h:226
ptr_stack undo_point
Definition: def_struct.h:233
GENERIC stack_top
Definition: def_struct.h:236
unsigned long time_stamp
Definition: def_struct.h:232
ptr_choice_point next
Definition: def_struct.h:235
ptr_stack undo_stack
Definition: def_glob.h:53
goals type
Definition: def_struct.h:223
#define FALSE
Definition: def_const.h:128
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_goal goal_stack
Definition: def_struct.h:234
unsigned long global_time_stamp
Definition: login.c:28
GENERIC stack_pointer
Definition: def_glob.h:14
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_definition pending
Definition: def_struct.h:228
ptr_choice_point choice_stack
Definition: def_glob.h:51
ptr_goal next
Definition: def_struct.h:227
void push_def_ptr_value ( ptr_psi_term  q,
GENERIC p 
)

push_def_ptr_value

Parameters
ptr_psi_termq
GENERIC*p

PUSH_DEF_PTR_VALUE(q,p) (9.6) Same as push_ptr_value, but only for psi-terms whose definition field is being modified. (If another field is modified, use push_ptr_value.) This routine implements the time-stamp technique of only trailing once between choice point creations, even on multiple bindings. q is address of psi-term, p is address of field inside psi-term that is modified. Both the definition and the time_stamp must be trailed.

Definition at line 416 of file login.c.

References wl_stack::aaaa_3, assert, wl_stack::bbbb_3, choice_stack, def_ptr, global_time_stamp, heap_pointer, int_ptr, wl_stack::next, push_ptr_value(), STACK_ALLOC, stack_pointer, trail_condition(), wl_stack::type, undo_stack, and VALID_ADDRESS.

417 {
418  ptr_stack m,n;
419 
420  assert(VALID_ADDRESS(q));
421  assert(VALID_ADDRESS(p));
422 #ifdef TS
423  if (trail_condition(q) &&
424  /* (q->time_stamp != global_time_stamp) && */
425  (p < (GENERIC *)choice_stack || p > (GENERIC *)stack_pointer))
426  {
427 #define TRAIL_TS
428 #ifdef TRAIL_TS
429 
430  assert((GENERIC)q<heap_pointer); /* RM: Feb 15 1993 */
431 
432  m=STACK_ALLOC(stack); /* Trail time_stamp */
433  m->type=int_ptr;
434  m->aaaa_3= (GENERIC *) &(q->time_stamp);
435  m->bbbb_3= (GENERIC *) (q->time_stamp);
436  m->next=undo_stack;
437  n=STACK_ALLOC(stack); /* Trail definition field (top of undo_stack) */
438  n->type=def_ptr;
439  n->aaaa_3= p;
440  n->bbbb_3= (GENERIC *)*p;
441  n->next=m;
442  undo_stack=n;
443 #else
444  n=STACK_ALLOC(stack); /* Trail definition field (top of undo_stack) */
445  n->type=def_ptr;
446  n->aaaa_3= p;
447  n->bbbb_3= (GENERIC *) *p;
448  n->next=undo_stack;
449  undo_stack=n;
450 #endif
451  q->time_stamp=global_time_stamp;
452  }
453 #else
455 #endif
456 }
#define VALID_ADDRESS(A)
Definition: def_macro.h:132
#define def_ptr
Definition: def_const.h:173
GENERIC * bbbb_3
Definition: def_struct.h:218
ptr_stack undo_stack
Definition: def_glob.h:53
long trail_condition(psi_term *Q)
trail_condition
Definition: login.c:2632
type_ptr type
Definition: def_struct.h:216
GENERIC heap_pointer
Definition: def_glob.h:12
#define STACK_ALLOC(A)
Definition: def_macro.h:16
GENERIC * aaaa_3
Definition: def_struct.h:217
unsigned long global_time_stamp
Definition: login.c:28
GENERIC stack_pointer
Definition: def_glob.h:14
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define assert(N)
Definition: memory.c:113
#define int_ptr
Definition: def_const.h:172
void push_goal ( goals  t,
ptr_psi_term  aaaa_5,
ptr_psi_term  bbbb_5,
GENERIC  cccc_5 
)

push_goal

Parameters
goalst
ptr_psi_termaaaa_5
ptr_psi_termbbbb_5
GENERICcccc_5

PUSH_GOAL(t,a,b,c) Push a goal onto the goal stack. T is the type of the goal, A,B and C are various parameters. See PUSH_CHOICE_POINT(t,a,b,c).

Definition at line 600 of file login.c.

References wl_goal::aaaa_1, wl_goal::bbbb_1, wl_goal::cccc_1, FALSE, goal_stack, wl_goal::next, wl_goal::pending, STACK_ALLOC, and wl_goal::type.

601 {
602  ptr_goal thegoal;
603 
604  thegoal=STACK_ALLOC(goal);
605 
606  thegoal->type=t;
607  thegoal->aaaa_1=aaaa_5;
608  thegoal->bbbb_1=bbbb_5;
609  thegoal->cccc_1=cccc_5;
610  thegoal->next=goal_stack;
611  thegoal->pending=FALSE;
612 
613  goal_stack=thegoal;
614 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_goal goal_stack
Definition: def_glob.h:50
GENERIC cccc_1
Definition: def_struct.h:226
goals type
Definition: def_struct.h:223
#define FALSE
Definition: def_const.h:128
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_definition pending
Definition: def_struct.h:228
ptr_goal next
Definition: def_struct.h:227
void push_psi_ptr_value ( ptr_psi_term  q,
GENERIC p 
)

push_psi_ptr_value

Parameters
ptr_psi_termq
GENERIC*p

PUSH_PSI_PTR_VALUE(q,p) (9.6) Same as push_ptr_value, but only for psi-terms whose coref field is being modified. (If another field is modified, use push_ptr_value.) This routine implements the time-stamp technique of only trailing once between choice point creations, even on multiple bindings. q is address of psi-term, p is address of field inside psi-term that is modified. Both the coref and the time_stamp must be trailed.

Definition at line 474 of file login.c.

References wl_stack::aaaa_3, assert, wl_stack::bbbb_3, choice_stack, global_time_stamp, int_ptr, wl_stack::next, psi_term_ptr, push_ptr_value(), STACK_ALLOC, stack_pointer, trail_condition(), wl_stack::type, undo_stack, and VALID_ADDRESS.

475 {
476  ptr_stack m,n;
477 
478  assert(VALID_ADDRESS(q));
479  assert(VALID_ADDRESS(p));
480 #ifdef TS
481  if (trail_condition(q) &&
482  /* (q->time_stamp != global_time_stamp) && */
483  (p < (GENERIC *)choice_stack || p > (GENERIC *)stack_pointer))
484  {
485 #define TRAIL_TS
486 #ifdef TRAIL_TS
487  m=STACK_ALLOC(stack); /* Trail time_stamp */
488  m->type=int_ptr;
489  m->aaaa_3= (GENERIC *) &(q->time_stamp);
490  m->bbbb_3= (GENERIC *) (q->time_stamp);
491  m->next=undo_stack;
492  n=STACK_ALLOC(stack); /* Trail coref field (top of undo_stack) */
493  n->type=psi_term_ptr;
494  n->aaaa_3= (GENERIC *) p;
495  n->bbbb_3= (GENERIC *) *p;
496  n->next=m;
497  undo_stack=n;
498 #else
499  n=STACK_ALLOC(stack); /* Trail coref field (top of undo_stack) */
500  n->type=psi_term_ptr;
501  n->aaaa_3= (ptr_psi_term)p;
502  n->bbbb_3= *p;
503  n->next=undo_stack;
504  undo_stack=n;
505 #endif
506  q->time_stamp=global_time_stamp;
507  }
508 #else
510 #endif
511 }
#define VALID_ADDRESS(A)
Definition: def_macro.h:132
GENERIC * bbbb_3
Definition: def_struct.h:218
ptr_stack undo_stack
Definition: def_glob.h:53
long trail_condition(psi_term *Q)
trail_condition
Definition: login.c:2632
type_ptr type
Definition: def_struct.h:216
#define STACK_ALLOC(A)
Definition: def_macro.h:16
GENERIC * aaaa_3
Definition: def_struct.h:217
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
unsigned long global_time_stamp
Definition: login.c:28
GENERIC stack_pointer
Definition: def_glob.h:14
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define assert(N)
Definition: memory.c:113
#define psi_term_ptr
Definition: def_const.h:170
#define int_ptr
Definition: def_const.h:172
push_ptr_value ( type_ptr  t,
GENERIC p 
)

push_ptr_value

Parameters
type_ptrt
GENERIC*p

PUSH_PTR_VALUE(t,*p) Push the pair (P,*P) onto the stack of things to be undone (trail). It needn't be done if P is greater than the latest choice point because in that case memory is reclaimed.

Definition at line 383 of file login.c.

References wl_stack::aaaa_3, assert, wl_stack::bbbb_3, choice_stack, heap_pointer, wl_stack::next, STACK_ALLOC, stack_pointer, wl_stack::type, undo_stack, and VALID_ADDRESS.

384 {
385  ptr_stack n;
386 
387  assert(p<(GENERIC *)heap_pointer); /* RM: Feb 15 1993 */
388 
389  assert(VALID_ADDRESS(p));
390  if (p < (GENERIC *)choice_stack || p > (GENERIC *)stack_pointer)
391  {
392  n=STACK_ALLOC(stack);
393  n->type=t;
394  n->aaaa_3= (GENERIC *) p;
395  n->bbbb_3= (GENERIC *) *p;
396  n->next=undo_stack;
397  undo_stack=n;
398  }
399 }
#define VALID_ADDRESS(A)
Definition: def_macro.h:132
GENERIC * bbbb_3
Definition: def_struct.h:218
ptr_stack undo_stack
Definition: def_glob.h:53
type_ptr type
Definition: def_struct.h:216
GENERIC heap_pointer
Definition: def_glob.h:12
#define STACK_ALLOC(A)
Definition: def_macro.h:16
GENERIC * aaaa_3
Definition: def_struct.h:217
GENERIC stack_pointer
Definition: def_glob.h:14
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define assert(N)
Definition: memory.c:113
void push_ptr_value_global ( type_ptr  t,
GENERIC p 
)

push_ptr_value_global

Parameters
type_ptrt
GENERIC*p

Same as push_ptr_value, but for objects that must always be trailed. This includes objects outside of the Life data space and entries in the var_tree.

Definition at line 523 of file login.c.

References wl_stack::aaaa_3, assert, wl_stack::bbbb_3, wl_stack::next, STACK_ALLOC, wl_stack::type, undo_stack, and VALID_ADDRESS.

524 {
525  ptr_stack n;
526 
527  assert(VALID_ADDRESS(p)); /* 17.8 */
528  n=STACK_ALLOC(stack);
529  n->type=t;
530  n->aaaa_3= (GENERIC *) p;
531  n->bbbb_3= (GENERIC *) *p;
532  n->next=undo_stack;
533  undo_stack=n;
534 }
#define VALID_ADDRESS(A)
Definition: def_macro.h:132
GENERIC * bbbb_3
Definition: def_struct.h:218
ptr_stack undo_stack
Definition: def_glob.h:53
type_ptr type
Definition: def_struct.h:216
#define STACK_ALLOC(A)
Definition: def_macro.h:16
GENERIC * aaaa_3
Definition: def_struct.h:217
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
#define assert(N)
Definition: memory.c:113
void push_window ( long  type,
long  disp,
long  wind 
)

push_window

Parameters
longtype
longdisp
longwind

PUSH_WINDOW(type,disp,wind) Push the window information (operation, display and window identifiers) on the undo_stack (trail) so that the window can be destroyed, redrawn, or hidden on backtracking.

Definition at line 548 of file login.c.

References wl_stack::aaaa_3, assert, wl_stack::bbbb_3, wl_stack::next, STACK_ALLOC, wl_stack::type, undo_action, and undo_stack.

549 {
550  ptr_stack n;
551 
552  assert(type & undo_action);
553  n=STACK_ALLOC(stack);
554  n->type=type;
555  n->aaaa_3=(GENERIC *)disp;
556  n->bbbb_3=(GENERIC *)wind;
557  n->next=undo_stack;
558  undo_stack=n;
559 }
GENERIC * bbbb_3
Definition: def_struct.h:218
ptr_stack undo_stack
Definition: def_glob.h:53
type_ptr type
Definition: def_struct.h:216
#define STACK_ALLOC(A)
Definition: def_macro.h:16
GENERIC * aaaa_3
Definition: def_struct.h:217
#define undo_action
Definition: def_const.h:188
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
#define assert(N)
Definition: memory.c:113
void put_back_char ( long  c)

put_back_char

Parameters
longc

PUT_BACK_CHAR Put back one character, if there already are 2 saved characters then report an error (= bug).

Definition at line 729 of file token.c.

References Errorline(), old_saved_char, and saved_char.

730 {
731  if (old_saved_char)
732  Errorline("in tokenizer, put_back_char three times (last=%d).\n",c);
734  saved_char=c;
735 }
long old_saved_char
Definition: def_glob.h:193
long saved_char
Definition: def_glob.h:192
void Errorline(char *format,...)
Definition: error.c:414
void put_back_token ( psi_term  t)

put_back_token

Parameters
psi_termt

PUT_BACK_TOKEN Put back a psi_term, if there already are two saved then report an error (= bug).

Definition at line 746 of file token.c.

References Errorline(), NULL, old_saved_psi_term, saved_psi_term, and stack_copy_psi_term().

747 {
749  Errorline("in parser, put_back_token three times (last=%P).\n",t);
752 }
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Definition: error.c:414
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
ptr_psi_term quote_copy ( ptr_psi_term  t,
long  heap_flag 
)

quote_copy

Parameters
ptr_psi_termt
longheap_flag

Definition at line 186 of file copy.c.

References copy(), FALSE, QUOTE_FLAG, and to_heap.

187 { to_heap=FALSE; return (copy(t, QUOTE_FLAG, heap_flag)); }
ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
copy
Definition: copy.c:248
long to_heap
Definition: def_glob.h:264
#define FALSE
Definition: def_const.h:128
#define QUOTE_FLAG
Definition: def_const.h:326
ptr_psi_term quotedStackCopy ( psi_term  p)

make psi term from unitListElement

Parameters
psi_termp

not sure purpose (DJD ???)

Definition at line 527 of file bi_sys.c.

References mark_quote(), and stack_copy_psi_term().

528 {
529  ptr_psi_term q;
530 
532  mark_quote(q);
533  return q;
534 }
void mark_quote(ptr_psi_term t)
mark_quote
Definition: copy.c:675
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void raw_setup_builtins ( )

raw_setup_builtins

set up the built-ins for the mode raw

Definition at line 311 of file raw.c.

References bi_module, c_begin_raw(), c_end_raw(), c_get_raw(), c_in_raw(), c_put_raw(), c_reset_window_flag(), c_window_flag(), function_it, new_built_in(), and predicate.

312 {
313 #ifndef NORAW
320  new_built_in(bi_module,"reset_window_flag", predicate, c_reset_window_flag);
321 #endif
322 }
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
new_built_in
Definition: built_ins.c:5371
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
long c_get_raw()
c_get_raw
Definition: raw.c:107
long c_begin_raw()
c_begin_raw
Definition: raw.c:39
long c_put_raw()
c_put_raw
Definition: raw.c:206
long c_window_flag()
c_window_flag
Definition: raw.c:273
long c_end_raw()
c_end_raw
Definition: raw.c:230
long c_in_raw()
Definition: raw.c:256
long c_reset_window_flag()
c_reset_window_flag
Definition: raw.c:294
ptr_module bi_module
Definition: def_glob.h:155
long read_char ( )

read_char

READ_CHAR Return the char read from the input stream, if end of file reached then return EOF. If stringparse==TRUE then read characters from the input string instead of from a file.

Definition at line 680 of file token.c.

References EOLN, FALSE, infoline(), input_stream, line_count, NULL, old_saved_char, prompt, saved_char, start_of_line, stringinput, stringparse, trace_input, and TRUE.

681 {
682  int c=0;
683 
684  if ((c=saved_char)) {
686  old_saved_char=0;
687  }
688  else if (stringparse) {
689  if ((c=(*stringinput)))
690  stringinput++;
691  else
692  c=EOF;
693  }
694  else if (input_stream == NULL || feof(input_stream))
695  c=EOF;
696  else {
697  if (start_of_line) {
699  line_count++;
700  if (input_stream==stdin) infoline("%s",prompt); /* 21.1 */
701  }
702 
703  c=fgetc(input_stream);
704 
705  if(trace_input) /* RM: Jan 13 1993 */
706  if(c!=EOF)
707  printf("%c",c);
708  else
709  printf(" <EOF>\n");
710 
711  if (c==EOLN)
713  }
714 
715  /* printf("%c\n",c); RM: Jan 5 1993 Just to trace the parser */
716 
717  return c;
718 }
long start_of_line
Definition: def_glob.h:191
long old_saved_char
Definition: def_glob.h:193
#define NULL
Definition: def_const.h:203
long saved_char
Definition: def_glob.h:192
long trace_input
Definition: token.c:12
long line_count
Definition: def_glob.h:39
#define EOLN
Definition: def_const.h:140
void infoline(char *format,...)
Definition: error.c:245
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
FILE * input_stream
Definition: def_glob.h:38
char * prompt
Definition: def_glob.h:42
long stringparse
Definition: def_glob.h:202
char * stringinput
Definition: def_glob.h:203
void read_comment ( ptr_psi_term  tok)

read_comment

Parameters
ptr_psi_termtok

READ_COMMENT Read a comment starting with '' to the end of the line.

Definition at line 779 of file token.c.

References comment, EOLN, read_char(), and wl_psi_term::type.

780 {
781  long c;
782 
783  do {
784  c=read_char();
785  } while (c!=EOF && c!=EOLN);
786 
787  tok->type=comment;
788 }
ptr_definition comment
Definition: def_glob.h:80
#define EOLN
Definition: def_const.h:140
ptr_definition type
Definition: def_struct.h:165
long read_char()
read_char
Definition: token.c:680
psi_term read_life_form ( char  ch1,
char  ch2 
)

read_life_form

Parameters
charch1
charch2

READ_LIFE_FORM(str1,str2) This reads in one life-form from the input stream which finishes with the psi_term whose name is STR1 or STR2, typically if we're reading a list [A,4*5,b-4!] then STR1="," and STR2="|" . It would be incorrect if "," were taken as an operator.

This routine implements the two state expression parser as described in the implementation guide. It deals with all the various types of operators, precedence is dealt with by the CRUNCH function. Each time an opening parenthesis is encountered a new expression is started.

Definition at line 728 of file parser.c.

References wl_psi_term::attr_list, bad_psi_term(), crunch(), equ_tokc, equ_tokch, error_psi_term, FALSE, fx, fy, line_count, MAX_PRECEDENCE, nop, NOP, parse_ok, parser_stack_index, pop(), precedence(), push(), put_back_token(), read_psi_term(), read_token(), stringparse, Syntaxerrorline(), TRUE, xf, xfx, xfy, yf, and yfx.

729 {
730  psi_term t,t2;
731  long limit,pr_op,pr_1,pr_2,start=0;
732  long fin=FALSE;
733  long state=0;
734  long prec=0;
735 
736  long op;
737 
738  limit=parser_stack_index+1;
739 
740  if (parse_ok)
741  do {
742  if (state)
743  read_token(&t);
744  else
745  t=read_psi_term();
746 
747  if (!start)
748  start=line_count;
749 
750  if (!fin)
751  if (state) {
752  if (equ_tokc(t,ch1) || equ_tokc(t,ch2)) {
753  fin=TRUE;
754  put_back_token(t);
755  }
756  else {
757  pr_op=precedence(t,xf);
758  pr_1=pr_op-1;
759 
760  if(pr_op==NOP) {
761  pr_op=precedence(t,yf);
762  pr_1=pr_op;
763  }
764 
765  if(pr_op==NOP) {
766 
767  pr_op=precedence(t,xfx);
768  pr_1=pr_op-1;
769  pr_2=pr_op-1;
770 
771  if(pr_op==NOP) {
772  pr_op=precedence(t,xfy);
773  pr_1=pr_op-1;
774  pr_2=pr_op;
775  }
776 
777  if(pr_op==NOP) {
778  pr_op=precedence(t,yfx);
779  pr_1=pr_op;
780  pr_2=pr_op-1;
781  }
782 
783  /* if(pr_op==NOP) {
784  pr_op=precedence(t,yfy);
785  pr_1=pr_op;
786  pr_2=pr_op-1;
787  }
788  */
789 
790  if(pr_op==NOP) {
791  fin=TRUE;
792  put_back_token(t);
793  }
794  else
795  {
796  crunch(pr_1,limit);
797  push(t,pr_2,xfx);
798  prec=pr_2;
799  state=0;
800  }
801  }
802  else {
803  crunch(pr_1,limit);
804  push(t,pr_1,xf);
805  prec=pr_1;
806  }
807  }
808  }
809  else {
810 
811  if(t.attr_list)
812  pr_op=NOP;
813  else {
814  pr_op=precedence(t,fx);
815  pr_2=pr_op-1;
816 
817  if(pr_op==NOP) {
818  pr_op=precedence(t,fy);
819  pr_2=pr_op;
820  }
821  }
822 
823  if(pr_op==NOP) {
824  if(equ_tokch(t,'(')) {
825  t2=read_life_form(')',0);
826  if(parse_ok) {
827  push(t2,prec,nop);
828  read_token(&t2);
829  if(!equ_tokch(t2,')')) {
831  else {
832  /*
833  perr("*** Syntax error ");psi_term_error();
834  perr(": ')' missing.\n");
835  */
836 
837  /* RM: Feb 1 1993 */
838  Syntaxerrorline("')' missing (%E)\n");
839 
840  put_back_token(t2);
841  }
842  }
843  state=1;
844  }
845  }
846  else
847  if(bad_psi_term(&t)) {
848  put_back_token(t);
849  /* psi_term_error(); */
850  fin=TRUE;
851  }
852  else {
853  push(t,prec,nop);
854  state=1;
855  }
856  }
857  else {
858  push(t,pr_2,fx);
859  prec=pr_2;
860  }
861 
862  }
863 
864  } while (!fin && parse_ok);
865 
866  if (state)
867  crunch(MAX_PRECEDENCE,limit);
868 
869  if (parse_ok && parser_stack_index!=limit) {
871  else {
872  /*
873  perr("*** Syntax error ");psi_term_error();
874  perr(": bad expression.\n");
875  */
876 
877  /* RM: Feb 1 1993 */
878  Syntaxerrorline("bad expression (%E)\n");
879  }
880  }
881  else
882  (void)pop(&t,&op);
883 
884  if (!parse_ok)
885  t= *error_psi_term;
886 
887  parser_stack_index=limit-1;
888 
889  return t;
890 }
#define yfx
Definition: def_const.h:268
#define equ_tokc(A, B)
Definition: def_macro.h:71
void read_token(ptr_psi_term tok)
read_token
Definition: token.c:1186
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
#define NOP
Definition: def_const.h:332
void push(psi_term tok, long prec, long op)
push
Definition: parser.c:107
long precedence(psi_term tok, long typ)
precedence
Definition: parser.c:180
#define xfy
Definition: def_const.h:267
#define nop
Definition: def_const.h:260
void put_back_token(psi_term t)
put_back_token
Definition: token.c:746
long line_count
Definition: def_glob.h:39
psi_term read_life_form(char ch1, char ch2)
read_life_form
Definition: parser.c:728
void Syntaxerrorline(char *format,...)
Definition: error.c:498
#define TRUE
Definition: def_const.h:127
long pop(ptr_psi_term tok, long *op)
pop
Definition: parser.c:132
void crunch(long prec, long limit)
crunch
Definition: parser.c:662
ptr_psi_term error_psi_term
Definition: def_glob.h:23
int bad_psi_term(ptr_psi_term t)
bad_psi_term
Definition: parser.c:31
#define FALSE
Definition: def_const.h:128
#define xf
Definition: def_const.h:261
#define yf
Definition: def_const.h:263
#define MAX_PRECEDENCE
Definition: def_const.h:103
long parser_stack_index
Definition: def_glob.h:24
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
psi_term read_psi_term()
read_psi_term
Definition: parser.c:421
ptr_node attr_list
Definition: def_struct.h:171
#define fy
Definition: def_const.h:264
#define equ_tokch(A, B)
Definition: def_macro.h:66
void read_name ( ptr_psi_term  tok,
long  ch,
long(*)()  f,
ptr_definition  typ 
)
void read_number ( ptr_psi_term  tok,
long  c 
)

read_number

Parameters
ptr_psi_termtok
longc

READ_NUMBER(c) Read in the number whose first character is c. Accepted syntax: digit+ [ . digit+ ] [ {e|E} {+|-|empty} digit* ] Negative numbers are dealt with in the parser.

Definition at line 1110 of file token.c.

References DIGIT, heap_alloc(), integer, put_back_char(), read_char(), REAL, real, wl_psi_term::type, and wl_psi_term::value_3.

1111 {
1112  long c2;
1113  REAL f,p;
1114  long /* sgn, */ pwr,posflag;
1115 
1116  /* if (sgn=(c=='-')) c=read_char(); */
1117 
1118  /* tok->type=integer; RM: Mar 8 1993 */
1119 
1120  f=0.0;
1121  do { f=f*10.0+(c-'0'); c=read_char(); } while (DIGIT(c));
1122 
1123  if (c=='.') {
1124  c2=read_char();
1125  if DIGIT(c2) {
1126  /* tok->type=real; RM: Mar 8 1993 */
1127  p=10.0;
1128  while (DIGIT(c2)) { f=f+(c2-'0')/p; p=p*10.0; c2=read_char(); }
1129  put_back_char(c2);
1130  }
1131  else {
1132  put_back_char(c2);
1133  put_back_char(c);
1134  }
1135  }
1136  else
1137  put_back_char(c);
1138 
1139  c=read_char();
1140  if (c=='e' || c=='E') {
1141  c2=read_char();
1142  if (c2=='+' || c2=='-' || DIGIT(c2)) {
1143  tok->type=real;
1144  posflag = (c2=='+' || DIGIT(c2));
1145  if (!DIGIT(c2)) c2=read_char();
1146  pwr=0;
1147  while (DIGIT(c2)) { pwr=pwr*10+(c2-'0'); c2=read_char(); }
1148  put_back_char(c2);
1149  p=1.0;
1150  while (pwr>=100) { pwr-=100; if (posflag) p*=1e100; else p/=1e100; }
1151  while (pwr>=10 ) { pwr-=10; if (posflag) p*=1e10; else p/=1e10; }
1152  while (pwr>0 ) { pwr-=1; if (posflag) p*=1e1; else p/=1e1; }
1153  f*=p;
1154  }
1155  else {
1156  put_back_char(c2);
1157  put_back_char(c);
1158  }
1159  }
1160  else
1161  put_back_char(c);
1162 
1163  /* if (sgn) f = -f; */
1164  tok->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
1165  *(REAL *)tok->value_3=f;
1166 
1167  /* RM: Mar 8 1993 */
1168  if(f==floor(f))
1169  tok->type=integer;
1170  else
1171  tok->type=real;
1172 }
#define DIGIT(C)
Definition: def_macro.h:37
#define REAL
Definition: def_const.h:72
ptr_definition real
Definition: def_glob.h:102
ptr_definition integer
Definition: def_glob.h:93
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
long read_char()
read_char
Definition: token.c:680
GENERIC heap_alloc(long s)
heap_alloc
Definition: memory.c:1616
void put_back_char(long c)
put_back_char
Definition: token.c:729
psi_term read_psi_term ( )

read_psi_term

READ_PSI_TERM() This reads in a complex object from the input stream, that is, a whole psi-term.

Examples:

[A,B,C]

{0;1;2+A}

<a,b,c> death(victim => V,murderer => M)

which(x,y,z)

A:g(f)

I have allowed mixing labelled with unlabelled attributes.

Example:

f(x=>A,B,y=>K,"hklk",D) is parsed as f(1=>B,2=>"hklk",3=>D,x=>A,y=>K).

Definition at line 421 of file parser.c.

References add_module1, add_module2, add_module3, alist, apply, wl_psi_term::attr_list, bad_psi_term(), wl_keyword::combined_name, wl_psi_term::coref, current_module, disjunction, eof, equ_tok, equ_tokch, equal_types, error_psi_term, FALSE, FEATCMP, feature_insert(), find(), functor, heap_copy_string(), integer, wl_definition::keyword, wl_module::module_name, NULL, parse_list(), parse_ok, wl_keyword::private_feature, put_back_token(), quoted_string, read_life_form(), read_token(), REAL, wl_psi_term::resid, stack_copy_psi_term(), stack_insert(), stack_psi_term(), stringparse, wl_keyword::symbol, Syntaxerrorline(), TRUE, two, wl_psi_term::type, wl_psi_term::value_3, variable, and wl_const_3.

422 {
423  psi_term t,t2,t3;
424  char s[10];
425  long count=0,f=TRUE,f2,v;
426  ptr_psi_term module;
427 
428  if(parse_ok) {
429 
430  read_token(&t);
431 
432  if(equ_tokch(t,'['))
433  t=parse_list(alist,']',','); /*** RICHARD Nov_4 ***/
434  else
435  if(equ_tokch(t,'{'))
436  t=parse_list(disjunction,'}',';'); /*** RICHARD Nov_4 ***/
437 
438  /* The syntax <a,b,c> for conjunctions has been abandoned.
439  else
440  if(equ_tokch(t,'<'))
441  t=parse_list(conjunction,'>',',');
442  */
443 
444  if(parse_ok
445  && t.type!=eof
446  && !bad_psi_term(&t)
447  /* && (precedence(t,fx)==NOP)
448  && (precedence(t,fy)==NOP) */
449  ) {
450  read_token(&t2);
451  if(equ_tokch(t2,'(')) {
452 
453  do {
454 
455  f2=TRUE;
456  read_token(&t2);
457 
458  if(wl_const_3(t2) && !bad_psi_term(&t2)) {
459  read_token(&t3);
460  if(equ_tok(t3,"=>")) {
461  t3=read_life_form(',',')');
462 
463  if(t2.type->keyword->private_feature) /* RM: Mar 11 1993 */
465  /* RM: Jan 13 1993 */
466  &(t.attr_list),
467  &t3);
468  else
470  /* RM: Jan 13 1993 */
471  &(t.attr_list),
472  &t3);
473 
474  f2=FALSE;
475  }
476  else
477  put_back_token(t3);
478  }
479 
480  if(parse_ok && equal_types(t2.type,integer)) {
481  read_token(&t3);
482  if(equ_tok(t3,"=>")) {
483  t3=read_life_form(',',')');
484  v= *(REAL *)t2.value_3;
485  (void)snprintf(s,10,"%ld",v);
486  feature_insert(s,&(t.attr_list),&t3);
487  f2=FALSE;
488  }
489  else
490  put_back_token(t3);
491  }
492 
493  if(f2) {
494  put_back_token(t2);
495  t2=read_life_form(',',')');
496  ++count;
497  (void)snprintf(s,10,"%ld",count);
498  feature_insert(s,&(t.attr_list),&t2);
499  }
500 
501  read_token(&t2);
502 
503  if(equ_tokch(t2,')'))
504  f=FALSE;
505  else
506  if(!equ_tokch(t2,',')) {
508  else {
509  /*
510  perr("*** Syntax error ");psi_term_error();
511  perr(": ',' expected in argument list.\n");
512  */
513 
514  /* RM: Feb 1 1993 */
515  Syntaxerrorline("',' expected in argument list (%E)\n");
516 
517  f=FALSE;
518  }
519  }
520 
521  } while(f && parse_ok);
522  }
523  else
524  put_back_token(t2);
525  }
526  }
527  else
528  t= *error_psi_term;
529 
530  if(t.type==variable && t.attr_list) {
531  t2=t;
532  t.type=apply;
533  t.value_3=NULL;
534  t.coref=NULL;
535  t.resid=NULL;
536  (void)stack_insert(FEATCMP,(char *)functor->keyword->symbol,
537  &(t.attr_list),
539  }
540 
541 
542  /* RM: Mar 12 1993 Nasty hack for Bruno's features in modules */
543  if((t.type==add_module1 || t.type==add_module2 || t.type==add_module3) &&
544  !find(FEATCMP,two,t.attr_list)) {
545 
546  module=stack_psi_term(4);
547  module->type=quoted_string;
549 
550  (void)stack_insert(FEATCMP,two,&(t.attr_list),(GENERIC)module);
551  }
552 
553  return t;
554 }
ptr_residuation resid
Definition: def_struct.h:173
#define FEATCMP
Definition: def_const.h:257
void read_token(ptr_psi_term tok)
read_token
Definition: token.c:1186
char * combined_name
Definition: def_struct.h:92
ptr_module current_module
Definition: def_glob.h:161
char * two
Definition: def_glob.h:251
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
psi_term parse_list(ptr_definition typ, char e, char s)
parse_list
Definition: parser.c:329
char * symbol
Definition: def_struct.h:91
ptr_definition apply
Definition: def_glob.h:72
void put_back_token(psi_term t)
put_back_token
Definition: token.c:746
#define REAL
Definition: def_const.h:72
ptr_definition add_module3
Definition: def_glob.h:69
psi_term read_life_form(char ch1, char ch2)
read_life_form
Definition: parser.c:728
void feature_insert(char *keystr, ptr_node *tree, ptr_psi_term psi)
feature_insert
Definition: parser.c:251
#define wl_const_3(S)
Definition: def_macro.h:104
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
ptr_definition alist
Definition: def_glob.h:94
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
ptr_definition functor
Definition: def_glob.h:91
ptr_definition eof
Definition: def_glob.h:86
void Syntaxerrorline(char *format,...)
Definition: error.c:498
#define TRUE
Definition: def_const.h:127
ptr_psi_term error_psi_term
Definition: def_glob.h:23
ptr_definition integer
Definition: def_glob.h:93
int bad_psi_term(ptr_psi_term t)
bad_psi_term
Definition: parser.c:31
#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_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
char * module_name
Definition: def_struct.h:75
ptr_definition disjunction
Definition: def_glob.h:84
ptr_psi_term coref
Definition: def_struct.h:172
#define equal_types(A, B)
Definition: def_macro.h:106
ptr_definition add_module2
Definition: def_glob.h:68
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
ptr_definition add_module1
Definition: def_glob.h:67
int private_feature
Definition: def_struct.h:95
#define equ_tok(A, B)
Definition: def_macro.h:62
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_definition variable
Definition: def_glob.h:111
ptr_node attr_list
Definition: def_struct.h:171
#define equ_tokch(A, B)
Definition: def_macro.h:66
void read_string ( ptr_psi_term  tok,
long  e 
)

read_string

Parameters
ptr_psi_termtok
longe

READ_STRING(e) Read a string ending with character E, where E=" or '. Transform a double occurrence into a single one so that 'ab""cd' is the string 'ab"cd'.

Definition at line 859 of file token.c.

References base2int(), FALSE, heap_copy_string(), isoctal, NULL, put_back_char(), read_char(), read_string_error(), STRLEN, TOKEN_ERROR(), TRUE, wl_psi_term::type, update_symbol(), wl_psi_term::value_3, and warningline().

860 {
861  long c;
862  string str;
863  long len=0;
864  long store=TRUE;
865  long flag=TRUE;
866 
867  str[len]=0;
868 
869  do {
870  c=read_char();
871  if (c==EOF) {
872  store=FALSE;
873  flag=FALSE;
875  }
876  else if (e=='"' && c=='\\') {
877  c=read_char();
878  if (c==EOF) {
879  store=FALSE;
880  flag=FALSE;
881  put_back_char('\\');
883  }
884  else {
885  switch (c) {
886  case 'a': c='\a'; break;
887  case 'b': c='\b'; break;
888  case 'f': c='\f'; break;
889  case 'n': c='\n'; break;
890  case 'r': c='\r'; break;
891  case 't': c='\t'; break;
892  case 'v': c='\v'; break;
893  /* missing \ooo and \xhh */
894  case 'x':
895  {
896  int n;
897  c=read_char();
898  if (c==EOF) {
899  store=flag=FALSE;
901  break;
902  }
903  else if (!isxdigit(c)) {
904  store=flag=FALSE;
906  break;
907  }
908  else {
909  n = base2int(c);
910  }
911  c=read_char();
912  if (isxdigit(c)) n = 16*n+base2int(c);
913  else put_back_char(c);
914  c=n;
915  break;
916  }
917  default:
918  if (isoctal(c)) {
919  int n,i;
920  for(i=n=0;i<3&&isoctal(c);i++,c=read_char())
921  n = n*8 + base2int(c);
922  if (c!=EOF) put_back_char(c);
923  c=n;
924  break;
925  }
926  else break;
927  }
928  }
929  }
930  else
931  if (c==e) {
932  c=read_char();
933  if (c!=e) {
934  store=FALSE;
935  flag=FALSE;
936  put_back_char(c);
937  }
938  }
939  if (store)
940  if (len==STRLEN) {
941  warningline("string too long, extra ignored (%E).\n");
942  store=FALSE;
943  }
944  else {
945  str[len++]=c;
946  str[len]=0;
947  }
948  } while(flag);
949 
950  if (e=='"')
951  tok->value_3=(GENERIC)heap_copy_string(str);
952  else {
953  tok->type=update_symbol(NULL,str); /* Maybe no_module would be better */
954  tok->value_3=NULL;
955  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
956  }
957 }
int base2int(int n)
base2int
Definition: token.c:816
#define NULL
Definition: def_const.h:203
ptr_definition update_symbol(ptr_module module, char *symbol)
update_symbol
Definition: modules.c:270
void read_string_error(int n)
read_string_error
Definition: token.c:796
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
#define isoctal(c)
Definition: token.c:847
#define STRLEN
Definition: def_const.h:86
void TOKEN_ERROR(ptr_psi_term p)
TOKEN_ERROR.
Definition: token.c:38
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 read_char()
read_char
Definition: token.c:680
void put_back_char(long c)
put_back_char
Definition: token.c:729
void read_string_error ( int  n)

read_string_error

Parameters
intn

Definition at line 796 of file token.c.

References FALSE, parse_ok, stringparse, and Syntaxerrorline().

797 {
799  else
800  switch (n) {
801  case 0:
802  Syntaxerrorline("end of file reached before end of string (%E).\n");
803  break;
804  case 1:
805  Syntaxerrorline("Hexadecimal digit expected (%E).\n");
806  break;
807  }
808 }
void Syntaxerrorline(char *format,...)
Definition: error.c:498
#define FALSE
Definition: def_const.h:128
long stringparse
Definition: def_glob.h:202
long parse_ok
Definition: def_glob.h:171
void read_token ( ptr_psi_term  tok)

read_token

Parameters
ptr_psi_termtok

READ_TOKEN Read in one token from the input stream, represented as a psi_term. Return the psi_term 'end_of_file' if that is the case.

Used in the parser Set prompt to the 'partial input' prompt

Definition at line 1186 of file token.c.

References read_token_main(), and TRUE.

1187 { read_token_main(tok, TRUE); }
void read_token_main(ptr_psi_term tok, long for_parser)
read_token_main
Definition: token.c:1207
#define TRUE
Definition: def_const.h:127
void read_token_b ( ptr_psi_term  tok)

read_token_b

Parameters
ptr_psi_termtok

Used as a built-in Prompt is unchanged

Definition at line 1197 of file token.c.

References FALSE, and read_token_main().

1198 { read_token_main(tok, FALSE); }
void read_token_main(ptr_psi_term tok, long for_parser)
read_token_main
Definition: token.c:1207
#define FALSE
Definition: def_const.h:128
void read_token_main ( ptr_psi_term  tok,
long  for_parser 
)

read_token_main

Parameters
ptr_psi_termtok
longfor_parser

Definition at line 1207 of file token.c.

References wl_psi_term::attr_list, bk2_stack_insert(), choice_stack, comment, constant, wl_psi_term::coref, current_module, cut, wl_node::data, DIGIT, eof, EOLN, Errorline(), FALSE, final_dot, final_question, find(), wl_psi_term::flags, legal_in_name(), line_count, LOWER, nothing, NULL, old_saved_psi_term, prompt, psi_term_line_number, put_back_char(), quoted_string, read_char(), read_comment(), read_name(), read_number(), read_string(), read_token(), wl_psi_term::resid, saved_psi_term, SINGLE, stack_psi_term(), wl_psi_term::status, STRCMP, SYMBOL, symbolic(), TOKEN_ERROR(), TRUE, wl_psi_term::type, update_symbol(), UPPER, wl_psi_term::value_3, var_occurred, var_tree, and variable.

1208 {
1209  long c, c2;
1210  ptr_node n;
1211  char p[2];
1212 
1213  if (for_parser && (saved_psi_term!=NULL)) {
1214  *tok= *saved_psi_term;
1217  }
1218  else {
1219  tok->type=nothing;
1220 
1221  do {
1222  c=read_char();
1223  } while(c!=EOF && (c<=32));
1224 
1225  if (for_parser) psi_term_line_number=line_count;
1226 
1227  switch(c) {
1228  case EOF:
1229  tok->type=eof;
1230  tok->value_3=NULL;
1231  break;
1232  case '%':
1233  read_comment(tok);
1234  break;
1235  case '"':
1236  read_string(tok,c);
1237  tok->type=quoted_string;
1238  break;
1239  case 39: /* The quote symbol "'" */
1240  read_string(tok,c);
1241  break;
1242 
1243  default:
1244 
1245  /* Adding this results in problems with terms like (N-1) */
1246  /* if (c=='-' && (c2=read_char()) && DIGIT(c2)) {
1247  put_back_char(c2);
1248  read_number(tok,c);
1249  }
1250  else */
1251 
1252  if(c=='.' || c=='?') { /* RM: Jul 7 1993 */
1253  c2=read_char();
1254  put_back_char(c2);
1255  /*printf("c2=%d\n",c2);*/
1256  if(c2<=' ' || c2==EOF) {
1257  if(c=='.')
1258  tok->type=final_dot;
1259  else
1260  tok->type=final_question;
1261 
1262  tok->value_3=NULL;
1263  }
1264  else
1265  read_name(tok,c,symbolic,constant);
1266  }
1267  else
1268  if DIGIT(c)
1269  read_number(tok,c);
1270  else
1271  if UPPER(c) {
1273  }
1274  else
1275  if LOWER(c) {
1277  }
1278  else
1279  if SYMBOL(c) {
1280  read_name(tok,c,symbolic,constant);
1281  }
1282  else /* RM: Jul 7 1993 Moved this */
1283  if SINGLE(c) {
1284  p[0]=c; p[1]=0;
1286  tok->value_3=NULL;
1287  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
1288  }
1289  else {
1290  Errorline("illegal character %d in input (%E).\n",c);
1291  }
1292  }
1293 
1294  if (tok->type==variable) {
1295  if (tok->value_3) {
1296  /* If the variable read in has name "_", then it becomes 'top' */
1297  /* and is no longer a variable whose name must be remembered. */
1298  /* As a result, '@' and '_' are synonyms in the program input. */
1299  if (!strcmp((char *)tok->value_3,"_")) {
1300  p[0]='@'; p[1]=0;
1302  tok->value_3=NULL;
1303  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
1304  }
1305  else {
1306  /* Insert into variable tree, create 'top' value if need be. */
1308  n=find(STRCMP,(char *)tok->value_3,var_tree);
1309  if (n==NULL) {
1311  /* The change is always trailed. */
1312  (void)bk2_stack_insert(STRCMP,(char *)tok->value_3,&var_tree,(GENERIC)t); /* 17.8 */
1313  tok->coref=t;
1314  }
1315  else
1316  tok->coref=(ptr_psi_term)n->data;
1317  }
1318  }
1319  /* else do nothing */
1320  }
1321  }
1322 
1323  if (tok->type==comment)
1324  read_token(tok);
1325 
1326  if (tok->type!=variable)
1327  tok->coref=NULL;
1328 
1329  tok->attr_list=NULL;
1330  tok->status=0;
1331  tok->flags=FALSE; /* 14.9 */
1332  tok->resid=NULL;
1333 
1334  if (tok->type==cut) /* 12.7 */
1336 
1337  do {
1338  c=read_char();
1339  if (c==EOLN) {
1340  if (for_parser) put_back_char(c);
1341  c=0;
1342  }
1343  else if (c<0 || c>32) {
1344  put_back_char(c);
1345  c=0;
1346  }
1347  } while(c && c!=EOF);
1348 
1349  if (for_parser) prompt="| ";
1350 }
ptr_residuation resid
Definition: def_struct.h:173
ptr_module current_module
Definition: def_glob.h:161
#define UPPER(C)
Definition: def_macro.h:39
ptr_definition comment
Definition: def_glob.h:80
long psi_term_line_number
Definition: def_glob.h:268
#define DIGIT(C)
Definition: def_macro.h:37
ptr_definition constant
Definition: def_glob.h:82
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
ptr_node bk2_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
bk2_stack_insert
Definition: trees.c:377
void read_name(ptr_psi_term tok, long ch, long(*f)(long), ptr_definition typ)
read_name
Definition: token.c:1002
void read_string(ptr_psi_term tok, long e)
read_string
Definition: token.c:859
ptr_definition update_symbol(ptr_module module, char *symbol)
update_symbol
Definition: modules.c:270
#define LOWER(C)
Definition: def_macro.h:41
#define SYMBOL(C)
Definition: def_macro.h:52
long line_count
Definition: def_glob.h:39
void Errorline(char *format,...)
Definition: error.c:414
#define EOLN
Definition: def_const.h:140
void read_number(ptr_psi_term tok, long c)
read_number
Definition: token.c:1110
ptr_definition eof
Definition: def_glob.h:86
#define TRUE
Definition: def_const.h:127
#define STRCMP
Definition: def_const.h:255
ptr_definition final_dot
Definition: def_glob.h:137
#define FALSE
Definition: def_const.h:128
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
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term coref
Definition: def_struct.h:172
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
long legal_in_name(long c)
legal_in_name
Definition: token.c:980
ptr_definition final_question
Definition: def_glob.h:138
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
void read_comment(ptr_psi_term tok)
read_comment
Definition: token.c:779
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
char * prompt
Definition: def_glob.h:42
long symbolic(long c)
symbolic
Definition: token.c:967
ptr_definition cut
Definition: def_glob.h:83
#define SINGLE(C)
Definition: def_macro.h:47
ptr_definition nothing
Definition: def_glob.h:98
void TOKEN_ERROR(ptr_psi_term p)
TOKEN_ERROR.
Definition: token.c:38
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
long read_char()
read_char
Definition: token.c:680
ptr_definition variable
Definition: def_glob.h:111
ptr_node attr_list
Definition: def_struct.h:171
ptr_choice_point choice_stack
Definition: def_glob.h:51
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
void read_token(ptr_psi_term tok)
read_token
Definition: token.c:1186
void put_back_char(long c)
put_back_char
Definition: token.c:729
ptr_psi_term real_stack_psi_term ( long  stat,
REAL  thereal 
)

real_stack_psi_term

Parameters
longstat thereal

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

Definition at line 48 of file lefun.c.

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

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

rec_replace

Parameters
ptr_definitionold
ptr_definitionnew
ptr_psi_termterm

Definition at line 865 of file modules.c.

References wl_psi_term::attr_list, def_ptr, deref_ptr, insert_translation(), int_ptr, NULL, push_ptr_value(), replace_attr(), translate(), wl_psi_term::type, and wl_psi_term::value_3.

866 {
867  ptr_psi_term done;
868  long *info; // some trouble w this - don't see
869  ptr_node old_attr;
870 
871  deref_ptr(term);
872  done=translate(term,&info);
873  if(!done) {
874  insert_translation(term,term,0);
875 
876  if(term->type==old && !term->value_3) {
877  push_ptr_value(def_ptr,(GENERIC *)&(term->type));
878  term->type=new;
879  }
880  old_attr=term->attr_list;
881  if(old_attr) {
883  term->attr_list=NULL;
884  replace_attr(old_attr,term,old,new);
885  }
886  }
887 }
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
translate
Definition: copy.c:108
#define def_ptr
Definition: def_const.h:173
void replace_attr(ptr_node, ptr_psi_term, ptr_definition, ptr_definition)
replace_attr
Definition: modules.c:898
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
insert_translation
Definition: copy.c:67
#define NULL
Definition: def_const.h:203
#define deref_ptr(P)
Definition: def_macro.h:95
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_node attr_list
Definition: def_struct.h:171
#define int_ptr
Definition: def_const.h:172
long redefine ( ptr_psi_term  t)

redefine

Parameters
ptr_psi_termt

REDEFINE(t) This decides whether a definition (a sort, function, or predicate) may be extended or not.

Definition at line 104 of file types.c.

References wl_definition::children, wl_keyword::combined_name, wl_definition::date, deref_ptr, Errorline(), FALSE, file_date, wl_definition::keyword, MAX_BUILT_INS, wl_definition::parents, wl_definition::protected, remove_cycles(), wl_definition::rule, wl_keyword::symbol, TRUE, wl_psi_term::type, wl_definition::type_def, type_it, undef, warningflag, warningline(), and yes_or_no().

105 {
106  ptr_definition d; // ,d2;
107  // ptr_int_list l,*l2;
108  long success=TRUE;
109 
110  deref_ptr(t);
111  d=t->type;
112  if (d->date<file_date) {
113  if (d->type_def==(def_type)type_it) {
114  /* Except for top, sorts are always unprotected, with a warning. */
115  if (FALSE /*d==top*/) {
116  Errorline("the top sort '@' may not be extended.\n");
117  success=FALSE;
118  }
119  /* RM: Mar 25 1993
120  else if (d!=top)
121  warningline("extending definition of sort '%s'.\n",d->keyword->symbol);
122  */
123  }
124  else if (d->protected && d->type_def!=(def_type)undef) {
125  if (d->date>0) {
126  /* The term was entered in a previous file, and therefore */
127  /* cannot be altered. */
128  Errorline("the %T '%s' may not be changed.\n", /* RM: Jan 27 1993 */
129  d->type_def, d->keyword->combined_name);
130  success=FALSE;
131  }
132  else {
133  if (d->rule && (unsigned long)d->rule<=MAX_BUILT_INS /*&& input_stream==stdin*/) {
134  /* d is a built-in, and therefore cannot be altered. */
135  Errorline("the built-in %T '%s' may not be extended.\n",
136  d->type_def, d->keyword->symbol);
137  success=FALSE;
138  }
139  else {
140  /* d is not a built-in, and therefore can be altered. */
141  warningline("extending the %T '%s'.\n",d->type_def,d->keyword->symbol);
142  if (warningflag) if (!yes_or_no()) success=FALSE;
143  }
144  }
145  }
146 
147  if (success) {
148  if (d->type_def==(def_type)type_it) { /* d is an already existing type */
149  /* Remove cycles in the type hierarchy of d */
150  /* This is done by Richard's version, and I don't know why. */
151  /* It seems to be a no-op. */
152  remove_cycles(d, &(d->children));
153  remove_cycles(d, &(d->parents));
154  /* d->rule=NULL; */ /* Types must keep their rules! */
155  /* d->properties=NULL; */ /* Types get new properties from encode */
156  }
157  if (d->date==0) d->date=file_date;
158  /* d->type=undef; */ /* Objects keep their type! */
159  /* d->always_check=TRUE; */
160  /* d->protected=TRUE; */
161  /* d->children=NULL; */
162  /* d->parents=NULL; */
163  /* d->code=NOT_CODED; */
164  }
165  }
166 
167  return success;
168 }
char * combined_name
Definition: def_struct.h:92
#define undef
Definition: def_const.h:360
def_type type_def
Definition: def_struct.h:133
long file_date
Definition: def_glob.h:60
ptr_keyword keyword
Definition: def_struct.h:124
void remove_cycles(ptr_definition d, ptr_int_list *dl)
remove_cycles
Definition: types.c:85
long warningflag
Definition: def_glob.h:270
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
ptr_pair_list rule
Definition: def_struct.h:126
#define FALSE
Definition: def_const.h:128
#define MAX_BUILT_INS
Definition: def_const.h:82
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
ptr_int_list children
Definition: def_struct.h:131
long yes_or_no()
yes_or_no
Definition: types.c:50
ptr_int_list parents
Definition: def_struct.h:130
void release_resid ( ptr_psi_term  t)

release_resid

Parameters
ptr_psi_termt

Definition at line 445 of file lefun.c.

References release_resid_main(), and TRUE.

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

release_resid_main

Parameters
ptr_psi_termt
longtrailflag

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

Definition at line 411 of file lefun.c.

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

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

release_resid_notrail

Parameters
ptr_psi_termt

Definition at line 456 of file lefun.c.

References FALSE, and release_resid_main().

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

remove_cycles

Parameters
ptr_definitiond
ptr_int_list*dl

Remove references to d in d's children or parents

Definition at line 85 of file types.c.

References wl_int_list::next.

86 {
87  while (*dl) {
88  if (((ptr_definition)(*dl)->value_1)==d)
89  *dl = (*dl)->next;
90  else
91  dl= &((*dl)->next);
92  }
93 }
ptr_int_list next
Definition: def_struct.h:55
void replace ( ptr_definition  old,
ptr_definition  new,
ptr_psi_term  term 
)

replace

Parameters
ptr_definitionold
ptr_definitionnew
ptr_psi_termterm)

REPLACE(old,new,term) Replace all occurrences of type OLD with NEW in TERM.

Definition at line 851 of file modules.c.

References clear_copy(), and rec_replace().

852 {
853  clear_copy();
854  rec_replace(old,new,term);
855 }
void clear_copy()
clear_copy
Definition: copy.c:53
void rec_replace(ptr_definition, ptr_definition, ptr_psi_term)
rec_replace
Definition: modules.c:865
void replace_attr ( ptr_node  old_attr,
ptr_psi_term  term,
ptr_definition  old,
ptr_definition  new 
)

replace_attr

Parameters
ptr_nodeold_attr
ptr_psi_termterm
ptr_definitionold
ptr_definitionnew

Definition at line 898 of file modules.c.

References wl_psi_term::attr_list, wl_keyword::combined_name, wl_node::data, FEATCMP, wl_node::key, wl_definition::keyword, wl_node::left, wl_keyword::private_feature, rec_replace(), wl_node::right, stack_insert(), and wl_keyword::symbol.

899 {
900  ptr_psi_term value;
901  char *oldlabel; /* RM: Mar 12 1993 */
902  char *newlabel;
903 
904  if(old_attr->left)
905  replace_attr(old_attr->left,term,old,new);
906 
907  value=(ptr_psi_term)old_attr->data;
908  rec_replace(old,new,value);
909 
910  if(old->keyword->private_feature) /* RM: Mar 12 1993 */
911  oldlabel=old->keyword->combined_name;
912  else
913  oldlabel=old->keyword->symbol;
914 
915  if(new->keyword->private_feature) /* RM: Mar 12 1993 */
916  newlabel=new->keyword->combined_name;
917  else
918  newlabel=new->keyword->symbol;
919 
920  if(!strcmp(old_attr->key,oldlabel))
921  (void)stack_insert(FEATCMP,newlabel,&(term->attr_list),(GENERIC)value);
922  else
923  (void)stack_insert(FEATCMP,old_attr->key,&(term->attr_list),(GENERIC)value);
924 
925  if(old_attr->right)
926  replace_attr(old_attr->right,term,old,new);
927 }
#define FEATCMP
Definition: def_const.h:257
char * combined_name
Definition: def_struct.h:92
void replace_attr(ptr_node, ptr_psi_term, ptr_definition, ptr_definition)
replace_attr
Definition: modules.c:898
ptr_keyword keyword
Definition: def_struct.h:124
GENERIC data
Definition: def_struct.h:185
char * symbol
Definition: def_struct.h:91
ptr_node left
Definition: def_struct.h:183
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
char * key
Definition: def_struct.h:182
void rec_replace(ptr_definition, ptr_definition, ptr_psi_term)
rec_replace
Definition: modules.c:865
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
int private_feature
Definition: def_struct.h:95
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
ptr_node right
Definition: def_struct.h:184
void report_error ( ptr_psi_term  g,
char *  s 
)

Definition at line 718 of file error.c.

References report_error_main().

721 {
722  report_error_main(g,s,"Error");
723 }
void report_error_main(ptr_psi_term g, char *s, char *s2)
Definition: error.c:700
void report_error2 ( ptr_psi_term  g,
char *  s 
)

Definition at line 772 of file error.c.

References report_error2_main().

775 {
776  report_error2_main(g,s,"Error");
777 }
void report_error2_main(ptr_psi_term g, char *s, char *s2)
Definition: error.c:755
void report_error2_main ( ptr_psi_term  g,
char *  s,
char *  s2 
)

Definition at line 755 of file error.c.

References display_psi_stderr(), and perr_s().

758 {
759  // FILE *f;
760 
761  perr_s("*** %s: argument '",s2);
763  perr_s("' %s.\n",s);
764 }
void display_psi_stderr(ptr_psi_term t)
display_psi_stderr
Definition: print.c:1550
void perr_s(char *s1, char *s2)
Definition: error.c:665
void report_error_main ( ptr_psi_term  g,
char *  s,
char *  s2 
)

Definition at line 700 of file error.c.

References display_psi_stderr(), perr(), and perr_s2().

703 {
704  // FILE *f;
705 
706  perr_s2("*** %s: %s in '",s2,s);
708  perr("'.\n");
709 }
void perr_s2(char *s1, char *s2, char *s3)
Definition: error.c:671
void display_psi_stderr(ptr_psi_term t)
display_psi_stderr
Definition: print.c:1550
void perr(char *str)
Definition: error.c:659
void report_warning ( ptr_psi_term  g,
char *  s 
)

Definition at line 746 of file error.c.

References report_error_main(), and warningflag.

749 {
750  if (warningflag) report_error_main(g,s,"Warning");
751 }
long warningflag
Definition: error.c:16
void report_error_main(ptr_psi_term g, char *s, char *s2)
Definition: error.c:700
void report_warning2 ( ptr_psi_term  g,
char *  s 
)

Definition at line 785 of file error.c.

References report_error2_main(), and warningflag.

788 {
789  if (warningflag) report_error2_main(g,s,"Warning");
790 }
long warningflag
Definition: error.c:16
void report_error2_main(ptr_psi_term g, char *s, char *s2)
Definition: error.c:755
long reportAndAbort ( ptr_psi_term  g,
char *  s 
)

Definition at line 732 of file error.c.

References abort_life(), report_error_main(), and TRUE.

735 {
736  report_error_main(g,s,"Error");
737  return abort_life(TRUE); // djd added TRUE
738 }
void report_error_main(ptr_psi_term g, char *s, char *s2)
Definition: error.c:700
long abort_life(int nlflag)
abort_life
Definition: built_ins.c:2260
#define TRUE
Definition: def_const.h:127
void reset_stacks ( )

reset_stacks

Called when level jumps back to zero. Setting these two pointers to NULL causes an exit from main_prove and will then reset all other global information.

Definition at line 2047 of file login.c.

References choice_stack, goal_stack, NULL, and undo().

2048 {
2049  undo(NULL); /* 8.10 */
2050  goal_stack=NULL;
2052 #ifdef TS
2053  /* global_time_stamp=INIT_TIME_STAMP; */ /* 9.6 */
2054 #endif
2055 }
ptr_goal goal_stack
Definition: def_glob.h:50
void undo(ptr_stack limit)
undo
Definition: login.c:691
#define NULL
Definition: def_const.h:203
ptr_choice_point choice_stack
Definition: def_glob.h:51
void reset_step ( )

Definition at line 596 of file error.c.

References stepcount, stepflag, and TRUE.

597 {
598  if (stepcount>0) {
599  stepcount=0;
600  stepflag=TRUE;
601  }
602 }
#define TRUE
Definition: def_const.h:127
long stepcount
Definition: error.c:22
long stepflag
Definition: error.c:20
ptr_psi_term residListGoalQuote ( ptr_residuation  p)
Parameters
ptr_residuationp

Return a ptr to a psi-term marked as evaluated. The psi-term is a copy at the top level of the goal residuated on p, with the rest of the psi-term shared.

Definition at line 545 of file bi_sys.c.

References wl_goal::aaaa_1, copyPsiTerm, wl_residuation::goal, stack_psi_term(), and wl_psi_term::status.

546 {
547  ptr_psi_term psi;
548 
549  psi = stack_psi_term(4);
550  copyPsiTerm(psi, p->goal->aaaa_1);
551  psi->status = 4;
552  return psi;
553 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_goal goal
Definition: def_struct.h:156
#define copyPsiTerm(a, b)
Definition: bi_sys.c:10
ptr_psi_term stack_psi_term(long stat)
stack_psi_term
Definition: lefun.c:21
GENERIC residListNext ( ptr_residuation  p)
Parameters
ptr_residuationp

Definition at line 561 of file bi_sys.c.

References wl_residuation::next.

562 {
563  return (GENERIC )(p->next);
564 }
ptr_residuation next
Definition: def_struct.h:157
unsigned long * GENERIC
Definition: def_struct.h:17
void residuate ( ptr_psi_term  t)

residuate

Parameters
ptr_psi_termt

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

Definition at line 125 of file lefun.c.

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

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

residuate2

Parameters
ptr_psi_termu
ptr_psi_termv

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

Definition at line 144 of file lefun.c.

References residuate().

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

residuate3

Parameters
ptr_psi_termu
ptr_psi_termv
ptr_psi_termw

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

Definition at line 159 of file lefun.c.

References residuate().

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

residuate_double

Parameters
ptr_psi_termt u

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

Definition at line 107 of file lefun.c.

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

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

residuateGoalOnVar

Parameters
ptr_goalg
ptr_psi_termvar
ptr_psi_termothervar

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

Definition at line 192 of file lefun.c.

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

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

restore_parse_state

Parameters
ptr_parse_blockpb

Definition at line 444 of file token.c.

References wl_parse_block::ef, eof_flag, wl_parse_block::lc, line_count, old_saved_char, old_saved_psi_term, wl_parse_block::osc, wl_parse_block::ospt, saved_char, saved_psi_term, wl_parse_block::sc, wl_parse_block::sol, wl_parse_block::spt, and start_of_line.

445 {
446  if (pb) {
447  line_count = pb->lc;
448  start_of_line = pb->sol;
449  saved_char = pb->sc;
450  old_saved_char = pb->osc;
451  saved_psi_term = pb->spt;
452  old_saved_psi_term = pb->ospt;
453  eof_flag = pb->ef;
454  }
455 }
ptr_psi_term ospt
Definition: def_struct.h:377
long eof_flag
Definition: def_glob.h:196
long start_of_line
Definition: def_glob.h:191
long old_saved_char
Definition: def_glob.h:193
long saved_char
Definition: def_glob.h:192
long line_count
Definition: def_glob.h:39
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
ptr_psi_term spt
Definition: def_struct.h:376
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
void restore_resid ( ptr_resid_block  rb,
ptr_psi_term match_date 
)

restore_resid

Parameters
ptr_resid_blockrb
ptr_psi_term*match_date

Definition at line 1417 of file lefun.c.

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

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

restore_state

Parameters
ptr_psi_termt

Restore global state from an existing file state psi-term t

Definition at line 334 of file token.c.

References eof_flag, EOF_FLAG, get_attr(), input_file_name, INPUT_FILE_NAME, input_stream, lf_true, line_count, LINE_COUNT, NULL, null_psi_term, old_saved_char, OLD_SAVED_CHAR, old_saved_psi_term, OLD_SAVED_PSI_TERM, REAL, saved_char, SAVED_CHAR, saved_psi_term, SAVED_PSI_TERM, start_of_line, START_OF_LINE, and STREAM.

335 {
336  // long i;
337  char *str;
338 
339 
340  input_stream = (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
341  str = (char*) ((ptr_psi_term)get_attr(t,INPUT_FILE_NAME))->value_3;
342  strcpy(input_file_name,str);
343  /* for (i=0;i++;i<=strlen(str)) input_file_name[i]=str[i]; */
344  line_count = *(REAL *) ((ptr_psi_term)get_attr(t,LINE_COUNT))->value_3;
345  saved_char = *(REAL *) ((ptr_psi_term)get_attr(t,SAVED_CHAR))->value_3;
347 
350 
353 
356 
357 
358  /* RM: Jan 27 1993
359  set_current_module(
360  find_module(((ptr_psi_term)get_attr(input_state,
361  CURRENT_MODULE))->value_3));
362  */
363 }
#define LINE_COUNT
Definition: def_const.h:227
long eof_flag
Definition: def_glob.h:196
long start_of_line
Definition: def_glob.h:191
string input_file_name
Definition: def_glob.h:40
#define SAVED_PSI_TERM
Definition: def_const.h:231
#define OLD_SAVED_CHAR
Definition: def_const.h:230
ptr_psi_term null_psi_term
Definition: def_glob.h:140
long old_saved_char
Definition: def_glob.h:193
#define NULL
Definition: def_const.h:203
long saved_char
Definition: def_glob.h:192
#define REAL
Definition: def_const.h:72
long line_count
Definition: def_glob.h:39
#define STREAM
Definition: def_const.h:225
#define START_OF_LINE
Definition: def_const.h:228
ptr_definition lf_true
Definition: def_glob.h:107
FILE * input_stream
Definition: def_glob.h:38
#define INPUT_FILE_NAME
Definition: def_const.h:226
#define OLD_SAVED_PSI_TERM
Definition: def_const.h:232
GENERIC get_attr(ptr_psi_term t, char *attrname)
get_attr
Definition: token.c:265
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
#define EOF_FLAG
Definition: def_const.h:233
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
#define SAVED_CHAR
Definition: def_const.h:229
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
void save_parse_state ( ptr_parse_block  pb)

save_parse_state

Parameters
ptr_parse_blockpb

Definition at line 425 of file token.c.

References wl_parse_block::ef, eof_flag, wl_parse_block::lc, line_count, old_saved_char, old_saved_psi_term, wl_parse_block::osc, wl_parse_block::ospt, saved_char, saved_psi_term, wl_parse_block::sc, wl_parse_block::sol, wl_parse_block::spt, and start_of_line.

426 {
427  if (pb) {
428  pb->lc = line_count;
429  pb->sol = start_of_line;
430  pb->sc = saved_char;
431  pb->osc = old_saved_char;
432  pb->spt = saved_psi_term;
433  pb->ospt = old_saved_psi_term;
434  pb->ef = eof_flag;
435  }
436 }
ptr_psi_term ospt
Definition: def_struct.h:377
long eof_flag
Definition: def_glob.h:196
long start_of_line
Definition: def_glob.h:191
long old_saved_char
Definition: def_glob.h:193
long saved_char
Definition: def_glob.h:192
long line_count
Definition: def_glob.h:39
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
ptr_psi_term spt
Definition: def_struct.h:376
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
void save_resid ( ptr_resid_block  rb,
ptr_psi_term  match_date 
)

save_resid

Parameters
ptr_resid_blockrb
ptr_psi_termmatch_date

Saving & restoring residuation information

Definition at line 1398 of file lefun.c.

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

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

save_state

Parameters
ptr_psi_termt

Save global state into an existing file state psi-term t

Definition at line 293 of file token.c.

References wl_psi_term::attr_list, wl_node::data, eof_flag, EOF_FLAG, FEATCMP, find(), heap_add_psi_attr(), heap_mod_int_attr(), heap_mod_str_attr(), heap_psi_term(), input_file_name, INPUT_FILE_NAME, input_stream, lf_false, lf_true, line_count, LINE_COUNT, null_psi_term, old_saved_char, OLD_SAVED_CHAR, old_saved_psi_term, OLD_SAVED_PSI_TERM, saved_char, SAVED_CHAR, saved_psi_term, SAVED_PSI_TERM, start_of_line, START_OF_LINE, STREAM, wl_psi_term::type, and wl_psi_term::value_3.

294 {
295  ptr_node n;
296  ptr_psi_term t1;
297 
299  t1=(ptr_psi_term)n->data;
301 
302  /* RM: Jan 27 1993
303  heap_mod_str_attr(t,CURRENT_MODULE,current_module->module_name);
304  */
305 
310 
313 
316 
317  t1=heap_psi_term(4);
320 
321  t1=heap_psi_term(4);
324 }
#define FEATCMP
Definition: def_const.h:257
#define LINE_COUNT
Definition: def_const.h:227
long eof_flag
Definition: def_glob.h:196
long start_of_line
Definition: def_glob.h:191
void heap_mod_int_attr(ptr_psi_term t, char *attrname, long value)
heap_mod_int_attr
Definition: token.c:116
string input_file_name
Definition: def_glob.h:40
#define SAVED_PSI_TERM
Definition: def_const.h:231
ptr_psi_term heap_psi_term(long stat)
heap_psi_term
Definition: lefun.c:75
#define OLD_SAVED_CHAR
Definition: def_const.h:230
ptr_psi_term null_psi_term
Definition: def_glob.h:140
GENERIC data
Definition: def_struct.h:185
long old_saved_char
Definition: def_glob.h:193
long saved_char
Definition: def_glob.h:192
long line_count
Definition: def_glob.h:39
#define STREAM
Definition: def_const.h:225
#define START_OF_LINE
Definition: def_const.h:228
void heap_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
heap_add_psi_attr
Definition: token.c:226
ptr_definition lf_true
Definition: def_glob.h:107
FILE * input_stream
Definition: def_glob.h:38
ptr_definition lf_false
Definition: def_glob.h:89
GENERIC value_3
Definition: def_struct.h:170
#define INPUT_FILE_NAME
Definition: def_const.h:226
#define OLD_SAVED_PSI_TERM
Definition: def_const.h:232
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
#define EOF_FLAG
Definition: def_const.h:233
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void heap_mod_str_attr(ptr_psi_term t, char *attrname, char *str)
heap_mod_str_attr
Definition: token.c:191
ptr_definition type
Definition: def_struct.h:165
#define SAVED_CHAR
Definition: def_const.h:229
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
ptr_module set_current_module ( ptr_module  module)

set_current_module

Parameters
ptr_modulemodule

SET_CURRENT_MODULE(module) Set the current module to a given string.

Definition at line 100 of file modules.c.

References current_module.

101 {
102  current_module=module;
103  /* printf("*** Current module: '%s'\n",current_module->module_name); */
104  return current_module;
105 }
ptr_module current_module
Definition: modules.c:15
void set_trace_to_prove ( )

Definition at line 639 of file error.c.

References new_trace().

640 {
641  new_trace(2);
642 }
void new_trace(long newtrace)
Definition: error.c:619
void setUnitList ( GENERIC  x)

set static unitListElement

Parameters
GENERICx what to set static unitListElement to (GENERIC)

not sure purpose (DJD ???)

Definition at line 468 of file bi_sys.c.

References unitListElement.

469 {
470  unitListElement = x;
471 }
static GENERIC unitListElement
Definition: bi_sys.c:459
long shift_warning ( long  dir,
ptr_psi_term  arg,
REAL  val 
)

Definition at line 867 of file error.c.

References nonint_warning().

871 {
872  if (dir)
873  return nonint_warning(arg,val,"of right shift operation is not an integer");
874  else
875  return nonint_warning(arg,val,"of left shift operation is not an integer");
876 }
long nonint_warning(ptr_psi_term arg, REAL val, char *msg)
Definition: error.c:810
void show ( long  limit)

show

Parameters
longlimit

SHOW(limit) This prints the parser's stack, for debugging purposes only, LIMIT marks the bottom of the current stack.

Definition at line 64 of file parser.c.

References display_psi_stdout(), fx, int_stack, nop, parser_stack_index, psi_term_stack, xf, and xfx.

65 {
66  long i;
67 
68  for (i=1;i<=parser_stack_index;i++) {
69  if (i==limit)
70  printf("-> ");
71  else
72  printf(" ");
73  printf("%3ld: ",i);
74  switch (op_stack[i]) {
75  case fx:
76  printf("FX ");
77  break;
78  case xfx:
79  printf("XFX ");
80  break;
81  case xf:
82  printf("XF ");
83  break;
84  case nop:
85  printf("NOP ");
86  break;
87  default:
88  printf("??? ");
89  }
90  printf(" prec=%4ld ",int_stack[i]);
92  printf("\n");
93  }
94  printf("\n");
95 }
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
void display_psi_stdout(ptr_psi_term t)
display_psi_stdout
Definition: print.c:1536
#define nop
Definition: def_const.h:260
#define xf
Definition: def_const.h:261
long parser_stack_index
Definition: def_glob.h:24
long int_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:318
psi_term psi_term_stack[PARSER_STACK_SIZE]
Definition: def_glob.h:317
void show_count ( )

show_count

SHOW_COUNT() This routine doesn't do anything if not in verbose mode. It prints the number of of sub-goals attempted, along with cpu-time spent during the proof etc...

Definition at line 1161 of file login.c.

References end_time, goal_count, heap_pointer, mem_base, mem_limit, NOTQUIET, stack_info(), stack_pointer, and verbose.

1162 {
1163  float t;
1164 
1165  if (verbose) {
1166  printf(" [");
1167 
1168  (void)times(&end_time);
1169  t = (end_time.tms_utime - start_time.tms_utime)/60.0;
1170 
1171  printf("%1.3fs cpu, %ld goal%s",t,goal_count,(goal_count!=1?"s":""));
1172 
1173  if (t!=0.0) printf(" (%0.0f/s)",goal_count/t);
1174 
1175  printf(", %ld stack",sizeof(mem_base)*(stack_pointer-mem_base));
1176  printf(", %ld heap",sizeof(mem_base)*(mem_limit-heap_pointer));
1177 
1178  printf("]");
1179  }
1180 
1181  if(NOTQUIET) {
1182  printf("\n");
1183  stack_info(stdout);
1184  }
1185 
1186  goal_count=0;
1187 }
GENERIC mem_limit
Definition: def_glob.h:13
#define NOTQUIET
Definition: def_macro.h:10
long verbose
Definition: def_glob.h:273
long goal_count
Definition: def_glob.h:152
GENERIC mem_base
Definition: def_glob.h:11
GENERIC heap_pointer
Definition: def_glob.h:12
void stack_info(FILE *outfile)
Definition: error.c:58
struct tms start_time end_time
Definition: def_glob.h:298
GENERIC stack_pointer
Definition: def_glob.h:14
void stack_add_int_attr ( ptr_psi_term  t,
char *  attrname,
long  value 
)

stack_add_int_attr

Parameters
ptr_psi_termt
char*attrname
longvalue

Definition at line 94 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_alloc(), heap_copy_string(), integer, REAL, stack_insert(), stack_psi_term(), wl_psi_term::type, and wl_psi_term::value_3.

95 {
96  ptr_psi_term t1;
97 
98  t1=stack_psi_term(4);
99  t1->type=integer;
100  t1->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
101  *(REAL *)t1->value_3 = (REAL) value;
102 
103  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
104 }
#define FEATCMP
Definition: def_const.h:257
#define REAL
Definition: def_const.h:72
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
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
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
void stack_add_psi_attr ( ptr_psi_term  t,
char *  attrname,
ptr_psi_term  g 
)

stack_add_psi_attr

Parameters
ptr_psi_termt
char*attrname
ptr_psi_termg

Definition at line 239 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_copy_string(), and stack_insert().

240 {
241  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
242 }
#define FEATCMP
Definition: def_const.h:257
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
void stack_add_str_attr ( ptr_psi_term  t,
char *  attrname,
char *  str 
)

stack_add_str_attr

Parameters
ptr_psi_termt
char*attrname
char*str

Definition at line 170 of file token.c.

References wl_psi_term::attr_list, FEATCMP, heap_copy_string(), quoted_string, stack_copy_string(), stack_insert(), stack_psi_term(), wl_psi_term::type, and wl_psi_term::value_3.

171 {
172  ptr_psi_term t1;
173 
174  t1=stack_psi_term(4);
175  t1->type=quoted_string;
177 
178  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
179 }
#define FEATCMP
Definition: def_const.h:257
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
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_node attr_list
Definition: def_struct.h:171
char * stack_copy_string(char *s)
stack_copy_string
Definition: trees.c:184
GENERIC stack_alloc ( long  s)

stack_alloc

Parameters
longs

STACK_ALLOC(s) This returns a pointer to S bytes of memory in the stack. Alignment is taken into account in the following manner: the macro ALIGN is supposed to be a power of 2 and the pointer returned is a multiple of ALIGN.

Definition at line 1642 of file memory.c.

References ALIGN, Errorline(), heap_pointer, and stack_pointer.

1643 {
1644  GENERIC r;
1645 
1646  r = stack_pointer;
1647 
1648  if (s & (ALIGN-1))
1649  s = s - (s & (ALIGN-1)) + ALIGN;
1650  /* assert(s % sizeof(*stack_pointer) == 0); */
1651  s /= sizeof (*stack_pointer);
1652 
1653  stack_pointer += s;
1654 
1656  Errorline("the stack overflowed into the heap.\n");
1657 
1658  return r;
1659 }
void Errorline(char *format,...)
Definition: error.c:414
GENERIC heap_pointer
Definition: def_glob.h:12
GENERIC stack_pointer
Definition: def_glob.h:14
unsigned long * GENERIC
Definition: def_struct.h:17
#define ALIGN
Definition: def_const.h:31
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)
heap_ncopy_string
Definition: trees.c:150
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)
cons
Definition: types.c:179
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
stack_insert
Definition: trees.c:337
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_copy_psi_term ( psi_term  t)

stack_copy_psi_term

Parameters
psi_termt

STACK_COPY_PSI_TERM(tok) Return the address of a copy of TOK on the STACK. All psi_terms read in by the parser are read into the stack.

Definition at line 205 of file parser.c.

References global_time_stamp, and STACK_ALLOC.

206 {
207  ptr_psi_term p;
208 
210  (*p)=t;
211 #ifdef TS
212  p->time_stamp=global_time_stamp; /* 9.6 */
213 #endif
214 
215  return p;
216 }
#define STACK_ALLOC(A)
Definition: def_macro.h:16
unsigned long global_time_stamp
Definition: login.c:28
char * stack_copy_string ( char *  s)

stack_copy_string

Parameters
char*s

STACK_COPY_STRING(string) Make a copy of the string in the stack, and return a pointer to that. Exceptions: "1" and "2" are unique (and in the heap).

Definition at line 184 of file trees.c.

References one, stack_alloc(), and two.

185 {
186  char *p;
187 
188  if (s==one || s==two) return s;
189 
190  p=(char *)stack_alloc(strlen(s)+1);
191  strcpy(p,s);
192 
193  return p;
194 }
char * two
Definition: def_glob.h:251
char * one
Definition: def_glob.h:250
GENERIC stack_alloc(long s)
stack_alloc
Definition: memory.c:1642
void stack_info ( FILE *  outfile)

Definition at line 58 of file error.c.

References depth_cs(), depth_gs(), depth_ts(), and verbose.

60 {
61  /* Information about size of embedded stacks */
62  if (verbose) {
63  long gn,cn,tn;
64  fprintf(outfile,"*** Stack depths [");
65  gn=depth_gs();
66  cn=depth_cs();
67  tn=depth_ts();
68  fprintf(outfile,"%ld goal%s, %ld choice point%s, %ld trail entr%s",
69  gn,(gn!=1?"s":""),
70  cn,(cn!=1?"s":""),
71  tn,(tn!=1?"ies":"y"));
72  fprintf(outfile,"]\n");
73  }
74 }
static long depth_gs()
Definition: error.c:26
long verbose
Definition: error.c:19
static long depth_ts()
Definition: error.c:48
FILE * outfile
Definition: def_glob.h:333
static long depth_cs()
Definition: error.c:37
ptr_node stack_insert ( long  comp,
char *  keystr,
ptr_node tree,
GENERIC  info 
)

stack_insert

Parameters
longcomp
char*keystr
ptr_node*tree
GENERICinfo

STACK_INSERT(comp,keystr,tree,info) Exactly the same as heap_insert, only the new node is in the stack.

Definition at line 337 of file trees.c.

References FALSE, general_insert(), and STACK.

338 {
339 
340  return general_insert(comp,keystr,tree,info,STACK,FALSE,0L);
341 }
#define FALSE
Definition: def_const.h:128
ptr_node general_insert(long comp, char *keystr, ptr_node *tree, GENERIC info, long heapflag, long copystr, long bkflag)
ptr_node general_insert
Definition: trees.c:224
#define STACK
Definition: def_const.h:148
void stack_insert_copystr ( char *  keystr,
ptr_node tree,
GENERIC  info 
)

stack_insert_copystr

Parameters
char*keystr
ptr_node*tree
GENERICinfo

STACK_INSERT_COPYSTR(keystr,tree,info) Insert the pointer INFO under the reference string KEYSTR (which is a feature name) in the binary tree TREE. KEYSTR is copied to the heap. A potential additional node allocated to TREE is put on the stack.

Definition at line 301 of file trees.c.

References FEATCMP, general_insert(), STACK, and TRUE.

302 {
303 
304  (void)general_insert(FEATCMP,keystr,tree,info,STACK,TRUE,0L);
305 }
#define FEATCMP
Definition: def_const.h:257
#define TRUE
Definition: def_const.h:127
ptr_node general_insert(long comp, char *keystr, ptr_node *tree, GENERIC info, long heapflag, long copystr, long bkflag)
ptr_node general_insert
Definition: trees.c:224
#define STACK
Definition: def_const.h:148
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)
stack_insert
Definition: trees.c:337
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_psi_term ( long  stat)

stack_psi_term

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

Definition at line 21 of file lefun.c.

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

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

start_chrono

START_CHRONO() This initialises the CPU time counter.

Definition at line 349 of file login.c.

350 {
351  (void)times(&start_time);
352 }
long starts_nonlower ( char *  s)

starts_nonlower

Parameters
char*s

Return TRUE iff s starts with a non-lowercase character.

Definition at line 406 of file print.c.

References LOWER.

407 {
408  return (*s && !LOWER(s[0]));
409 }
#define LOWER(C)
Definition: def_macro.h:41
void stdin_cleareof ( )

stdin_cleareof

Clear EOF if necessary for stdin

Definition at line 51 of file token.c.

References eof_flag, FALSE, NULL, old_saved_char, old_saved_psi_term, saved_char, saved_psi_term, start_of_line, stdin_terminal, and TRUE.

52 {
53  if (eof_flag && stdin_terminal) {
54  clearerr(stdin);
58  saved_char=0;
61  }
62 }
long stdin_terminal
Definition: def_glob.h:188
long eof_flag
Definition: def_glob.h:196
long start_of_line
Definition: def_glob.h:191
long old_saved_char
Definition: def_glob.h:193
#define NULL
Definition: def_const.h:203
long saved_char
Definition: def_glob.h:192
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_psi_term saved_psi_term
Definition: def_glob.h:194
ptr_psi_term old_saved_psi_term
Definition: def_glob.h:195
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
long str_to_int ( char *  s)

str_to_int

Parameters
char*s

STR_TO_INT(s) Converts the string S into a positive integer. Returns -1 if s is not an integer.

Definition at line 118 of file print.c.

References DIGIT.

119 {
120  long v=0;
121  char c;
122 
123  c=(*s);
124  if (c==0)
125  v= -1;
126  else {
127  while (DIGIT(c)) {
128  v=v*10+(c-'0');
129  s++;
130  c=(*s);
131  }
132  if (c!=0) v= -1;
133  }
134 
135  return v;
136 }
#define DIGIT(C)
Definition: def_macro.h:37
long strict_matches ( ptr_psi_term  t1,
ptr_psi_term  t2,
long *  smaller 
)

strict_matches

Parameters
ptr_psi_termt1
ptr_psi_termt2
long*smaller

STRICT_MATCHES(t1,t2,s) Almost the same as matches, except that S is set to TRUE only if the type of t1 is strictly less than the type of t2. Because of the implementation of ints, reals, strings, and lists, this has to take the value field into account, and thus must be passed the whole psi-term.

Definition at line 1713 of file types.c.

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

1714 {
1715  long result,sm;
1716 
1717  result=matches(t1->type,t2->type,&sm);
1718 
1719  if (sm) {
1720  /* At this point, t1->type <| t2->type */
1721  if (t1->type==t2->type) {
1722  /* Same types: strict only if first has a value & second does not */
1723  if (t1->value_3!=NULL && t2->value_3==NULL)
1724  sm=TRUE;
1725  else
1726  sm=FALSE;
1727  }
1728  else {
1729  /* Different types: the first must be strictly smaller */
1730  sm=TRUE;
1731  }
1732  }
1733 
1734  *smaller=sm;
1735  return result;
1736 }
#define NULL
Definition: def_const.h:203
#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
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
matches
Definition: types.c:1666
char * string_val ( ptr_psi_term  term)

string_val

Parameters
ptr_psi_termterm

STRING_VAL(term) Return a string defined by a term, that is: if term is a string, return the value, otherwise return the symbol for that term.

Definition at line 169 of file modules.c.

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

170 {
171  deref_ptr(term);
172  if(term->value_3 && term->type==quoted_string)
173  return (char *)term->value_3;
174  else
175  return term->type->keyword->symbol;
176 }
ptr_keyword keyword
Definition: def_struct.h:124
char * symbol
Definition: def_struct.h:91
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition quoted_string
Definition: def_glob.h:101
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
char * strip_module_name ( char *  str)

strip_module_name

Parameters
char*str

STRIP_MODULE_NAME(symbol) Return the sub-string of symbol without the module prefix.

Definition at line 144 of file modules.c.

References legal_in_name().

145 {
146  char *s=str;
147 
148  while(legal_in_name(*s))
149  s++;
150  if(s!=str && *s=='#' /* && *(s+1)!=0 */) {
151  s++;
152  /* printf("Stripped module from '%s' yielding '%s'\n",str,s); */
153  return s;
154  }
155  else
156  return str;
157 }
long legal_in_name(long c)
legal_in_name
Definition: token.c:980
long strpos ( long  pos,
char *  str 
)

strpos

Parameters
longpos
char*str

Utility to correctly handle '
' inside strings being printed: What is the column after printing str, when the starting position is pos? Same as strlen, except that the length count starts with pos and
resets it.

Definition at line 608 of file print.c.

609 {
610  while (*str) {
611  if (str[0]=='\n') pos=0; else pos++;
612  str++;
613  }
614  return pos;
615 }
long sub_CodeType ( ptr_int_list  c1,
ptr_int_list  c2 
)

sub_CodeType

Parameters
ptr_int_listc1
ptr_int_listc2

SUB_CodeType(c1,c2) Return TRUE if code C1 is <| than type C2, that is if type represented by code C1 matches type represented by C2.

We already know that t1 and t2 are not top.

Definition at line 1618 of file types.c.

References FALSE, wl_int_list::next, NOT_CODED, TRUE, and wl_int_list::value_1.

1619 {
1620  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1621  while (c1 && c2) {
1622  if ((unsigned long)c1->value_1 & ~(unsigned long)c2->value_1) return FALSE;
1623  c1=c1->next;
1624  c2=c2->next;
1625  }
1626  }
1627  else
1628  return FALSE;
1629 
1630  return TRUE;
1631 }
#define NOT_CODED
Definition: def_const.h:134
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
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
long sub_type ( ptr_definition  t1,
ptr_definition  t2 
)

sub_type

Parameters
ptr_definitiont1
ptr_definitiont2

SUB_TYPE(t1,t2) Return TRUE if type T1 is <| than type T2, that is if T1 matches T2.

Definition at line 1642 of file types.c.

References wl_definition::code, FALSE, sub_CodeType(), top, and TRUE.

1643 {
1644  if (t1!=t2)
1645  if (t2!=top)
1646  {
1647  if (t1==top)
1648  return FALSE;
1649  else
1650  return sub_CodeType(t1->code, t2->code);
1651  }
1652  return TRUE;
1653 }
long sub_CodeType(ptr_int_list c1, ptr_int_list c2)
sub_CodeType
Definition: types.c:1618
ptr_definition top
Definition: def_glob.h:106
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_int_list code
Definition: def_struct.h:129
long symbolic ( long  c)

symbolic

Parameters
longc

SYMBOLIC(character) Tests if character is a symbol (see macro).

Definition at line 967 of file token.c.

References SYMBOL.

968 {
969  return SYMBOL(c);
970 }
#define SYMBOL(C)
Definition: def_macro.h:52
void Syntaxerrorline ( char *  format,
  ... 
)

Definition at line 498 of file error.c.

References assert, display_psi(), FALSE, input_file_name, parse_ok, perr_i(), perr_s(), print_code(), print_def_type(), print_operator_kind(), and psi_term_line_number.

499 {
500  va_list VarArg;
501  // int l;
502  char buffer_loc[5];
503  char *p;
504  unsigned long lng2;
505  char *cptr;
506  ptr_int_list pil;
507  ptr_psi_term psi;
508  operator kind;
509  def_type t ;
510  va_start(VarArg,format);
511  // fprintf(stderr,"format = %lx %s\n",(long)format,format);fflush(stdout);
512  if(parse_ok) { /* RM: Feb 1 1993 */
513  parse_ok=FALSE; /* RM: Feb 1 1993 */
514  fprintf(stderr,"*** Syntax error: ");
515  // fprintf(stderr,"format2 = %lx %s\n",(long)format,format);
516  // vinfoline(format, stderr, VarArg);
517  //#define vinfoline(format, outfile, xxxx) {
518  for (p=format;p && *p; p++)
519  {
520  if (*p == '%')
521  {
522  p++;
523  switch (*p)
524  {
525  case 'd':
526  case 'x':
527  buffer_loc[0] = '%';
528  buffer_loc[1] = 'l';
529  buffer_loc[2] = *p;
530  buffer_loc[3] = 0;
531  lng2 = va_arg(VarArg,long);
532  fprintf(stderr, buffer_loc, lng2);
533  break;
534  case 's':
535  buffer_loc[0] = '%';
536  buffer_loc[1] = *p;
537  buffer_loc[2] = 0;
538  cptr = va_arg(VarArg,char *);
539  fprintf(stderr, buffer_loc, cptr);
540  break;
541  case 'C':
542  /* type coding as bin string */
543  pil = va_arg(VarArg,ptr_int_list);
544  print_code(stderr,pil);
545  break;
546  case 'P':
547  psi = va_arg(VarArg,ptr_psi_term);
548  display_psi(stderr,psi);
549  break;
550  case 'O':
551  kind = va_arg(VarArg,operator);
552  print_operator_kind(stderr,kind);
553  break;
554  case 'T':
555  assert(stderr==stderr);
556  t = va_arg(VarArg,def_type);
557  print_def_type(t);
558  break;
559  case 'E':
560  assert(stderr==stderr);
561  perr_i("near line %ld",psi_term_line_number);
562  if (strcmp(input_file_name,"stdin")) {
563  perr_s(" in file \042%s\042",input_file_name);
564  }
565  parse_ok=FALSE;
566  break;
567  case '%':
568  (void)putc(*p,stderr);
569  break;
570  default:
571  fprintf(stderr,"<%c follows %% : report bug >", *p);
572  break;
573  }
574  }
575  else
576  (void)putc(*p,stderr);
577  }
578  }
579  va_end(VarArg);
580 }
void perr_i(char *str, long i)
Definition: error.c:677
long psi_term_line_number
Definition: def_glob.h:268
string input_file_name
Definition: def_glob.h:40
void display_psi(FILE *s, ptr_psi_term t)
display_psi
Definition: print.c:1579
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
print_code
Definition: print.c:167
void print_def_type(def_type t)
print_def_type
Definition: types.c:24
#define FALSE
Definition: def_const.h:128
long parse_ok
Definition: def_glob.h:171
void print_operator_kind(FILE *s, long kind)
print_operator_kind
Definition: print.c:192
#define assert(N)
Definition: memory.c:113
char * text_buffer_cmp ( struct text_buffer buf,
int  idx,
char *  str 
)

text_buffer_cmp

Parameters
structtext_buffer *buf
intidx
char*str

compare string str with text in buffer buf starting at index idx. if the text to the end matches a prefix of the string, return pointer to remaining suffix of str to be matched, else return 0.

Definition at line 934 of file sys.c.

References text_buffer::data, text_buffer::next, and top.

935 {
936  while (buf) {
937  while (idx<buf->top)
938  if (!*str || buf->data[idx] != *str)
939  return 0;
940  else { idx++; str++; }
941  if (!*str && !buf->next) return str;
942  else {
943  buf=buf->next;
944  idx=0;
945  }
946  }
947  return 0;
948 }
char data[TEXTBUFSIZE]
Definition: def_struct.h:401
ptr_definition top
Definition: def_glob.h:106
struct text_buffer * next
Definition: def_struct.h:399
void text_buffer_free ( struct text_buffer buf)

text_buffer_free

Parameters
structtext_buffer *buf

free a linked list of buffers

Definition at line 986 of file sys.c.

References text_buffer::next.

987 {
988  struct text_buffer *next;
989  while (buf) {
990  next = buf->next;
991  free(buf);
992  buf=next;
993  }
994 }
struct text_buffer * next
Definition: def_struct.h:399
int text_buffer_next ( struct text_buffer buf,
int  idx,
char  c,
struct text_buffer **  rbuf,
int *  ridx 
)

text_buffer_next

Parameters
structtext_buffer *buf
intidx
charc
structtext_buffer **rbuf
int*ridx

find the first match for character c starting from index idx in buffer buf. if found place new buffer and index in rbuf and ridx and return 1, else return 0

Definition at line 907 of file sys.c.

References text_buffer::data, text_buffer::next, and top.

908 {
909  while (buf) {
910  while (idx<buf->top)
911  if (buf->data[idx] == c) {
912  *rbuf=buf;
913  *ridx=idx;
914  return 1;
915  }
916  else idx++;
917  buf=buf->next;
918  idx=0;
919  }
920  return 0;
921 }
char data[TEXTBUFSIZE]
Definition: def_struct.h:401
ptr_definition top
Definition: def_glob.h:106
struct text_buffer * next
Definition: def_struct.h:399
void text_buffer_push ( struct text_buffer **  buf,
char  c 
)

text_buffer_push

Parameters
structtext_buffer **buf
charc

add a character at the end of a buffer. if the buffer is full, allocate a new buffer and link it to the current one, then overwrite the variable holding the pointer to the current buffer with the pointer to the new buffer.

Definition at line 961 of file sys.c.

References text_buffer::next, TEXTBUFSIZE, and text_buffer::top.

962 {
963  if ((*buf)->top < TEXTBUFSIZE)
964  (*buf)->data[(*buf)->top++] = c;
965  else {
966  (*buf)->next = (struct text_buffer *)
967  malloc(sizeof(struct text_buffer));
968  if (!(*buf)->next) {
969  fprintf(stderr,"Fatal error: malloc failed in text_buffer_push\n");
970  exit(EXIT_FAILURE);
971  }
972  bzero((char*)(*buf)->next,sizeof(struct text_buffer));
973  *buf = (*buf)->next;
974  (*buf)->top = 1;
975  (*buf)->data[0]=c;
976  }
977 }
#define TEXTBUFSIZE
Definition: def_struct.h:396
struct text_buffer * next
Definition: def_struct.h:399
void title ( )

TITLE.

This routine marks the start of Life. It prints info about the compile DATE, some blurb about the author etc... Who cares anyway?? [I do! -hak]

Definition at line 39 of file info.c.

References PARSER_STACK_SIZE, pnf(), quietflag, REAL, and STRLEN.

40 {
41  if(quietflag)
42  return; /* RM: Feb 17 1993 */
43 
44  printf("Wild_Life Interpreter Version +VERSION+ +DATE+\n");
45  printf("Copyright (C) 1991-93 DEC Paris Research Laboratory\n");
46  printf("Extensions, Copyright (C) 1994-1995 Intelligent Software Group, SFU\n");
47  // should comment next 4 lines for test suite
48  // printf("OS/2 Port by Dennis J. Darland 06/17/96\n");
49  // printf("SUSE Linux Port by Dennis J. Darland May 2014\n");
50  // printf("Cygwin Port by Dennis J. Darland March 2015\n");
51  // printf("Further Debugging of Port by Dennis J. Darland June 2016\n");
52  // I don't understand why I cannot have above lines.
53  // has to to with title call in lib.c & life.c - related to memory.c
54  // may be important to understand even not just for above printf's
55 
56 #ifndef X11
57  printf("X interface not installed.\n");
58 #endif
59 
60 #if 0
61  printf("\n- Main data-structure sizes:\n");
62  pnf("rule",sizeof(struct pair_list));
63  pnf("psi_term",sizeof(struct psi_term));
64  pnf("binary tree node",sizeof(struct node));
65  pnf("stacked goal",sizeof(struct goal));
66  pnf("stacked choice-point",sizeof(struct choice_point));
67  pnf("backtracking action",sizeof(struct ptr_stack));
68  pnf("symbol definition",sizeof(struct definition));
69  pnf("code node",sizeof(struct int_list));
70  pnf("list node",sizeof(struct list));
71  pnf("real number",sizeof(REAL));
72 
73  printf("\n- Size of C built-in types:\n");
74  pnf("REAL",sizeof(REAL));
75  pnf("long",sizeof(long));
76  pnf("int",sizeof(unsigned long));
77  pnf("pointer",sizeof(char *));
78 
79  printf("\n- System constants:\n");
80  pnf("Maximum string or line length:",STRLEN);
81  pnf("Parser stack depth:",PARSER_STACK_SIZE);
82  pnf("Size of real numbers:",sizeof(REAL));
83  printf("\n\n");
84 #endif
85 }
static void pnf(char *s, int n)
PNF.
Definition: info.c:21
#define PARSER_STACK_SIZE
Definition: def_const.h:100
long quietflag
Definition: def_glob.h:271
#define REAL
Definition: def_const.h:72
#define STRLEN
Definition: def_const.h:86
void toggle_step ( )

Definition at line 650 of file error.c.

References new_step(), and stepflag.

651 {
652  new_step(!stepflag);
653 }
void new_step(long newstep)
Definition: error.c:629
long stepflag
Definition: error.c:20
void toggle_trace ( )

Definition at line 644 of file error.c.

References new_trace(), and trace.

645 {
646  new_trace(trace?0:1);
647 }
void new_trace(long newtrace)
Definition: error.c:619
long trace
Definition: error.c:18
void TOKEN_ERROR ( ptr_psi_term  p)

TOKEN_ERROR.

Parameters
ptr_psi_termp

Definition at line 38 of file token.c.

References error_psi_term, Syntaxerrorline(), and wl_psi_term::type.

39 {
40  if(p->type==error_psi_term->type) {
41  Syntaxerrorline("Module violation (%E).\n");
42  }
43 }
void Syntaxerrorline(char *format,...)
Definition: error.c:498
ptr_psi_term error_psi_term
Definition: def_glob.h:23
ptr_definition type
Definition: def_struct.h:165
ptr_choice_point topmost_what_next ( )

topmost_what_next

UNUSED 12.7 Return the choice point corresponding to the first 'what_next' choice point in the choice point stack. Return NULL if there is none. This is used to ensure that cuts don't go below the most recent 'what_next' choice point.

Definition at line 2026 of file login.c.

References choice_stack, wl_choice_point::goal_stack, wl_choice_point::next, NULL, wl_goal::type, and what_next.

2027 {
2029 
2030  while (cp && cp->goal_stack && cp->goal_stack->type!=what_next)
2031  cp=cp->next;
2032 
2033  if (cp && cp->goal_stack && cp->goal_stack->type==what_next)
2034  return cp;
2035  else
2036  return (ptr_choice_point) NULL;
2037 }
#define NULL
Definition: def_const.h:203
ptr_choice_point next
Definition: def_struct.h:235
goals type
Definition: def_struct.h:223
#define what_next
Definition: def_const.h:277
ptr_goal goal_stack
Definition: def_struct.h:234
ptr_choice_point choice_stack
Definition: def_glob.h:51
void traceline ( char *  format,
  ... 
)

Definition at line 157 of file error.c.

References assert, display_psi(), FALSE, input_file_name, parse_ok, perr_i(), perr_s(), print_code(), print_def_type(), print_operator_kind(), psi_term_line_number, trace, and tracing().

158 {
159  va_list VarArg;
160  // int l;
161  char buffer_loc[5];
162  char *p;
163  unsigned long lng2;
164  char *cptr;
165  ptr_int_list pil;
166  ptr_psi_term psi;
167  operator kind;
168  def_type t ;
169 
170  va_start(VarArg,format);
171 
172  if (trace) // DJD
173  {
174  /* RM: Nov 10 1993 */
175 
176  if ((trace == 2) && (format[0] != 'p')) return;
177  tracing();
178 
179  // vinfoline(format, stdout, VarArg);
180  // #define vinfoline(format, outfile, xxxx) {
181  for (p=format;p && *p; p++)
182  {
183  if (*p == '%')
184  {
185  p++;
186  switch (*p)
187  {
188  case 'd':
189  case 'x':
190  buffer_loc[0] = '%';
191  buffer_loc[1] = 'l';
192  buffer_loc[2] = *p;
193  buffer_loc[3] = 0;
194  lng2 = va_arg(VarArg, long);
195  fprintf(stdout, buffer_loc, lng2);
196  break;
197  case 's':
198  buffer_loc[0] = '%';
199  buffer_loc[1] = *p;
200  buffer_loc[2] = 0;
201  cptr = va_arg(VarArg,char *);
202  fprintf(stdout, buffer_loc, cptr);
203  break;
204  case 'C':
205  /* type coding as bin string */
206  pil = va_arg(VarArg,ptr_int_list);
207  print_code(stdout,pil);
208  break;
209  case 'P':
210  psi = va_arg(VarArg,ptr_psi_term);
211  display_psi(stdout,psi);
212  break;
213  case 'O':
214  kind = va_arg(VarArg,operator);
215  print_operator_kind(stdout,kind);
216  break;
217  case 'T':
218  assert(stdout==stderr);
219  t = va_arg(VarArg,def_type);
220  print_def_type(t);
221  break;
222  case 'E':
223  assert(stdout==stderr);
224  perr_i("near line %ld",psi_term_line_number);
225  if (strcmp(input_file_name,"stdin")) {
226  perr_s(" in file \042%s\042",input_file_name);
227  }
228  parse_ok=FALSE;
229  break;
230  case '%':
231  (void)putc(*p,stdout);
232  break;
233  default:
234  fprintf(stdout,"<%c follows %% : report bug >", *p);
235  break;
236  }
237  }
238  else
239  (void)putc(*p,stdout);
240  }
241  }
242  va_end(VarArg);
243 }
void perr_i(char *str, long i)
Definition: error.c:677
long psi_term_line_number
Definition: def_glob.h:268
string input_file_name
Definition: def_glob.h:40
void display_psi(FILE *s, ptr_psi_term t)
display_psi
Definition: print.c:1579
void perr_s(char *s1, char *s2)
Definition: error.c:665
void tracing()
Definition: error.c:604
void print_code(FILE *s, ptr_int_list c)
print_code
Definition: print.c:167
void print_def_type(def_type t)
print_def_type
Definition: types.c:24
#define FALSE
Definition: def_const.h:128
long trace
Definition: error.c:18
long parse_ok
Definition: def_glob.h:171
void print_operator_kind(FILE *s, long kind)
print_operator_kind
Definition: print.c:192
#define assert(N)
Definition: memory.c:113
void tracing ( )

Definition at line 604 of file error.c.

References depth_cs(), depth_gs(), goal_count, MAX_TRACE_INDENT, steptrace, and TRUE.

605 {
606  long i;
607  long indent_loc;
608 
609  printf("T%04ld",goal_count);
610  printf(" C%02ld",depth_cs());
611  indent_loc=depth_gs();
612  if (indent_loc>=MAX_TRACE_INDENT) printf(" G%02ld",indent_loc);
613  indent_loc = indent_loc % MAX_TRACE_INDENT;
614  for (i=indent_loc; i>=0; i--) printf(" ");
615  steptrace=TRUE;
616 }
static long depth_gs()
Definition: error.c:26
#define MAX_TRACE_INDENT
Definition: def_const.h:120
long steptrace
Definition: error.c:21
long goal_count
Definition: def_glob.h:152
#define TRUE
Definition: def_const.h:127
static long depth_cs()
Definition: error.c:37
long trail_condition ( psi_term Q)

trail_condition

Parameters
psi_term*Q

Definition at line 2632 of file login.c.

References choice_stack, and wl_choice_point::time_stamp.

2633 {
2634  return (choice_stack && choice_stack->time_stamp>=Q->time_stamp);
2635 }
unsigned long time_stamp
Definition: def_struct.h:232
ptr_choice_point choice_stack
Definition: def_glob.h:51
ptr_psi_term translate ( ptr_psi_term  a,
long **  infoptr 
)

translate

Parameters
ptr_psi_terma
long**infoptr)

TRANSLATE(a,info) Get the translation of address A and the info field stored with it. Return NULL if none is found.

Definition at line 108 of file copy.c.

References hashentry::bucketindex, HASH, HASHEND, hashtable, hashtime, hashbucket::info, hashbucket::new_value, hashbucket::next, NULL, and hashbucket::old_value.

109 {
110  long index;
111  /* long i; 20.8 */
112  long bucket;
113 
114  index = HASH(a);
115  if (hashtable[index].timestamp != hashtime) return NULL;
116  bucket = hashtable[index].bucketindex;
117  /* i=0; 20.8 */
118  while (bucket != HASHEND && hashbuckets[bucket].old_value != a) {
119  /* i++; 20.8 */
120  bucket = hashbuckets[bucket].next;
121  }
122  /* hashstats[i]++; 20.8 */
123  if (bucket != HASHEND) {
124  *infoptr = &hashbuckets[bucket].info;
125  return (hashbuckets[bucket].new_value);
126  }
127  else
128  return NULL;
129 }
static struct hashentry hashtable[HASHSIZE]
Definition: copy.c:16
#define HASHEND
Definition: def_const.h:322
#define NULL
Definition: def_const.h:203
static long hashtime
Definition: copy.c:18
static struct hashbucket * hashbuckets
Definition: copy.c:17
long bucketindex
Definition: def_struct.h:393
#define HASH(A)
Definition: def_macro.h:273
void traverse_tree ( ptr_node  n,
int  flag 
)

traverse_tree

Parameters
ptr_noden
0intflag

Do for all arguments, for the built-ins c_public, c_private, and c_private_feature.

Definition at line 656 of file modules.c.

References wl_node::data, deref_ptr, FALSE, wl_node::left, MAKE_FEATURE_PRIVATE, make_feature_private(), MAKE_PRIVATE, make_public(), MAKE_PUBLIC, wl_node::right, and TRUE.

657 {
658  if (n) {
659  ptr_psi_term t;
660  traverse_tree(n->left,flag);
661 
662  t=(ptr_psi_term)n->data;
663  deref_ptr(t);
664  switch (flag) {
665  case MAKE_PUBLIC:
666  (void)make_public(t,TRUE);
667  break;
668  case MAKE_PRIVATE:
669  (void)make_public(t,FALSE);
670  break;
672  (void)make_feature_private(t);
673  break;
674  }
675  traverse_tree(n->right,flag);
676  }
677 }
void traverse_tree(ptr_node n, int flag)
traverse_tree
Definition: modules.c:656
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define MAKE_PRIVATE
Definition: modules.c:644
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
int make_feature_private(ptr_psi_term term)
make_feature_private
Definition: modules.c:1256
long make_public(ptr_psi_term term, long bool)
make_public
Definition: modules.c:613
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
#define MAKE_FEATURE_PRIVATE
Definition: modules.c:645
#define MAKE_PUBLIC
Definition: modules.c:643
ptr_node right
Definition: def_struct.h:184
long two_or_more ( ptr_node  t)

two_or_more

Parameters
ptr_nodet

Return true if number of attributes is greater than 1

Definition at line 1254 of file print.c.

References FALSE, wl_node::left, wl_node::right, and TRUE.

1255 {
1256  if (t) {
1257  if (t->left || t->right) return TRUE; else return FALSE;
1258  }
1259  else
1260  return FALSE;
1261 }
ptr_node left
Definition: def_struct.h:183
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_node right
Definition: def_struct.h:184
ptr_int_list two_to_the ( long  p)

two_to_the

Parameters
longp

TWO_TO_THE(p) Return the code worth 2^p.

Definition at line 776 of file types.c.

References HEAP_ALLOC, INT_SIZE, wl_int_list::next, NULL, and wl_int_list::value_1.

777 {
778  ptr_int_list result,code;
779  long v=1;
780 
781  code=HEAP_ALLOC(int_list);
782  code->value_1=0;
783  code->next=NULL;
784  result=code;
785 
786  while (p>=INT_SIZE) {
787  code->next=HEAP_ALLOC(int_list);
788  code=code->next;
789  code->value_1=0;
790  code->next=NULL;
791  p=p-INT_SIZE;
792  }
793 
794  v= v<<p ;
795  code->value_1=(GENERIC)v;
796 
797  return result;
798 }
#define INT_SIZE
Definition: def_const.h:144
#define NULL
Definition: def_const.h:203
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_int_list next
Definition: def_struct.h:55
long type_cyclicity ( ptr_definition  d,
ptr_int_list  anc 
)

type_cyclicity

Parameters
ptr_definitiond
ptr_int_listanc

TYPE_CYCLICITY(d,anc) Check cyclicity of type hierarchy. If cyclic, return a TRUE error condition and print an error message with a cycle.

Definition at line 977 of file types.c.

References wl_definition::code, Errorline(), exit_life(), FALSE, wl_int_list::next, NOT_CODED, wl_definition::parents, perr(), perr_sort_cycle(), TRUE, type_member(), and wl_int_list::value_1.

978 {
979  ptr_int_list p=d->parents;
980  ptr_definition pd;
981  long errflag;
982  int_list anc2;
983 
984  while (p) {
985  pd=(ptr_definition)p->value_1;
986  /* If unmarked, mark and recurse */
987  if (pd->code==NOT_CODED) {
988  pd->code = (ptr_int_list)TRUE;
989  anc2.value_1=(GENERIC)pd;
990  anc2.next=anc;
991  errflag=type_cyclicity(pd,&anc2);
992  if (errflag) return TRUE;
993  }
994  /* If marked, check if it's in the ancestor list */
995  else {
996  if (type_member(pd,anc)) {
997  Errorline("there is a cycle in the sort hierarchy\n");
998  perr("*** Cycle: [");
999  perr_sort_cycle(anc);
1000  perr("]\n");
1001  exit_life(TRUE);
1002  return TRUE;
1003  }
1004  }
1005  p=p->next;
1006  }
1007  return FALSE;
1008 }
long type_cyclicity(ptr_definition d, ptr_int_list anc)
type_cyclicity
Definition: types.c:977
void perr(char *str)
Definition: error.c:659
void exit_life(long nl_flag)
exit_life
Definition: built_ins.c:2220
#define NOT_CODED
Definition: def_const.h:134
void perr_sort_cycle(ptr_int_list anc)
perr_sort_cycle
Definition: types.c:959
void Errorline(char *format,...)
Definition: error.c:414
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
struct wl_definition * ptr_definition
Definition: def_struct.h:31
ptr_int_list code
Definition: def_struct.h:129
GENERIC value_1
Definition: def_struct.h:54
unsigned long * GENERIC
Definition: def_struct.h:17
struct wl_int_list * ptr_int_list
Definition: def_struct.h:29
long type_member(ptr_definition t, ptr_int_list tlst)
type_member
Definition: types.c:918
ptr_int_list next
Definition: def_struct.h:55
ptr_int_list parents
Definition: def_struct.h:130
void type_disj_aim ( )

type_disj_aim

TYPE_DISJ_AIM() This routine implements type disjunctions, that is, when a type has been decoded and found to be a disjunction of types, enumerates the different values one by one.

Definition at line 1845 of file login.c.

References wl_goal::aaaa_1, aim, wl_definition::always_check, wl_psi_term::attr_list, wl_goal::bbbb_1, def_ptr, FALSE, fetch_def(), wl_definition::keyword, wl_int_list::next, NULL, push_choice_point(), push_ptr_value(), wl_psi_term::status, wl_keyword::symbol, traceline(), wl_psi_term::type, type_disj, and wl_int_list::value_1.

1846 {
1847  ptr_psi_term t;
1848  ptr_int_list d;
1849 
1850  t=(ptr_psi_term)aim->aaaa_1;
1851  d=(ptr_int_list)aim->bbbb_1;
1852 
1853  if (d->next) {
1854  traceline("pushing type disjunction choice point for %P\n", t);
1856  }
1857 
1858  push_ptr_value(def_ptr,(GENERIC *)&(t->type));
1859  /* Below makes cut.lf behave incorrectly: */
1860  /* push_def_ptr_value(t,&(t->type)); */ /* 14.8 */
1861  t->type=(ptr_definition)d->value_1;
1862 
1863  traceline("setting type disjunction to %s.\n", t->type->keyword->symbol);
1864 
1865  if ((t->attr_list || t->type->always_check) && t->status<4)
1866  fetch_def(t, FALSE);
1867 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define def_ptr
Definition: def_const.h:173
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
char always_check
Definition: def_struct.h:134
void traceline(char *format,...)
Definition: error.c:157
#define FALSE
Definition: def_const.h:128
struct wl_definition * ptr_definition
Definition: def_struct.h:31
ptr_goal aim
Definition: def_glob.h:49
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
#define type_disj
Definition: def_const.h:284
ptr_definition type
Definition: def_struct.h:165
GENERIC value_1
Definition: def_struct.h:54
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
void fetch_def(ptr_psi_term u, long allflag)
fetch_def
Definition: login.c:1208
ptr_node attr_list
Definition: def_struct.h:171
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
push_choice_point
Definition: login.c:638
ptr_int_list next
Definition: def_struct.h:55
long type_member ( ptr_definition  t,
ptr_int_list  tlst 
)

type_member

Parameters
ptr_definitiont
ptr_int_listtlst

TYPE_MEMBER(t,tlst) Return TRUE iff type t is in the list tlst.

Definition at line 918 of file types.c.

References FALSE, wl_int_list::next, TRUE, and wl_int_list::value_1.

919 {
920  while (tlst) {
921  if (t==(ptr_definition)tlst->value_1) return TRUE;
922  tlst=tlst->next;
923  }
924  return FALSE;
925 }
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
GENERIC value_1
Definition: def_struct.h:54
ptr_int_list next
Definition: def_struct.h:55
void undo ( ptr_stack  limit)

undo

Parameters
ptr_stacklimit

UNDO(limit) Undoes any side-effects up to LIMIT. Limit being the adress of the stack of side-effects you wish to return to.

Possible improvement: LIMIT is a useless parameter because GOAL_STACK is equivalent if one takes care when stacking UNDO actions. Namely, anything to be undone must be stacked LATER (=after) the goal which caused these things to be done, so that when the goal fails, everything done after it can be undone and the memory used can be reclaimed. This routine could be modified in order to cope with goals to be proved on backtracking: undo(goal).

Definition at line 691 of file login.c.

References wl_stack::aaaa_3, wl_stack::bbbb_3, destroy_window, hide_subwindow, hide_window, wl_stack::next, show_subwindow, show_window, wl_stack::type, undo_action, and undo_stack.

692 {
693  /*
694  while((unsigned long)undo_stack>(unsigned long)goal_stack)
695  */
696 
697  while ((unsigned long)undo_stack>(unsigned long)limit) {
698 #ifdef X11
699  if (undo_stack->type & undo_action) {
700  /* Window operation on backtracking */
701  switch(undo_stack->type) { /*** RM 8/12/92 ***/
702  case destroy_window:
703  x_destroy_window((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
704  break;
705  case show_window:
706  x_show_window((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
707  break;
708  case hide_window:
709  x_hide_window((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
710  break;
711  case show_subwindow:
712  x_show_subwindow((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
713  break;
714  case hide_subwindow:
715  x_hide_subwindow((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
716  break;
717  }
718  }
719  else
720 #endif
721  /* Restoring variable value on backtracking */
724  }
725 }
#define show_subwindow
Definition: def_const.h:186
#define hide_subwindow
Definition: def_const.h:187
#define show_window
Definition: def_const.h:184
GENERIC * bbbb_3
Definition: def_struct.h:218
#define destroy_window
Definition: def_const.h:183
#define hide_window
Definition: def_const.h:185
ptr_stack undo_stack
Definition: def_glob.h:53
type_ptr type
Definition: def_struct.h:216
GENERIC * aaaa_3
Definition: def_struct.h:217
#define undo_action
Definition: def_const.h:188
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
void undo_actions ( )

undo_actions

UNDO_ACTIONS() A subset of undo(limit) (the detrailing routine) that does all undo actions on the undo_stack, but does not undo any variable bindings, nor does it change the value of undo_stack.

Definition at line 736 of file login.c.

References Errorline(), NULL, and undo().

737 {
738  // ptr_stack u=undo_stack;
739 
740  Errorline("undo_actions should not be called.\n");
741  undo(NULL); /* 8.10 */
742  return;
743  /*
744  #ifdef X11
745  while ((unsigned long)u) {
746  if (u->type & undo_action) {
747  if (u->type==destroy_window) {
748  x_destroy_window((unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3);
749  }
750  else if (u->type==show_window) {
751  x_show_window((unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3);
752  }
753  else if (u->type==hide_window) {
754  x_hide_window((unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3);
755  }
756  }
757  u=u->next;
758  }
759  #endif
760  */
761 }
void undo(ptr_stack limit)
undo
Definition: login.c:691
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Definition: error.c:414
long unify_aim ( )

unify_aim

UNIFY_AIM() This routine performs one unification step. AIM is the current unification goal.

U and V are the two psi-terms to unify.

It swaps the two psi-terms into chronological order. U is the oldest (smallest stack address). Calculates their GLB, check their values are unifiable. It deals with all the messy things like: curried functions gaining missing arguments, types which need checking, residuation variables whose constraints must be released, disjunctions appearing in the GLB etc...

It's a rather lengthy routine, only its speed is fairly crucial in the overall performance of Wild_Life, and the code is not duplicated elsewhere.

Definition at line 1344 of file login.c.

References TRUE, and unify_body().

1345 {
1346  return unify_body(TRUE);
1347 }
long unify_body(long eval_flag)
unify_body
Definition: login.c:1365
#define TRUE
Definition: def_const.h:127
long unify_aim_noeval ( )

unify_aim_noeval

Definition at line 1354 of file login.c.

References FALSE, and unify_body().

1355 {
1356  return unify_body(FALSE);
1357 }
long unify_body(long eval_flag)
unify_body
Definition: login.c:1365
#define FALSE
Definition: def_const.h:128
long unify_body ( long  eval_flag)

unify_body

Parameters
longeval_flag

Definition at line 1365 of file login.c.

References wl_goal::aaaa_1, aim, wl_psi_term::attr_list, wl_goal::bbbb_1, wl_psi_term::coref, cut, cut_ptr, decode(), def_ptr, deref, deref_ptr, equal_types, Errorline(), FALSE, fetch_def_lazy(), wl_psi_term::flags, function_it, glb(), global_unify(), heap_pointer, int_ptr, integer, wl_definition::keyword, merge(), more_u_attr, more_v_attr, new_stat, wl_int_list::next, NULL, overlap_type(), push_choice_point(), push_psi_ptr_value(), push_ptr_value(), quoted_string, QUOTED_TRUE, REAL, real, release_resid(), wl_psi_term::resid, wl_psi_term::status, sub_type(), wl_keyword::symbol, sys_bytedata, traceline(), TRUE, wl_psi_term::type, wl_definition::type_def, type_disj, type_it, u_func, v_func, wl_int_list::value_1, wl_psi_term::value_3, and warningline().

1366 {
1367  long success=TRUE,compare;
1368  ptr_psi_term u,v,tmp;
1369  REAL r;
1370  ptr_definition new_type,old1,old2;
1371  ptr_node old1attr, old2attr;
1372  ptr_int_list new_code;
1373  ptr_int_list d=NULL;
1374  long old1stat,old2stat; /* 18.2.94 */
1375 
1376  u=(ptr_psi_term )aim->aaaa_1;
1377  v=(ptr_psi_term )aim->bbbb_1;
1378 
1379  deref_ptr(u);
1380  deref_ptr(v);
1381 
1382  traceline("unify %P with %P\n",u,v);
1383 
1384  if (eval_flag) {
1385  deref(u);
1386  deref(v);
1387  }
1388 
1389  if (u!=v) {
1390 
1391  /**** Swap the two psi-terms to get them into chronological order ****/
1392  if (u>v) { tmp=v; v=u; u=tmp; }
1393 
1394  /**** Check for curried functions ****/
1397  old1stat=u->status; /* 18.2.94 */
1398  old2stat=v->status; /* 18.2.94 */
1399 
1400  /* PVR 18.2.94 */
1401  /* if (u_func && !(u->flags&QUOTED_TRUE) && v->attr_list) { */
1402  if (u_func && u->status==4 && !(u->flags&QUOTED_TRUE) && v->attr_list) {
1403  Errorline("attempt to unify with curried function %P\n", u);
1404  return FALSE;
1405  }
1406  /* if (v_func && !(v->flags&QUOTED_TRUE) && u->attr_list) { */
1407  if (v_func && v->status==4 && !(v->flags&QUOTED_TRUE) && u->attr_list) {
1408  Errorline("attempt to unify with curried function %P\n", v);
1409  return FALSE;
1410  }
1411 
1412 
1413 #ifdef ARITY /* RM: Mar 29 1993 */
1414  arity_unify(u,v);
1415 #endif
1416 
1417  /***** Deal with global vars **** RM: Feb 8 1993 */
1418  if((GENERIC) v>=heap_pointer)
1419  return global_unify(u,v);
1420 
1421 
1422  /**** Calculate their Greatest Lower Bound and compare them ****/
1423  success=(compare=glb(u->type,v->type,&new_type,&new_code));
1424 
1425  if (success) {
1426 
1427  /**** Keep the old types for later use in incr. constraint checking ****/
1428  old1 = u->type;
1429  old2 = v->type;
1430  old1attr = u->attr_list;
1431  old2attr = v->attr_list;
1432 
1433  /**** DECODE THE RESULTING TYPE ****/
1434  if (!new_type) {
1435  d=decode(new_code);
1436  if (d) {
1437  new_type=(ptr_definition)d->value_1;
1438  d=d->next;
1439  }
1440  else
1441  Errorline("undecipherable sort code.\n");
1442  }
1443 
1444  /**** Make COMPARE a little more precise ****/
1445  if (compare==1)
1446  if (u->value_3 && !v->value_3)
1447  compare=2;
1448  else
1449  if (v->value_3 && !u->value_3)
1450  compare=3;
1451 
1452  /**** Determine the status of the resulting psi-term ****/
1453  new_stat=4;
1454  switch (compare) {
1455  case 1:
1456  if (u->status <4 && v->status <4)
1457  new_stat=2;
1458  break;
1459  case 2:
1460  if (u->status<4)
1461  new_stat=2;
1462  break;
1463  case 3:
1464  if (v->status<4)
1465  new_stat=2;
1466  break;
1467  case 4:
1468  new_stat=2;
1469  break;
1470  }
1471 
1472  /*
1473  printf("u=%s, v=%s, compare=%ld, u.s=%ld, v.s=%ld, ns=%ld\n",
1474  u->type->keyword->symbol,
1475  v->type->keyword->symbol,
1476  compare,
1477  u->status,
1478  v->status,
1479  new_stat);
1480  */
1481 
1482  /**** Check that integers have no decimals ****/
1483  if (u->value_3 && sub_type(new_type,integer)) {
1484  r= *(REAL *)u->value_3;
1485  success=(r==floor(r));
1486  }
1487  if (success && v->value_3 && sub_type(new_type,integer)) {
1488  r= *(REAL *)v->value_3;
1489  success=(r==floor(r));
1490  }
1491 
1492  /**** Unify the values of INTs REALs STRINGs LISTs etc... ****/
1493  if (success) {
1494  /* LAZY-EAGER */
1495  if (u->value_3!=v->value_3)
1496  if (!u->value_3) {
1497  compare=4;
1499  u->value_3=v->value_3;
1500  }
1501  else if (v->value_3) {
1502  if (overlap_type(new_type,real))
1503  success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
1504  else if (overlap_type(new_type,quoted_string))
1505  success=(strcmp((char *)u->value_3,(char *)v->value_3)==0);
1506  else if (overlap_type(new_type,sys_bytedata)) {
1507  unsigned long ulen = *((unsigned long *)u->value_3);
1508  unsigned long vlen = *((unsigned long *)v->value_3);
1509  success=(ulen==vlen &&
1510  (bcmp((char *)u->value_3,(char *)v->value_3,ulen)==0));
1511  }
1512  else if (u->type==cut && v->type==cut) { /* 22.9 */
1513  ptr_psi_term mincut;
1514  mincut = (ptr_psi_term) (u->value_3 < (GENERIC) v->value_3? u->value_3 : v->value_3);
1515  if (mincut!=(ptr_psi_term)u->value_3) {
1517  u->value_3=(GENERIC)mincut;
1518  }
1519  }
1520  else {
1521  warningline("'%s' may not be unified.\n",new_type->keyword->symbol);
1522  success=FALSE;
1523  }
1524  }
1525  else
1526  compare=4;
1527  }
1528 
1529  /**** Bind the two psi-terms ****/
1530  if (success) {
1531  /* push_ptr_value(psi_term_ptr,(ptr_psi_term *)&(v->coref)); 9.6 */
1532  push_psi_ptr_value(v,(GENERIC *)&(v->coref));
1533  v->coref=u;
1534 
1535  if (!equal_types(u->type,new_type)) {
1536  push_ptr_value(def_ptr,(GENERIC *)&(u->type));
1537  /* This does not seem to work right with cut.lf: */
1538  /* push_def_ptr_value(u,&(u->type_3)); */ /* 14.8 */
1539  u->type=new_type;
1540  }
1541 
1542  if (u->status!=new_stat) {
1544  u->status=new_stat;
1545  }
1546 
1547  /**** Unify the attributes ****/
1550 
1551 
1552 #ifdef ARITY /* RM: Mar 29 1993 */
1553  arity_merge(u->attr_list,v->attr_list);
1554 #endif
1555 
1556 
1557  if (u->attr_list || v->attr_list)
1558  merge(&(u->attr_list),v->attr_list);
1559 
1560  /**** Look after curried functions ****/
1561  /*
1562  if ((u_func && more_v_attr) || (v_func && more_u_attr)) {
1563  if (!(u->flags&QUOTED_TRUE | v->flags&QUOTED_TRUE)) {
1564  traceline("re-evaluating curried expression %P\n", u);
1565  if (u->status!=0) {
1566  push_ptr_value(int_ptr,(ptr_psi_term *)&(u->status));
1567  u->status=0;
1568  }
1569  check_func(u);
1570  }
1571  }
1572  */
1573 
1574  if (v->flags&QUOTED_TRUE && !(u->flags&QUOTED_TRUE)) { /* 16.9 */
1575  push_ptr_value(int_ptr,(GENERIC *)&(u->flags));
1576  u->flags|=QUOTED_TRUE;
1577  }
1578 
1579  /**** RELEASE RESIDUATIONS ****/
1580  /* This version implements the correct semantics. */
1581  if (u->resid)
1582  release_resid(u);
1583  if (v->resid)
1584  release_resid(v);
1585 
1586  /**** Alternatives in a type disjunction ****/
1587  if (d) {
1588  traceline("pushing type disjunction choice point for %P\n",u);
1590  }
1591 
1592  /**** VERIFY CONSTRAINTS ****/
1593  /* if ((old1stat<4 || old2stat<4) &&
1594  (u->type->type==type || v->type->type==type)) { 18.2.94 */
1595  if (new_stat<4 && u->type->type_def==(def_type)type_it) {
1596  /* This does not check the already-checked properties */
1597  /* (i.e. those in types t with t>=old1 or t>=old2), */
1598  /* and it does not check anything if u has no attributes. */
1599  /* It will, however, check the unchecked properties if a */
1600  /* type gains attributes. */
1601  fetch_def_lazy(u, old1, old2,
1602  old1attr, old2attr,
1603  old1stat, old2stat);
1604  }
1605  }
1606  }
1607  }
1608  return success;
1609 }
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
int global_unify(ptr_psi_term u, ptr_psi_term v)
global_unify
Definition: modules.c:1053
struct wl_definition * def_type
Definition: def_struct.h:32
long glb(ptr_definition t1, ptr_definition t2, ptr_definition *t3, ptr_int_list *c3)
glb
Definition: types.c:1481
#define def_ptr
Definition: def_const.h:173
long new_stat
Definition: def_glob.h:307
ptr_int_list decode(ptr_int_list c)
decode
Definition: types.c:1784
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
def_type type_def
Definition: def_struct.h:133
long more_u_attr
Definition: def_glob.h:303
ptr_keyword keyword
Definition: def_struct.h:124
#define cut_ptr
Definition: def_const.h:176
#define NULL
Definition: def_const.h:203
char * symbol
Definition: def_struct.h:91
void merge(ptr_node *u, ptr_node v)
merge
Definition: login.c:1131
long overlap_type(ptr_definition t1, ptr_definition t2)
overlap_type
Definition: types.c:1579
#define REAL
Definition: def_const.h:72
void release_resid(ptr_psi_term t)
release_resid
Definition: lefun.c:445
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
void traceline(char *format,...)
Definition: error.c:157
#define type_it
Definition: def_const.h:363
void Errorline(char *format,...)
Definition: error.c:414
ptr_definition real
Definition: def_glob.h:102
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
push_psi_ptr_value
Definition: login.c:474
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
long v_func
Definition: def_glob.h:306
ptr_definition integer
Definition: def_glob.h:93
long u_func
Definition: def_glob.h:306
#define FALSE
Definition: def_const.h:128
#define deref(P)
Definition: def_macro.h:142
ptr_definition quoted_string
Definition: def_glob.h:101
struct wl_definition * ptr_definition
Definition: def_struct.h:31
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
#define equal_types(A, B)
Definition: def_macro.h:106
ptr_definition sys_bytedata
Definition: def_glob.h:336
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition cut
Definition: def_glob.h:83
#define type_disj
Definition: def_const.h:284
void warningline(char *format,...)
Definition: error.c:327
ptr_definition type
Definition: def_struct.h:165
GENERIC value_1
Definition: def_struct.h:54
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
void push_ptr_value(type_ptr t, GENERIC *p)
push_ptr_value
Definition: login.c:383
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
push_choice_point
Definition: login.c:638
long more_v_attr
Definition: def_glob.h:304
ptr_int_list next
Definition: def_struct.h:55
#define int_ptr
Definition: def_const.h:172
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)
matches
Definition: types.c:1666
#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
GENERIC unique_name ( )

unique_name

Make sure that the new variable name does not exist in the var_tree. (This situation should be rare.) Time to print a term is proportional to product of var_tree size and number of tags in the term. This may become large in pathological cases.

Definition at line 99 of file print.c.

References find(), heap_nice_name(), STRCMP, and var_tree.

100 {
101  GENERIC name_loc;
102 
103  do name_loc=(GENERIC)heap_nice_name();
104  while (find(STRCMP,(char *)name_loc,var_tree));
105 
106  return name_loc;
107 }
ptr_node var_tree
Definition: def_glob.h:26
#define STRCMP
Definition: def_const.h:255
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
unsigned long * GENERIC
Definition: def_struct.h:17
GENERIC unitListNext ( )

set unitListElement to NULL & return NULL

not sure purpose (DJD ???)

Definition at line 490 of file bi_sys.c.

References NULL, and unitListElement.

491 {
493  return NULL;
494 }
#define NULL
Definition: def_const.h:203
static GENERIC unitListElement
Definition: bi_sys.c:459
ptr_psi_term unitListValue ( )

make psi term from unitListElement

not sure purpose (DJD ???)

Definition at line 479 of file bi_sys.c.

References makePsiTerm(), and unitListElement.

480 {
481  return makePsiTerm((void *)unitListElement);
482 }
ptr_psi_term makePsiTerm(ptr_definition x)
Definition: bi_sys.c:572
static GENERIC unitListElement
Definition: bi_sys.c:459
ptr_definition update_feature ( ptr_module  module,
char *  feature 
)

update_feature

Parameters
ptr_modulemodule
char*feature

UPDATE_FEATURE(module,feature) Look up a FEATURE. May return NULL if the FEATURE is not visible from MODULE.

Definition at line 1331 of file modules.c.

References current_module, wl_keyword::definition, extract_module_from_name(), hash_lookup(), NULL, wl_keyword::private_feature, wl_module::symbol_table, and update_symbol().

1332 {
1333  ptr_keyword key;
1334  ptr_module explicit;
1335 
1336  /* Check if the feature already contains a module name */
1337 
1338  if(!module)
1339  module=current_module;
1340 
1341  explicit=extract_module_from_name(feature);
1342  if(explicit)
1343  if(explicit!=module)
1344  return NULL; /* Feature isn't visible */
1345  else
1346  return update_symbol(NULL,feature);
1347 
1348  /* Now we have a simple feature to look up */
1349  key=hash_lookup(module->symbol_table,feature);
1350  if(key && key->private_feature)
1351  return key->definition;
1352  else
1353  return update_symbol(module,feature);
1354 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
ptr_definition definition
Definition: def_struct.h:96
ptr_hash_table symbol_table
Definition: def_struct.h:79
#define NULL
Definition: def_const.h:203
ptr_module current_module
Definition: modules.c:15
ptr_definition update_symbol(ptr_module module, char *symbol)
update_symbol
Definition: modules.c:270
int private_feature
Definition: def_struct.h:95
ptr_module extract_module_from_name(char *str)
extract_module_from_name
Definition: modules.c:116
ptr_definition update_symbol ( ptr_module  module,
char *  symbol 
)

update_symbol

Parameters
ptr_modulemodule
char*symbol

UPDATE_SYMBOL(m,s) S is a string of characters encountered during parsing, M is the module it belongs too.

if M is NULL then extract the module name from S. If that fails then use the current module.

Then, retrieve the keyword for 'module::symbol'. Then find the correct definition by scanning the opened modules.

Definition at line 270 of file modules.c.

References wl_keyword::combined_name, current_module, wl_keyword::definition, error_psi_term, Errorline(), extract_module_from_name(), FALSE, hash_insert(), hash_lookup(), HEAP_ALLOC, heap_copy_string(), make_module_token(), wl_keyword::module, wl_module::module_name, new_definition(), wl_int_list::next, NULL, wl_module::open_modules, wl_keyword::private_feature, wl_keyword::public, strip_module_name(), wl_keyword::symbol, wl_module::symbol_table, wl_psi_term::type, wl_int_list::value_1, and warningline().

271 {
272  ptr_keyword key;
273  ptr_definition result=NULL;
274  ptr_int_list opens;
275  ptr_module opened;
276  ptr_keyword openkey;
277  ptr_keyword tempkey;
278 
279  /* First clean up the arguments and find out which module to use */
280 
281  if(!module) {
282  module=extract_module_from_name(symbol);
283  if(!module)
284  module=current_module;
285  symbol=strip_module_name(symbol);
286  }
287 
288  /* printf("looking up %s#%s\n",module->module_name,symbol); */
289 
290  /* Now look up 'module#symbol' in the symbol table */
291  key=hash_lookup(module->symbol_table,symbol);
292 
293  if(key)
294  if(key->public || module==current_module)
295  result=key->definition;
296  else {
297  Errorline("qualified call to private symbol '%s'\n",
298  key->combined_name);
299 
300  result=error_psi_term->type;
301  }
302  else
303  if(module!=current_module) {
304  Errorline("qualified call to undefined symbol '%s#%s'\n",
305  module->module_name,symbol);
306  result=error_psi_term->type;
307  }
308  else
309  {
310  /* Add 'module#symbol' to the symbol table */
311  key=HEAP_ALLOC(struct wl_keyword);
312  key->module=module;
313  key->symbol=(char *)heap_copy_string(symbol);
314  key->combined_name=heap_copy_string(make_module_token(module,symbol));
315  key->public=FALSE;
316  key->private_feature=FALSE; /* RM: Mar 11 1993 */
317  key->definition=NULL;
318 
319  hash_insert(module->symbol_table,key->symbol,key);
320 
321 
322  /* Search the open modules of 'module' for 'symbol' */
323  opens=module->open_modules;
324  openkey=NULL;
325  while(opens) {
326  opened=(ptr_module)(opens->value_1);
327  if(opened!=module) {
328 
329  tempkey=hash_lookup(opened->symbol_table,symbol);
330 
331  if(tempkey)
332  if(openkey && openkey->public && tempkey->public) {
333  if(openkey->definition==tempkey->definition) {
334  warningline("benign module name clash: %s and %s\n",
335  openkey->combined_name,
336  tempkey->combined_name);
337  }
338  else {
339  Errorline("serious module name clash: \"%s\" and \"%s\"\n",
340  openkey->combined_name,
341  tempkey->combined_name);
342 
343  result=error_psi_term->type;
344  }
345  }
346  else
347  if(!openkey || !openkey->public)
348  openkey=tempkey;
349  }
350 
351  opens=opens->next;
352  }
353 
354  if(!result) { /* RM: Feb 1 1993 */
355 
356  if(openkey && openkey->public) {
357  /* Found the symbol in an open module */
358 
359  if(!openkey->public)
360  warningline("implicit reference to non-public symbol: %s\n",
361  openkey->combined_name);
362 
363  result=openkey->definition;
364  key->definition=result;
365 
366  /*
367  printf("*** Aliasing %s#%s to %s#%s\n",
368  key->module->module_name,
369  key->symbol,
370  openkey->module->module_name,
371  openkey->symbol);
372  */
373 
374  }
375  else { /* Didn't find it */
376  result=new_definition(key);
377  }
378  }
379  }
380 
381  return result;
382 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
HASH_LOOKUP.
Definition: hash_table.c:131
char * combined_name
Definition: def_struct.h:92
ptr_definition new_definition(ptr_keyword key)
new_definition
Definition: modules.c:220
ptr_definition definition
Definition: def_struct.h:96
ptr_hash_table symbol_table
Definition: def_struct.h:79
#define NULL
Definition: def_const.h:203
ptr_module current_module
Definition: modules.c:15
char * symbol
Definition: def_struct.h:91
char * strip_module_name(char *str)
strip_module_name
Definition: modules.c:144
struct wl_module * ptr_module
Definition: def_struct.h:83
void Errorline(char *format,...)
Definition: error.c:414
char * heap_copy_string(char *s)
heap_copy_string
Definition: trees.c:172
void hash_insert(ptr_hash_table table, char *symbol, ptr_keyword keyword)
HASH_INSERT.
Definition: hash_table.c:151
ptr_psi_term error_psi_term
Definition: def_glob.h:23
#define FALSE
Definition: def_const.h:128
char * module_name
Definition: def_struct.h:75
ptr_int_list open_modules
Definition: def_struct.h:77
ptr_module module
Definition: def_struct.h:90
int private_feature
Definition: def_struct.h:95
ptr_module extract_module_from_name(char *str)
extract_module_from_name
Definition: modules.c:116
void warningline(char *format,...)
Definition: error.c:327
int public
Definition: def_struct.h:94
ptr_definition type
Definition: def_struct.h:165
GENERIC value_1
Definition: def_struct.h:54
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
char * make_module_token(ptr_module module, char *str)
make_module_token
Definition: modules.c:191
ptr_int_list next
Definition: def_struct.h:55
void vinfoline ( char *  format,
FILE *  outfile,
  ... 
)
long warning ( )

Definition at line 685 of file error.c.

References perr(), and warningflag.

686 {
687  if (warningflag) perr("*** Warning: ");
688  return warningflag;
689 }
long warningflag
Definition: error.c:16
void perr(char *str)
Definition: error.c:659
void warningline ( char *  format,
  ... 
)

Definition at line 327 of file error.c.

References assert, display_psi(), FALSE, input_file_name, parse_ok, perr_i(), perr_s(), print_code(), print_def_type(), print_operator_kind(), psi_term_line_number, quietflag, and warningflag.

328 {
329  va_list VarArg;
330  // int l;
331  char buffer_loc[5];
332  char *p;
333  unsigned long lng2;
334  char *cptr;
335  ptr_int_list pil;
336  ptr_psi_term psi;
337  operator kind;
338  def_type t ;
339 
340  va_start(VarArg,format);
341 
342  if (warningflag) { // macro would not work
343 
344 
345  if(quietflag) return; /* RM: Sep 24 1993 */
346  fprintf(stderr,"*** Warning: ");
347  // vinfoline(format, stderr, VarArg);
348  // #define vinfoline(format, stderr, xxxx) {
349  for (p=format;p && *p; p++)
350  {
351  if (*p == '%')
352  {
353  p++;
354  switch (*p)
355  {
356  case 'd':
357  case 'x':
358  buffer_loc[0] = '%';
359  buffer_loc[1] = 'l';
360  buffer_loc[2] = *p;
361  buffer_loc[3] = 0;
362  lng2 = va_arg(VarArg,long);
363  fprintf(stderr, buffer_loc, lng2);
364  break;
365  case 's':
366  buffer_loc[0] = '%';
367  buffer_loc[1] = *p;
368  buffer_loc[2] = 0;
369  cptr = va_arg(VarArg,char *);
370  fprintf(stderr, buffer_loc, cptr);
371  break;
372  case 'C':
373  /* type coding as bin string */
374  pil = va_arg(VarArg,ptr_int_list);
375  print_code(stderr,pil);
376  break;
377  case 'P':
378  psi = va_arg(VarArg,ptr_psi_term);
379  display_psi(stderr,psi);
380  break;
381  case 'O':
382  kind = va_arg(VarArg,operator);
383  print_operator_kind(stderr,kind);
384  break;
385  case 'T':
386  assert(stderr==stderr);
387  t = va_arg(VarArg,def_type);
388  print_def_type(t);
389  break;
390  case 'E':
391  assert(stderr==stderr);
392  perr_i("near line %ld",psi_term_line_number);
393  if (strcmp(input_file_name,"stdin")) {
394  perr_s(" in file 042%s042",input_file_name);
395  }
396  parse_ok=FALSE;
397  break;
398  case '%':
399  (void)putc(*p,stderr);
400  break;
401  default:
402  fprintf(stderr,"<%c follows %% : report bug >", *p);
403  break;
404  }
405  }
406  else
407  (void)putc(*p,stderr);
408  }
409  }
410  va_end(VarArg);
411 }
long warningflag
Definition: error.c:16
void perr_i(char *str, long i)
Definition: error.c:677
long psi_term_line_number
Definition: def_glob.h:268
string input_file_name
Definition: def_glob.h:40
void display_psi(FILE *s, ptr_psi_term t)
display_psi
Definition: print.c:1579
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
print_code
Definition: print.c:167
void print_def_type(def_type t)
print_def_type
Definition: types.c:24
#define FALSE
Definition: def_const.h:128
long quietflag
Definition: error.c:17
long parse_ok
Definition: def_glob.h:171
void print_operator_kind(FILE *s, long kind)
print_operator_kind
Definition: print.c:192
#define assert(N)
Definition: memory.c:113
long warningx ( )

Definition at line 692 of file error.c.

References perr(), and warningflag.

693 {
694  if (warningflag) perr("*** Warning");
695  return warningflag;
696 }
long warningflag
Definition: error.c:16
void perr(char *str)
Definition: error.c:659
int WFfeature_count_loop ( ptr_node  n)

WFfeature_count_loop.

Parameters
ptr_noden

Definition at line 336 of file lib.c.

References wl_node::left, and wl_node::right.

337 {
338  int result=0;
339 
340  if(n) {
341  if(n->left)
342  result+=WFfeature_count_loop(n->left);
343  result++;
344  if(n->right)
345  result+=WFfeature_count_loop(n->right);
346  }
347 
348  return result;
349 }
ptr_node left
Definition: def_struct.h:183
int WFfeature_count_loop(ptr_node n)
WFfeature_count_loop.
Definition: lib.c:336
ptr_node right
Definition: def_struct.h:184
int WFFeatureCount ( ptr_psi_term  psi)

WFFeatureCount.

Parameters
ptr_psi_termpsi

Definition at line 357 of file lib.c.

References wl_psi_term::attr_list, deref_ptr, and WFfeature_count_loop().

358 {
359  int result=0;
360 
361  if(psi) {
362  deref_ptr(psi);
363  result=WFfeature_count_loop(psi->attr_list);
364  }
365 
366  return result;
367 }
#define deref_ptr(P)
Definition: def_macro.h:95
int WFfeature_count_loop(ptr_node n)
WFfeature_count_loop.
Definition: lib.c:336
ptr_node attr_list
Definition: def_struct.h:171
char ** WFFeatures ( ptr_psi_term  psi)

WFFeatures.

Parameters
ptr_psi_termpsi

Definition at line 391 of file lib.c.

References wl_psi_term::attr_list, deref_ptr, group_features(), NULL, and WFfeature_count_loop().

392 {
393  char **features_loc=NULL;
394  int n;
395 
396  if(psi) {
397  deref_ptr(psi);
398 
400  if(n) {
401  features_loc=(char **)malloc((n+1)*sizeof(char *));
402  (void)group_features(features_loc,psi->attr_list);
403  }
404  }
405 
406  return features_loc;
407 }
#define NULL
Definition: def_const.h:203
#define deref_ptr(P)
Definition: def_macro.h:95
char ** group_features(char **f, ptr_node n)
group_features
Definition: lib.c:34
int WFfeature_count_loop(ptr_node n)
WFfeature_count_loop.
Definition: lib.c:336
ptr_node attr_list
Definition: def_struct.h:171
double WFGetDouble ( ptr_psi_term  psi,
int *  ok 
)

WFGetDouble.

Parameters
ptr_psi_termpsi
int*ok

Definition at line 416 of file lib.c.

References deref_ptr, FALSE, real, sub_type(), TRUE, wl_psi_term::type, and wl_psi_term::value_3.

417 {
418  double value=0.0;
419 
420  if(ok)
421  *ok=FALSE;
422 
423  if(psi) {
424  deref_ptr(psi);
425 
426  if(sub_type(psi->type,real) && psi->value_3) {
427  value= *((double *)psi->value_3);
428  if(ok)
429  *ok=TRUE;
430  }
431  }
432  return value;
433 }
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
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 FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
PsiTerm WFGetFeature ( ptr_psi_term  psi,
char *  feature 
)

WFGetFeature.

Parameters
ptr_psi_termpsi
char*feature

Definition at line 468 of file lib.c.

References wl_psi_term::attr_list, wl_node::data, deref_ptr, FEATCMP, find(), and NULL.

469 {
470  ptr_psi_term result=NULL;
471  ptr_node n;
472 
473  if(psi && feature) {
474  deref_ptr(psi);
475  n=find(FEATCMP,feature,psi->attr_list);
476  if(n)
477  result=(PsiTerm)n->data;
478  }
479 
480  return result;
481 }
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
void * PsiTerm
Definition: def_struct.h:4
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
ptr_node attr_list
Definition: def_struct.h:171
char * WFGetString ( ptr_psi_term  psi,
int *  ok 
)

WFGetString.

Parameters
ptr_psi_termpsi
int*ok

Definition at line 442 of file lib.c.

References deref_ptr, FALSE, NULL, quoted_string, sub_type(), TRUE, wl_psi_term::type, and wl_psi_term::value_3.

443 {
444  char *value=NULL;
445 
446  if(ok)
447  *ok=FALSE;
448 
449  if(psi) {
450  deref_ptr(psi);
451 
452  if(sub_type(psi->type,quoted_string) && psi->value_3) {
453  value=(char *)psi->value_3;
454  if(ok)
455  *ok=TRUE;
456  }
457  }
458  return value;
459 }
#define NULL
Definition: def_const.h:203
long sub_type(ptr_definition t1, ptr_definition t2)
sub_type
Definition: types.c:1642
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#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_definition type
Definition: def_struct.h:165
PsiTerm WFGetVar ( char *  name)

WFGetVar.

Parameters
char*name

Definition at line 315 of file lib.c.

References wl_node::data, deref_ptr, find(), NULL, STRCMP, and var_tree.

316 {
317  ptr_psi_term result=NULL;
318  ptr_node n;
319 
321  if(n) {
322  result=(ptr_psi_term)n->data;
323  if(result)
324  deref_ptr(result);
325  }
326 
327  return result;
328 }
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node var_tree
Definition: def_glob.h:26
#define deref_ptr(P)
Definition: def_macro.h:95
char * name
Definition: def_glob.h:325
#define STRCMP
Definition: def_const.h:255
ptr_node find(long comp, char *keystr, ptr_node tree)
find
Definition: trees.c:394
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void WFInit ( long  argc,
char **  argv 
)
int WFInput ( char *  query)

WFInput.

Parameters
char*query

Definition at line 226 of file lib.c.

References wl_goal::aaaa_1, assert_clause(), assert_first, assert_ok, c_query_level, c_what_next, choice_stack, DEFRULES, encode_types(), FACT, fail, FALSE, goal_count, goal_stack, ignore_eff, init_parse_state(), main_prove(), wl_goal::next, NULL, parse(), prove, push_choice_point(), push_goal(), QUERY, reset_stacks(), save_parse_state(), stack_copy_psi_term(), start_chrono(), stringinput, stringparse, TRUE, wl_goal::type, undo(), undo_stack, var_occurred, WFmore, WFno, and WFyes.

227 {
228  ptr_psi_term t;
229  long sort;
230  parse_block pb;
231  int result=WFno;
232  ptr_stack save_undo_stack;
233  ptr_choice_point old_choice;
234 
235 
236  save_undo_stack=undo_stack;
237  old_choice=choice_stack;
238 
239 
240  if(!strcmp(query,".")) {
241  reset_stacks();
242  result=WFyes;
243  c_query_level=0;
244  }
245  else {
246  if(!strcmp(query,";")) {
247  sort=QUERY;
249  }
250  else {
251  /* Parse the string in its own state */
252  save_parse_state(&pb);
255  stringinput=query;
256 
257  /* old_var_occurred=var_occurred; */
259  t=stack_copy_psi_term(parse(&sort));
260 
261  /* Main loop of interpreter */
262  if(sort==QUERY) {
264  goal_count=0;
265 
267  c_query_level++;
270  /* reset_step(); */
271  }
272  else if (sort==FACT) {
274  assert_clause(t);
275  if(assert_ok)
276  result=WFyes;
277  undo(save_undo_stack);
279  encode_types();
280  }
281  }
282 
283  if(sort==QUERY) {
284  start_chrono();
285  main_prove();
286 
288 
289  if((long)(goal_stack->aaaa_1)==c_query_level)
290  if(choice_stack==old_choice) {
291  result=WFyes;
292  c_query_level--;
293  }
294  else
295  result=WFmore;
296  else {
297  result=WFno;
298  c_query_level--;
299  }
300 
302  }
303  }
304  }
305 
306  return result;
307 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void undo(ptr_stack limit)
undo
Definition: login.c:691
long assert_first
Definition: def_glob.h:58
ptr_goal goal_stack
Definition: def_glob.h:50
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
psi_term parse(long *q)
parse
Definition: parser.c:907
void save_parse_state(ptr_parse_block pb)
save_parse_state
Definition: token.c:425
#define DEFRULES
Definition: def_const.h:138
#define WFmore
Definition: def_const.h:19
#define FACT
Definition: def_const.h:151
#define NULL
Definition: def_const.h:203
#define WFno
Definition: def_const.h:13
long ignore_eff
Definition: def_glob.h:151
#define QUERY
Definition: def_const.h:152
#define WFyes
Definition: def_const.h:16
#define c_what_next
Definition: def_const.h:289
long assert_ok
Definition: def_glob.h:59
ptr_stack undo_stack
Definition: def_glob.h:53
long goal_count
Definition: def_glob.h:152
goals type
Definition: def_struct.h:223
#define TRUE
Definition: def_const.h:127
void start_chrono()
start_chrono
Definition: login.c:349
#define FALSE
Definition: def_const.h:128
long var_occurred
Definition: def_glob.h:189
#define fail
Definition: def_const.h:272
void init_parse_state()
init_parse_state
Definition: token.c:464
void reset_stacks()
reset_stacks
Definition: login.c:2047
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
void encode_types()
encode_types
Definition: types.c:1091
void main_prove()
main_prove
Definition: login.c:2335
long c_query_level
Definition: def_glob.h:289
long stringparse
Definition: def_glob.h:202
char * stringinput
Definition: def_glob.h:203
void assert_clause(ptr_psi_term t)
assert_clause
Definition: login.c:287
ptr_choice_point choice_stack
Definition: def_glob.h:51
ptr_goal next
Definition: def_struct.h:227
char * WFType ( ptr_psi_term  psi)

WFType.

Parameters
ptr_psi_termpsi

Definition at line 375 of file lib.c.

References wl_keyword::combined_name, deref_ptr, wl_definition::keyword, NULL, and wl_psi_term::type.

376 {
377  char *result=NULL;
378  if(psi) {
379  deref_ptr(psi);
380  result=psi->type->keyword->combined_name;
381  }
382  return result;
383 }
char * combined_name
Definition: def_struct.h:92
ptr_keyword keyword
Definition: def_struct.h:124
#define NULL
Definition: def_const.h:203
#define deref_ptr(P)
Definition: def_macro.h:95
ptr_definition type
Definition: def_struct.h:165
long what_next_aim ( )

what_next_aim

WHAT_NEXT_AIM() Find out what the user wants to do: a) retry current goal -> ';' b) quit current goal -> RETURN c) add current goal -> 'new goal ?' d) return to top level -> '.'

Definition at line 2068 of file login.c.

References wl_goal::aaaa_1, aborthooksym, aim, assert_clause(), assert_first, wl_goal::bbbb_1, begin_terminal_io(), wl_goal::cccc_1, current_module, DEFRULES, encode_types(), end_terminal_io(), eof, EOLN, FACT, FALSE, function_it, infoline(), MAX_LEVEL, wl_module::module_name, no_choices(), NOTQUIET, NULL, parse(), print_variables(), prompt, PROMPT, prompt_buffer, prove, push_choice_point(), push_goal(), put_back_char(), QUERY, read_char(), release_resid(), reset_stacks(), reset_step(), show_count(), stack_copy_psi_term(), start_chrono(), stdin_cleareof(), TRUE, TRUEMASK, wl_psi_term::type, wl_definition::type_def, undo(), undo_stack, user_module, var_occurred, what_next, what_next_cut(), x_window_creation, and xevent_existing.

2069 {
2070  long result=FALSE;
2071  ptr_psi_term s;
2072  long c, c2; /* 21.12 (prev. char) */
2073  char *pr;
2074  long sort,cut_loc=FALSE;
2075  long level,i;
2076  long eventflag;
2077  ptr_stack save_undo_stack;
2078  long lev1,lev2;
2080 
2081  level=((unsigned long)aim->cccc_1);
2082 
2083  if (aim->aaaa_1) {
2084  /* Must remember var_occurred from the what_next goal and from */
2085  /* execution of previous query (it may have contained a parse) */
2086  var_occurred=var_occurred || ((unsigned long)aim->bbbb_1)&TRUEMASK; /* 18.8 */
2087  eventflag=(((unsigned long)aim->bbbb_1)&(TRUEMASK*2))!=0;
2088  if (
2089  !var_occurred && no_choices() && level>0
2090 #ifdef X11
2091  /* Keep level same if no window & no X event */
2092  && !x_window_creation && !eventflag
2093 #endif
2094  ) {
2095  /* Keep level the same if in a query, the number of choice points */
2096  /* has not increased and there are no variables. */
2097  /* This has to have the same behavior as if an EOLN was typed */
2098  /* and no 'No' message should be given on the lowest level, */
2099  level--;
2100  (void)what_next_cut();
2101  if (level==0) { result=TRUE; }
2102  }
2103  }
2104 
2105 #ifdef X11
2107 #endif
2108 
2109  infoline(aim->aaaa_1?"\n*** Yes":"\n*** No");
2110  show_count();
2111  if (aim->aaaa_1 || level>0 ) (void)print_variables(NOTQUIET); // had commente || ... DJD
2112 
2113  {
2114  if (level > 0 && aborthooksym->type_def != (def_type)function_it )
2115  {
2116  lev1=MAX_LEVEL<level?MAX_LEVEL:(level);
2117  lev2=level;
2118  }
2119  else
2120  {
2121  lev1 = 0;
2122  lev2 = 0;
2123  }
2124 
2125  pr=prompt_buffer;
2126  /* RM: Oct 13 1993 */
2128  *pr='\0';
2129  else
2130  strcpy(pr,current_module->module_name);
2131  pr += strlen(pr);
2132  for(i=1;i<=lev1;i++) { *pr='-'; pr++; *pr='-'; pr++; }
2133  if (lev2>0)
2134  sprintf(pr,"%ld",lev2);
2135  strcat(pr,PROMPT);
2136 
2138  }
2139 
2140  stdin_cleareof();
2141  /* The system waits for either an input command or an X event. */
2142  /* An X event is treated *exactly* like an input command that */
2143  /* has the same effect. */
2144 #ifdef X11
2145  c=x_read_stdin_or_event(&eventflag);
2146  if (eventflag) {
2147  /* Include eventflag info in var_occurred field. */
2148  push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)(FALSE+2*TRUE),(GENERIC)level /* +1 RM: Jun 22 1993 */);
2150  result=TRUE;
2151  }
2152  else
2153 #else
2154  c=read_char();
2155 #endif
2156  {
2157  while (c!=EOLN && c>0 && c<=32 && c!=EOF) {
2158  c=read_char();
2159  }
2160  if (c==EOF) {
2161  reset_stacks();
2162  }
2163  else if (c==EOLN) {
2164  cut_loc=TRUE;
2165  }
2166  else if (c==';' || c=='.') {
2167  do {
2168  c2=read_char();
2169  } while (c2!=EOLN && c2!=EOF && c2>0 && c2<=32);
2170  if (c=='.') { /* 6.10 */
2171  reset_stacks();
2172  result=TRUE;
2173  }
2174  }
2175  else {
2177 
2178  put_back_char(c);
2180  save_undo_stack=undo_stack;
2181  s=stack_copy_psi_term(parse(&sort));
2182 
2183  if (s->type==eof) {
2184  reset_stacks();
2185  put_back_char(EOF);
2186  } else if (sort==QUERY) {
2189  reset_step();
2190  result=TRUE;
2191  }
2192  else if (sort==FACT) { /* A declaration */
2193  push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)FALSE,(GENERIC)(level + 1)); /* 18.5 */ // HERE
2195  assert_clause(s);
2196  /* Variables in the query may be used in a declaration, */
2197  /* but the declaration may not add any variables. */
2198  undo(save_undo_stack); /* 17.8 */
2199  encode_types();
2200  result=TRUE;
2201  }
2202  else {
2203  /* Stay at same level on syntax error */
2204  push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)FALSE,(GENERIC)(level+1)); /* 20.8 */
2205  result=TRUE; /* 20.8 */
2206  }
2207  }
2208  }
2209 
2210  if (cut_loc) result = what_next_cut() || result;
2211 
2212  end_terminal_io();
2213 
2214  var_occurred=FALSE;
2215  start_chrono();
2216 
2217  return result;
2218 }
void assert_clause(ptr_psi_term t)
assert_clause
Definition: login.c:287
#define prove
Definition: def_const.h:273
long what_next_cut()
what_next_cut
Definition: login.c:1987
void reset_stacks()
reset_stacks
Definition: login.c:2047
ptr_psi_term aaaa_1
Definition: def_struct.h:224
#define function_it
Definition: def_const.h:362
long assert_first
Definition: def_glob.h:58
void put_back_char(long c)
put_back_char
Definition: token.c:729
void show_count()
show_count
Definition: login.c:1161
ptr_module current_module
Definition: def_glob.h:161
#define NOTQUIET
Definition: def_macro.h:10
psi_term parse(long *q)
parse
Definition: parser.c:907
char prompt_buffer[PROMPT_BUFFER]
Definition: def_glob.h:237
#define TRUEMASK
Definition: def_const.h:129
void undo(ptr_stack limit)
undo
Definition: login.c:691
void reset_step()
Definition: error.c:596
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
push_goal
Definition: login.c:600
GENERIC cccc_1
Definition: def_struct.h:226
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 FACT
Definition: def_const.h:151
ptr_module user_module
Definition: def_glob.h:156
#define NULL
Definition: def_const.h:203
#define PROMPT
Definition: def_const.h:109
#define QUERY
Definition: def_const.h:152
long x_window_creation
Definition: def_glob.h:217
void release_resid(ptr_psi_term t)
release_resid
Definition: lefun.c:445
ptr_stack undo_stack
Definition: def_glob.h:53
#define EOLN
Definition: def_const.h:140
#define MAX_LEVEL
Definition: def_const.h:113
void end_terminal_io()
end_terminal_io
Definition: token.c:516
void infoline(char *format,...)
Definition: error.c:245
void begin_terminal_io()
begin_terminal_io
Definition: token.c:493
ptr_definition eof
Definition: def_glob.h:86
#define TRUE
Definition: def_const.h:127
#define what_next
Definition: def_const.h:277
#define FALSE
Definition: def_const.h:128
long var_occurred
Definition: def_glob.h:189
ptr_goal aim
Definition: def_glob.h:49
char * module_name
Definition: def_struct.h:75
ptr_psi_term stack_copy_psi_term(psi_term t)
stack_copy_psi_term
Definition: parser.c:205
void encode_types()
encode_types
Definition: types.c:1091
void start_chrono()
start_chrono
Definition: login.c:349
char * prompt
Definition: def_glob.h:42
long print_variables(long printflag)
print_variables
Definition: print.c:1368
long read_char()
read_char
Definition: token.c:680
long no_choices()
no_choices
Definition: login.c:1945
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
void stdin_cleareof()
stdin_cleareof
Definition: token.c:51
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_psi_term xevent_existing
Definition: def_glob.h:208
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
push_choice_point
Definition: login.c:638
long what_next_cut ( )

what_next_cut

Cut away up to and including the first 'what_next' choice point.

Definition at line 1987 of file login.c.

References backtrack(), choice_stack, FALSE, goal_stack, NULL, TRUE, wl_goal::type, undo(), and what_next.

1988 {
1989  long flag=TRUE;
1990  long result=FALSE;
1991 
1992  do {
1993  if (choice_stack) {
1994  backtrack();
1995  if (goal_stack->type==what_next) {
1996  flag=FALSE;
1997  result=TRUE;
1998  }
1999  }
2000  else {
2001  /* This undo does the last undo actions before returning to top level. */
2002  /* It is not needed for variable undoing, but for actions (like */
2003  /* closing windows). */
2004  undo(NULL);
2005  /* undo(mem_base); 7.8 */
2006 #ifdef TS
2007  /* global_time_stamp=INIT_TIME_STAMP; */ /* 9.6 */
2008 #endif
2009  flag=FALSE;
2010  }
2011  } while (flag);
2012 
2013  return result;
2014 }
ptr_goal goal_stack
Definition: def_glob.h:50
void undo(ptr_stack limit)
undo
Definition: login.c:691
#define NULL
Definition: def_const.h:203
goals type
Definition: def_struct.h:223
#define TRUE
Definition: def_const.h:127
#define what_next
Definition: def_const.h:277
#define FALSE
Definition: def_const.h:128
void backtrack()
backtrack
Definition: login.c:772
ptr_choice_point choice_stack
Definition: def_glob.h:51
void work_out_length ( )

work_out_length

WORK_OUT_LENGTH() Calculate the number of blanks before each tabulation. Insert line feeds until it all fits into PAGE_WIDTH columns. This is done by a trial and error mechanism.

Definition at line 626 of file print.c.

References wl_tab_brk::broken, wl_tab_brk::column, FALSE, indx, NULL, page_width, wl_tab_brk::printed, wl_item::str, strpos(), wl_item::tab, and TRUE.

627 {
628  ptr_item i;
629  long done=FALSE;
630  long pos;
631  ptr_tab_brk worst,root;
632  long w;
633 
634  while(!done) {
635 
636  pos=0;
637  done=TRUE;
638 
639  w= -1;
640  worst=NULL;
641  root=NULL;
642 
643  for(i=pretty_things+1;(unsigned long)i<(unsigned long)indx;i++) {
644 
645  if(i->tab->broken && i->tab->printed) {
646  pos=i->tab->column;
647  root=NULL;
648  }
649 
650  if(!i->tab->printed) i->tab->column=pos;
651 
652  if(!(i->tab->broken))
653  if(!root || (root && (root->column)>=(i->tab->column)))
654  root=i->tab;
655 
656  /* pos=pos+strlen(i->str); */
657  pos=strpos(pos,i->str);
658  i->tab->printed=TRUE;
659 
660  if(pos>page_width)
661  done=FALSE;
662 
663  if(pos>w) {
664  w=pos;
665  worst=root;
666  }
667  }
668 
669  for(i=pretty_things+1;(unsigned long)i<(unsigned long)indx;i++)
670  i->tab->printed=FALSE;
671 
672  if(!done)
673  if(worst)
674  worst->broken=TRUE;
675  else
676  done=TRUE;
677  }
678 }
long printed
Definition: def_struct.h:307
long column
Definition: def_struct.h:305
ptr_tab_brk tab
Definition: def_struct.h:312
char * str
Definition: def_struct.h:311
#define NULL
Definition: def_const.h:203
long broken
Definition: def_struct.h:306
#define TRUE
Definition: def_const.h:127
ptr_item indx
Definition: def_glob.h:329
#define FALSE
Definition: def_const.h:128
void write_attributes ( ptr_node  n,
ptr_tab_brk  tab 
)

write_attributes

Parameters
ptr_noden
ptr_tab_brktab

WRITE_ATTRIBUTES(n) Used by all versions of the built-in predicate write, and by the built-in predicate listing.

Definition at line 1419 of file print.c.

References wl_node::data, wl_node::left, mark_tab(), MAX_PRECEDENCE, pretty_tag_or_psi_term(), and wl_node::right.

1420 {
1421  if(n) {
1422  write_attributes(n->left,tab);
1423  mark_tab(tab);
1425  write_attributes(n->right,tab);
1426  }
1427 }
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define MAX_PRECEDENCE
Definition: def_const.h:103
ptr_node right
Definition: def_struct.h:184
long yes_or_no ( )

yes_or_no

Confirm an important change

Definition at line 50 of file types.c.

References EOLN, input_state, open_input_file(), perr(), prompt, read_char(), and restore_state().

51 {
52  char *old_prompt;
53  long c,d;
54  ptr_psi_term old_state_loc;
55 
56  perr("*** Are you really sure you want to do that ");
57  old_prompt=prompt;
58  prompt="(y/n)?";
59  old_state_loc=input_state;
60  (void)open_input_file("stdin");
61 
62  do {
63  do {
64  c=read_char();
65  } while (c!=EOLN && c>0 && c<=32);
66  } while (c!='y' && c!='n');
67 
68  d=c;
69  while (d!=EOLN && d!=EOF) d=read_char();
70 
71  prompt=old_prompt;
72  input_state=old_state_loc;
73  restore_state(old_state_loc);
74  return (c=='y');
75 }
void perr(char *str)
Definition: error.c:659
ptr_psi_term input_state
Definition: def_glob.h:199
#define EOLN
Definition: def_const.h:140
void restore_state(ptr_psi_term t)
restore_state
Definition: token.c:334
char * prompt
Definition: def_glob.h:42
long read_char()
read_char
Definition: token.c:680
long open_input_file(char *file)
open_input_file
Definition: token.c:594