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

Function Documentation

long abort_life ( int  nlflag)

Definition at line 2124 of file built_ins.c.

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

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

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

152 {
153  psi_term succ;
154  ptr_psi_term head2;
155  ptr_definition def;
156  ptr_pair_list p, *p2;
157 
158  if (!body && typ==(def_type)predicate) {
159  succ.type=succeed;
160  succ.value_3=NULL;
161  succ.coref=NULL;
162  succ.resid=NULL;
163  succ.attr_list=NULL;
164  body= ≻
165  }
166 
167  deref_ptr(head);
168  head2=head;
169 
170  /* assert(head->resid==NULL); 10.8 */
171  /* assert(body->resid==NULL); 10.8 */
172 
173  if (redefine(head)) {
174 
175  def=head->type;
176 
177  if (def->type_def==(def_type)undef || def->type_def==typ)
178 
179  /* RM: Jan 27 1993 */
180  if(TRUE
181  /* def->type==undef ||
182  def->keyword->module==current_module */
183  /* RM: Feb 2 1993 Commented out */
184  ) {
185  if (def->rule && (unsigned long)def->rule<=MAX_BUILT_INS) {
186  Errorline("the built-in %T '%s' may not be redefined.\n",
187  def->type_def, def->keyword->symbol);
188  }
189  else {
190  def->type_def=typ;
191 
192  /* PVR single allocation in source */
194  clear_copy();
195  /* p->aaaa_3=exact_copy(head2,HEAP); 24.8 25.8 */
196  /* p->bbbb_3=exact_copy(body,HEAP); 24.8 25.8 */
197 
198  p->aaaa_2=quote_copy(head2,HEAP); /* 24.8 25.8 */
199  p->bbbb_2=quote_copy(body,HEAP); /* 24.8 25.8 */
200 
201  if (assert_first) {
202  p->next=def->rule;
203  def->rule=p;
204  }
205  else {
206  p->next=NULL;
207  p2= &(def->rule);
208  while (*p2) {
209  p2= &((*p2)->next);
210  }
211  *p2=p;
212  }
213  assert_ok=TRUE;
214  }
215  }
216  else { /* RM: Jan 27 1993 */
217  Errorline("the %T '%s' may not be redefined from within module %s.\n",
218  def->type_def,
219  def->keyword->combined_name,
221  }
222  else {
223  Errorline("the %T '%s' may not be redefined as a %T.\n",
224  def->type_def, def->keyword->symbol, typ);
225  }
226  }
227 }
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()
Definition: copy.c:52
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)
Definition: types.c:91
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)
Definition: copy.c:200
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_pair_list rule
Definition: def_struct.h:126
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 ( )

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

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

Definition at line 716 of file types.c.

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

718 {
719  ptr_definition d;
720 
721  for(d=first_definition;d;d=d->next)
722  if (d->type_def==(def_type)type_it && d!=nothing)
724 }
def_type type_def
Definition: def_struct.h:133
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
#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)

Definition at line 397 of file print.c.

References FALSE, SYMBOL, and TRUE.

399 {
400  while (*s) {
401  if (!SYMBOL(*s)) return FALSE;
402  s++;
403  }
404  return TRUE;
405 }
#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 
)

Definition at line 5211 of file built_ins.c.

References Errorline(), FALSE, and TRUE.

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

Definition at line 434 of file lefun.c.

References push_ptr_value(), and resid_ptr.

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

Definition at line 28 of file lub.c.

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

31 {
32  while (more)
33  {
34  tail->next = STACK_ALLOC(int_list);
35  tail= tail->next;
36  tail->value_1 = more->value_1;
37  tail->next = NULL;
38  more = more->next;
39  }
40  return tail;
41 }
#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)

Definition at line 273 of file types.c.

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

275 {
276  ptr_psi_term t;
277 
278  if (n) {
280 
281  t=(ptr_psi_term)n->data;
282  deref_ptr(t);
283  if (t->type) {
284  if (t->type->type_def==(def_type)type_it) {
285  warningline("'%s' is a sort--only functions and predicates\
286  can have unevaluated arguments.\n",t->type->keyword->symbol);
287  }
288  else
290  }
291 
293  }
294 }
char evaluate_args
Definition: def_struct.h:136
void assert_args_not_eval(ptr_node n)
Definition: types.c:273
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)

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

470 {
471  ptr_psi_term arg1,arg2,pred=NULL,typ;
472  ptr_definition d;
473 
474  get_two_args(t->attr_list,&arg1,&arg2);
475 
476  if (arg1) {
477  typ=arg1;
478  deref_ptr(arg1);
479  if (!strcmp(arg1->type->keyword->symbol,"|")) {
480  get_two_args(arg1->attr_list,&arg1,&pred);
481  if (arg1) {
482  typ=arg1;
483  deref_ptr(arg1);
484  }
485  }
486 
487  if (arg1 && wl_const_3(*arg1)) {
488  /* if (!redefine(arg1)) return; RM: Feb 19 1993 */
489  d=arg1->type;
491  Errorline("the %T '%s' may not be redefined as a sort.\n",
492  d->type_def, d->keyword->symbol);
493  }
494  else {
497  add_rule(typ,pred,(def_type)type_it);
498  }
499  }
500  else {
501  Errorline("bad argument in sort declaration '%P' (%E).\n",t);
502  }
503  }
504  else {
505  Errorline("argument missing in sort declaration (%E).\n");
506  }
507 }
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
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)
Definition: login.c:148
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
void assert_clause ( ptr_psi_term  t)

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

269 {
270  // ptr_psi_term arg1,arg2;
271  // char *str;
272 
273  assert_ok=FALSE;
274  deref_ptr(t);
275 
276  /* RM: Feb 22 1993 defined c_alias in modules.c
277  if (equ_tok((*t),"alias")) {
278  get_two_args(t->attr_list,&arg1,&arg2);
279  if (arg1 && arg2) {
280  warningline("'%s' has taken the meaning of '%s'.\n",
281  arg2->type->keyword->symbol, arg1->type->keyword->symbol);
282  str=arg2->type->keyword->symbol;
283  assert_ok=TRUE;
284  deref_ptr(arg1);
285  deref_ptr(arg2);
286  *(arg2->type)= *(arg1->type);
287  arg2->type->keyword->symbol=str;
288  }
289  else
290  Errorline("arguments missing in %P.\n",t);
291  }
292  else
293  */
294 
295  if (equ_tok((*t),":-"))
297  else
298  if (equ_tok((*t),"->"))
300  else
301  if (equ_tok((*t),"::"))
303  else
304 
305 #ifdef CLIFE
306  if (equ_tok((*t),"block_struct"))
307  define_block(t);
308  else
309 #endif /* CLIFE */
310  /* if (equ_tok((*t),"<<<-")) { RM: Feb 10 1993
311  declare T as global. To do... maybe.
312  }
313  else
314  */
315 
316  if (equ_tok((*t),"<|") || equ_tok((*t),":="))
318  else
320 
321  /* if (!assert_ok && warning()) perr("the declaration is ignored.\n"); */
322 }
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
void assert_rule(psi_term t, def_type typ)
Definition: login.c:237
void assert_complicated_type(ptr_psi_term t)
Definition: types.c:375
#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)
Definition: types.c:468
void add_rule(ptr_psi_term head, ptr_psi_term body, def_type typ)
Definition: login.c:148
#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)

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

377 {
378  ptr_psi_term arg2,typ1,typ2,pred=NULL;
379  // ptr_list lst;
380  long eqflag = equ_tok((*t),":=");
381  long ok, any_ok=FALSE;
382 
383  get_two_args(t->attr_list,&typ1,&arg2);
384 
385  if (typ1 && arg2) {
386  deref_ptr(typ1);
387  deref_ptr(arg2);
388  typ2=arg2;
389  if (!strcmp(arg2->type->keyword->symbol,"|")) {
390  typ2=NULL;
391  get_two_args(arg2->attr_list,&arg2,&pred);
392  if (arg2) {
393  deref_ptr(arg2);
394  typ2=arg2;
395  }
396  }
397  if (typ2) {
398  if (typ2->type==disjunction) {
399 
400  if (typ1->attr_list && eqflag) {
401  warningline("attributes ignored left of ':=' declaration (%E).\n");
402  }
403  while(typ2 && typ2->type!=nil) {
404  get_two_args(typ2->attr_list,&arg2,&typ2); /* RM: Dec 14 1992 */
405  if(typ2)
406  deref_ptr(typ2);
407  if (arg2) {
408  deref_ptr(arg2);
409  if (eqflag) {
410  ok=assert_less(arg2,typ1);
411  if (ok) any_ok=TRUE;
412  if (ok && (arg2->attr_list || pred!=NULL)) {
413  add_rule(arg2,pred,(def_type)type_it);
414  }
415  }
416  else {
417  ok=assert_less(typ1,arg2);
418  if (ok) any_ok=TRUE;
419  if (ok && arg2->attr_list) {
420  warningline("attributes ignored in sort declaration (%E).\n");
421  }
422  }
423  }
424  }
425  assert_ok=TRUE;
426  }
427  else if (eqflag) {
428  if (typ1->attr_list) {
429  warningline("attributes ignored left of ':=' declaration (%E).\n");
430  }
431  ok=assert_less(typ1,typ2);
432  if (ok) any_ok=TRUE;
433  typ2->type=typ1->type;
434  if (ok && (typ2->attr_list || pred!=NULL))
435  add_rule(typ2,pred,(def_type)type_it);
436  else
437  assert_ok=TRUE;
438  }
439  else {
440  if (typ2->attr_list) {
441  warningline("attributes ignored right of '<|' declaration (%E).\n");
442  }
443  ok=assert_less(typ1,typ2);
444  if (ok) any_ok=TRUE;
445  if (ok && (typ1->attr_list || pred!=NULL))
446  add_rule(typ1,pred,(def_type)type_it);
447  else
448  assert_ok=TRUE;
449  }
450  }
451  else {
452  Errorline("argument missing in sort declaration (%E).\n");
453  }
454  }
455  else {
456  Errorline("argument missing in sort declaration (%E).\n");
457  }
458  if (!any_ok) assert_ok=FALSE;
459 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long assert_less(ptr_psi_term t1, ptr_psi_term t2)
Definition: types.c:183
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)
Definition: login.c:148
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)

Definition at line 303 of file types.c.

References wl_definition::always_check, deref_ptr, FALSE, and wl_psi_term::type.

305 {
306  if (n) {
307  ptr_psi_term t;
309 
310  t=(ptr_psi_term)n->data;
311  deref_ptr(t);
312  if (t->type) {
313  t->type->always_check=FALSE;
314  }
315 
317  }
318 }
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)
Definition: types.c:303
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 
)

Definition at line 183 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_definition::type_def, type_it, and types_modified.

185 {
186  ptr_definition d1,d2;
187  long ok=FALSE;
188  deref_ptr(t1);
189  deref_ptr(t2);
190 
191  if (t1->type==top) {
192  Errorline("the top sort '@' may not be a subsort.\n");
193  return FALSE;
194  }
195  if (t1->value_3 || t2->value_3) {
196  Errorline("the declaration '%P <| %P' is illegal.\n",t1,t2);
197  return FALSE;
198  }
199  /* Note: A *full* cyclicity check of the hierarchy is done in encode_types. */
200  if (t1->type==t2->type) {
201  Errorline("cyclic sort declarations are not allowed.\n");
202  return FALSE;
203  }
204 
205  if (!redefine(t1)) return FALSE;
206  if (!redefine(t2)) return FALSE;
207  d1=t1->type;
208  d2=t2->type;
210  Errorline("the %T '%s' may not be redefined as a sort.\n",
211  d1->type_def, d1->keyword->symbol);
212  }
213  else if (d2->type_def==(def_type)predicate || d2->type_def==(def_type)function_it) {
214  Errorline("the %T '%s' may not be redefined as a sort.\n",
215  d2->type_def, d2->keyword->symbol);
216  }
217  else {
221  make_type_link(d1, d2); /* 1.7 */
222  /* d1->parents=cons(d2,d1->parents); */
223  /* d2->children=cons(d1,d2->children); */
224  ok=TRUE;
225  }
226 
227  return ok;
228 }
#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)
Definition: types.c:91
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)
Definition: types.c:848
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 
)

Definition at line 235 of file types.c.

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

238 {
239  ptr_psi_term t;
240 
241  if (n) {
242  assert_protected(n->left,prot);
243 
244  t=(ptr_psi_term)n->data;
245  deref_ptr(t);
246  if (t->type) {
247  if (t->type->type_def==(def_type)type_it) {
248  warningline("'%s' is a sort. It can be extended without a declaration.\n",
249  t->type->keyword->symbol);
250  }
251  else if ((unsigned long)t->type->rule<MAX_BUILT_INS &&
252  (unsigned long)t->type->rule>0) {
253  if (!prot)
254  warningline("'%s' is a built-in--it has not been made dynamic.\n",
255  t->type->keyword->symbol);
256  }
257  else {
258  t->type->protected=prot;
259  if (prot) t->type->date&=(~1); else t->type->date|=1;
260  }
261  }
262 
263  assert_protected(n->right,prot);
264  }
265 }
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)
Definition: types.c:235
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 
)

Definition at line 237 of file login.c.

References add_rule(), get_two_args(), and Syntaxerrorline().

240 {
241  ptr_psi_term head;
242  ptr_psi_term body;
243 
244  get_two_args(t.attr_list,&head,&body);
245  if (head)
246  if (body)
247  add_rule(head,body,typ);
248  else {
249  Syntaxerrorline("body missing in definition of %T '%P'.\n", typ, head);
250  }
251  else {
252  Syntaxerrorline("head missing in definition of %T.\n",typ);
253  }
254 }
void Syntaxerrorline(char *format,...)
Definition: error.c:498
void add_rule(ptr_psi_term head, ptr_psi_term body, def_type typ)
Definition: login.c:148
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
ptr_node attr_list
Definition: def_struct.h:171
void assert_type ( ptr_psi_term  t)

Definition at line 345 of file types.c.

References assert_less(), assert_ok, Errorline(), get_two_args(), and NULL.

347 {
348  ptr_psi_term arg1,arg2;
349 
350  get_two_args(t->attr_list,&arg1,&arg2);
351  if(arg1==NULL || arg2==NULL) {
352  Errorline("bad sort declaration '%P' (%E).\n",t);
353  }
354  else
355  assert_ok=assert_less(arg1,arg2);
356 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long assert_less(ptr_psi_term t1, ptr_psi_term t2)
Definition: types.c:183
#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 ( )

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

725 {
726  // long gts;
727 
730 #ifdef TS
731  /* global_time_stamp=choice_stack->time_stamp; */ /* 9.6 */
732 #endif
735  resid_aim=NULL;
736 
737 
738  /* assert((unsigned long)stack_pointer>=(unsigned long)cut_point); 13.6 */
739  /* This situation occurs frequently in some benchmarks (e.g comb) */
740  /* printf("*** Possible GC error: cut_point is dangling\n"); */
741  /* fflush(stdout); */
742 
743  /* assert((unsigned long)stack_pointer>=(unsigned long)match_date); 13.6 */
744 }
ptr_goal goal_stack
Definition: def_glob.h:50
void undo(ptr_stack limit)
Definition: login.c:646
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)

Definition at line 20 of file parser.c.

References final_dot, final_question, and TRUE.

22 {
23  char *s,c;
24  long r;
25 
26 
27  if(t->type==final_dot || t->type==final_question) /* RM: Jul 9 1993 */
28  return TRUE;
29 
30  s=t->type->keyword->symbol;
31  c=s[0];
32  r=(s[1]==0 &&
33  (c=='(' ||
34  c==')' ||
35  c=='[' ||
36  c==']' ||
37  c=='{' ||
38  c=='}'
39  /* || c=='.' || c=='?' RM: Jul 7 1993 */
40  )
41  );
42 
43  return r;
44 }
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)

Definition at line 705 of file token.c.

707 {
708  switch (n) {
709  case '0': return 0;
710  case '1': return 1;
711  case '2': return 2;
712  case '3': return 3;
713  case '4': return 4;
714  case '5': return 5;
715  case '6': return 6;
716  case '7': return 7;
717  case '8': return 8;
718  case '9': return 9;
719  case 'a':
720  case 'A': return 10;
721  case 'b':
722  case 'B': return 11;
723  case 'c':
724  case 'C': return 12;
725  case 'd':
726  case 'D': return 13;
727  case 'e':
728  case 'E': return 14;
729  case 'f':
730  case 'F': return 15;
731  default:
732  fprintf(stderr,"base2int('%c'): illegal argument\n",n);
733  exit(EXIT_FAILURE);
734  }
735 }
void begin_terminal_io ( )

Definition at line 410 of file token.c.

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

411 {
412  inchange = (input_stream!=stdin);
413  outchange = (output_stream!=stdout);
414 
415  if (outchange) {
417  output_stream=stdout;
418  }
419 
420  if (inchange) {
422  (void)open_input_file("stdin");
423  }
424 }
ptr_psi_term input_state
Definition: def_glob.h:199
ptr_psi_term old_state
Definition: token.c:399
static long outchange
Definition: token.c:397
FILE * input_stream
Definition: def_glob.h:38
static long inchange
Definition: token.c:397
static FILE * out
Definition: token.c:398
FILE * output_stream
Definition: def_glob.h:41
long open_input_file(char *file)
Definition: token.c:504
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)

Definition at line 1648 of file types.c.

References INT_SIZE, and wl_int_list::value_1.

1650 {
1651  unsigned long p=0,dp=0,v=0,dv=0;
1652 
1653  while (c) {
1654  v=(unsigned long)c->value_1;
1655  if(v) {
1656  dp=p;
1657  dv=v;
1658  }
1659  c=c->next;
1660  p=p+INT_SIZE;
1661  }
1662 
1663  while (dv) {
1664  dp++;
1665  dv=dv>>1;
1666  }
1667 
1668  return dp;
1669 }
#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 
)

Definition at line 327 of file trees.c.

References FALSE, general_insert(), and STACK.

332 {
333 
334  return general_insert(comp,keystr,tree,info,STACK,FALSE,2L);
335 }
#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)
Definition: trees.c:184
#define STACK
Definition: def_const.h:148
void bk_mark_quote ( ptr_psi_term  t)

Definition at line 630 of file copy.c.

References bk_mark_quote(), bk_mark_quote_tree(), heap_pointer, int_ptr, push_ptr_value(), QUOTED_TRUE, and RMASK.

632 {
633  // ptr_list l;
634 
635  if (t && !(t->status&RMASK)) {
636  if(t->status!=4 && (GENERIC)t<heap_pointer)/* RM: Jul 16 1993 */
638  t->status = 4;
639  t->flags=QUOTED_TRUE; /* 14.9 */
640  t->status |= RMASK;
641  bk_mark_quote(t->coref);
643  t->status &= ~RMASK;
644  }
645 }
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
void bk_mark_quote_tree(ptr_node t)
Definition: copy.c:647
void bk_mark_quote(ptr_psi_term t)
Definition: copy.c:630
#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)

Definition at line 647 of file copy.c.

References bk_mark_quote(), and bk_mark_quote_tree().

649 {
650  if (t) {
654  }
655 }
void bk_mark_quote_tree(ptr_node t)
Definition: copy.c:647
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
void bk_mark_quote(ptr_psi_term t)
Definition: copy.c:630
ptr_node right
Definition: def_struct.h:184
void bk_stack_add_psi_attr ( ptr_psi_term  t,
char *  attrname,
ptr_psi_term  g 
)

Definition at line 200 of file token.c.

References bk_stack_insert(), FEATCMP, and heap_copy_string().

204 {
205  (void)bk_stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)g);
206 }
#define FEATCMP
Definition: def_const.h:257
ptr_node bk_stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:309
char * heap_copy_string(char *s)
Definition: trees.c:147
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 
)

Definition at line 309 of file trees.c.

References FALSE, general_insert(), and STACK.

314 {
315 
316  return general_insert(comp,keystr,tree,info,STACK,FALSE,1L);
317 }
#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)
Definition: trees.c:184
#define STACK
Definition: def_const.h:148
long bounds_undo_stack ( )

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

124 {
126 
127  while (u) {
128  if ( (GENERIC)u<mem_base
129  || (GENERIC)u>mem_limit
130  || (!VALID_ADDRESS(u->aaaa_3) && !(u->type & undo_action))
131  ) {
132  if ((GENERIC)u<mem_base || (GENERIC)u>mem_limit) {
133  printf("\nUNDO: u=%lx\n",(long)u);
134  }
135  else {
136  printf("\nUNDO: u:%lx type:%ld a:%lx b:%lx next:%lx\n",
137  (unsigned long)u,(unsigned long)u->type,(unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3,(unsigned long)u->next);
138  }
139  (void)fflush(stdout);
140  return FALSE;
141  }
142  u=u->next;
143  }
144 
145  return TRUE;
146 }
#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 ( )

Definition at line 2117 of file built_ins.c.

References abort_life(), and TRUE.

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

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

1165 {
1166  long success=TRUE;
1167  ptr_psi_term arg1,arg2,g;
1168  ptr_keyword key;
1169 
1170  g=aim->aaaa_1;
1171 
1172  deref_ptr(g);
1173  get_two_args(g->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
1174  if (arg1 && arg2) {
1175  deref_ptr(arg1);
1176  deref_ptr(arg2);
1177 
1179  if(key) {
1180  if(key->definition!=arg2->type) {
1181  warningline("alias: '%s' has now been overwritten by '%s'\n",
1182  key->combined_name,
1183  arg2->type->keyword->combined_name);
1184 
1185  key->definition=arg2->type;
1186  }
1187  }
1188  else
1189  Errorline("module violation: cannot alias '%s' from module \"%s\"\n",
1190  key->combined_name,
1192  }
1193  else {
1194  success=FALSE;
1195  Errorline("argument(s) missing in '%P'\n",g);
1196  }
1197 
1198  return success;
1199 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
Definition: hash_table.c:133
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
char * combined_name
Definition: def_struct.h:92
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:13
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 ( )

Definition at line 5552 of file built_ins.c.

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

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

Definition at line 5777 of file built_ins.c.

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

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

Definition at line 32 of file raw.c.

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

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

Definition at line 5245 of file built_ins.c.

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

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

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

958 {
959  long success=TRUE;
960  ptr_psi_term result,g,other;
961 
962 
963  g=aim->aaaa_1;
964  deref_ptr(g);
965  result=aim->bbbb_1;
966  deref_ptr(result);
967 
968 
969  other=stack_psi_term(4);
970  /* PVR 24.1.94 */
971  other->type=quoted_string;
973  /*
974  update_symbol(current_module,
975  current_module->module_name)
976  ->keyword->symbol
977  );
978 */ /* RM: 2/15/1994 */
979  /* other->type=update_symbol(current_module,current_module->module_name); */
980  resid_aim=NULL;
981  push_goal(unify,result,other,NULL);
982 
983  return success;
984 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define NULL
Definition: def_const.h:203
ptr_module current_module
Definition: modules.c:13
ptr_goal resid_aim
Definition: def_glob.h:220
char * heap_copy_string(char *s)
Definition: trees.c:147
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_goal aim
Definition: def_glob.h:49
char * module_name
Definition: def_struct.h:75
#define unify
Definition: def_const.h:274
ptr_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 ( )

Definition at line 5743 of file built_ins.c.

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

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

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

725 {
726  ptr_psi_term arg1,arg2;
727  ptr_psi_term call;
728  int success=TRUE;
729 
730 
731  call=aim->aaaa_1;
732  deref_ptr(call);
733  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
734 
735  if(arg1) {
736  deref_ptr(arg1);
737  if(arg1->type==lf_true)
739  else
740  if(arg1->type==lf_false)
742  else {
743  Errorline("argument should be boolean in '%P'\n",call);
744  success=FALSE;
745  }
746  }
747  else /* No argument: toggle */
749 
750  return success;
751 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long display_modules
Definition: modules.c:23
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 ( )

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

761 {
762  ptr_psi_term arg1,arg2;
763  ptr_psi_term call;
764  int success=TRUE;
765 
766 
767  call=aim->aaaa_1;
768  deref_ptr(call);
769  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
770 
771  if(arg1) {
772  deref_ptr(arg1);
773  if(arg1->type==lf_true)
775  else
776  if(arg1->type==lf_false)
778  else {
779  Errorline("argument should be boolean in '%P'\n",call);
780  success=FALSE;
781  }
782  }
783  else /* No argument: toggle */
785 
786  return success;
787 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long 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 ( )

Definition at line 232 of file raw.c.

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

234 {
235  if (!mode_raw)
236  {
237  Errorline ("in c_end_raw: not in mode raw\n");
238  return FALSE;
239  }
240 
241  if (ioctl (stdin_fileno, TIOCSETN, &param_input) == -1)
242  Errorline ("in end_raw: cannot reset mode raw\n");
243 
244  (void)setvbuf (stdin, bufbuf, _IONBF, BUFSIZ);
245  bzero (bufbuf, BUFSIZ);
246 
247  mode_raw = FALSE;
248  return TRUE;
249 }
#define stdin_fileno
Definition: def_const.h:343
static long mode_raw
Definition: raw.c:17
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:18
static struct sgttyb param_input
Definition: raw.c:16
long c_get_raw ( )

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

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

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

554 {
555  ptr_psi_term func,arg1,arg2, result, other;
556  ptr_definition ans;
557  ptr_int_list complexType;
558  ptr_int_list decodedType = NULL;
559  long ret;
560 
561  func=aim->aaaa_1;
562  deref_ptr(func);
563  get_two_args(func->attr_list,&arg1,&arg2);
564 
565  if ((!arg1) || (!arg2)) {
566  curry();
567  return TRUE;
568  }
569  result = aim->bbbb_1;
570  deref(result);
571  deref(arg1);
572  deref(arg2);
573  deref_args(func, set_1_2);
574 
575  if ((ret=glb(arg1->type, arg2->type, &ans, &complexType)) == 0)
576  return FALSE;
577 
578  if ((ret != 4)&&(isValue(arg1)||isValue(arg2))) {
579  /* glb is one of arg1->type or arg2->type AND at least one is a value */
580  if (!isSubTypeValue(arg1, arg2) && !isSubTypeValue(arg2, arg1))
581  return FALSE;
582  }
583  if (!ans) {
584  decodedType = decode(complexType);
585  ans = (ptr_definition)decodedType->value_1;
586  decodedType = decodedType->next;
587  }
588  other=makePsiTerm(ans);
589 
590  if (isValue(arg1)) other->value_3=arg1->value_3;
591  if (isValue(arg2)) other->value_3=arg2->value_3;
592 
593  if (isValue(arg1) || isValue(arg2)) {
594  if (decodedType) {
595  Errorline("glb of multiple-inheritance value sorts not yet implemented.\n");
596  return FALSE;
597  }
598  }
599 
600  if (decodedType)
601  push_choice_point(type_disj, result,(ptr_psi_term) decodedType,(GENERIC) NULL);
602 
603  resid_aim = NULL;
604  push_goal(unify,result,other,NULL);
605  return TRUE;
606 }
ptr_psi_term makePsiTerm(ptr_definition x)
Definition: bi_sys.c:468
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
int isSubTypeValue(ptr_psi_term arg1, ptr_psi_term arg2)
Definition: bi_type.c:163
long glb(ptr_definition t1, ptr_definition t2, ptr_definition *t3, ptr_int_list *c3)
Definition: types.c:1388
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:591
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
ptr_int_list decode(ptr_int_list c)
Definition: types.c:1678
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
void Errorline(char *format,...)
Definition: error.c:414
#define 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)
Definition: bi_type.c:541
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 ( )

Definition at line 2084 of file built_ins.c.

References exit_life(), and TRUE.

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

Definition at line 263 of file raw.c.

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

265 {
266  deref_ptr (aim->a);
268 
269  return TRUE;
270 }
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
static long mode_raw
Definition: raw.c:17
#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 ( )

Definition at line 5690 of file built_ins.c.

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

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

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

516 {
517  ptr_psi_term pred,arg1,arg2;
518 
519  pred=aim->aaaa_1;
520  deref_ptr(pred);
521  get_two_args(pred->attr_list,&arg1,&arg2);
522 
523  if (!arg1) (void)reportAndAbort(pred,"no first argument");
524  deref(arg1);
525 
526  if (!arg2) (void)reportAndAbort(pred,"no second argument");
527  deref(arg2);
528 
529  deref_args(pred, set_1_2);
530 
531  if (isa(arg1, arg2))
532  {
533  residuate(arg2);
534  return TRUE;
535  }
536  return FALSE;
537 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
static long isa(ptr_psi_term arg1, ptr_psi_term arg2)
Definition: bi_type.c:196
void residuate(ptr_psi_term t)
Definition: lefun.c:113
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 ( )

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

615 {
616  ptr_psi_term func,arg1,arg2, result, other;
617  ptr_definition ans=NULL;
618  ptr_int_list decodedType = NULL;
619 
620  func=aim->aaaa_1;
621  deref_ptr(func);
622  get_two_args(func->attr_list,&arg1,&arg2);
623 
624  if ((!arg1) || (!arg2))
625  {
626  curry();
627  return TRUE;
628  }
629  result = aim->bbbb_1;
630  deref(result);
631  deref(arg1);
632  deref(arg2);
633  deref_args(func, set_1_2);
634 
635  /* now lets find the list of types that is the lub */
636 
637  decodedType = lub(arg1, arg2, &other);
638 
639  if (decodedType) {
640  ans = (ptr_definition)decodedType->value_1;
641  decodedType = decodedType->next;
642  other = makePsiTerm(ans);
643  }
644 
645  if (decodedType)
646  push_choice_point(type_disj, result,(ptr_psi_term) decodedType,(GENERIC) NULL);
647 
648  resid_aim = NULL;
649  push_goal(unify,result,other,NULL);
650  return TRUE;
651 }
ptr_psi_term makePsiTerm(ptr_definition x)
Definition: bi_sys.c:468
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void push_choice_point(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:591
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
void curry()
Definition: lefun.c:157
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
#define set_1_2
Definition: def_const.h:196
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#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:150
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 ( )

Definition at line 993 of file modules.c.

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

995 {
996  long success=FALSE;
997  // ptr_psi_term result,module,symbol,call,other;
998  ptr_psi_term call;
999 
1000 
1001  call=aim->aaaa_1;
1002  deref_ptr(call);
1003 
1004  /*
1005  result=aim->bbbb_1;
1006  deref_ptr(result);
1007  get_two_args(call,(ptr_psi_term *)&module,(ptr_psi_term *)&symbol);
1008 
1009  if(module && symbol) {
1010  other=stack_psi_term(4);
1011  other->type=update_symbol(module_access,module_access->module_name);
1012  resid_aim=NULL;
1013  push_goal(unify,result,other,NULL);
1014 
1015  }
1016  */
1017 
1018  warningline("%P not implemented yet...\n",call);
1019 
1020  return success;
1021 }
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 ( )

Definition at line 514 of file modules.c.

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

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

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

699 {
700  // ptr_psi_term arg1,arg2;
701  ptr_psi_term call;
702  int success;
703 
704  call=aim->aaaa_1;
705  deref_ptr(call);
706  if (call->attr_list) {
708  success=TRUE;
709  } else {
710  Errorline("argument missing in '%P'\n",call);
711  success=FALSE;
712  }
713 
714  return success;
715 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void traverse_tree(ptr_node n, int flag)
Definition: modules.c:640
void Errorline(char *format,...)
Definition: error.c:414
#define MAKE_PRIVATE
Definition: modules.c:634
#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 ( )

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

1290 {
1291  // ptr_psi_term arg1,arg2;
1292  ptr_psi_term call;
1293  int success;
1294 
1295  call=aim->aaaa_1;
1296  deref_ptr(call);
1297  if (call->attr_list) {
1299  success=TRUE;
1300  } else {
1301  Errorline("argument missing in '%P'\n",call);
1302  success=FALSE;
1303  }
1304 
1305  return success;
1306 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void traverse_tree(ptr_node n, int flag)
Definition: modules.c:640
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:635
ptr_node attr_list
Definition: def_struct.h:171
long c_public ( )

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

673 {
674  // ptr_psi_term arg1,arg2;
675  ptr_psi_term call;
676  int success;
677 
678  call=aim->aaaa_1;
679  deref_ptr(call);
680  if (call->attr_list) {
682  success=TRUE;
683  } else {
684  Errorline("argument missing in '%P'\n",call);
685  success=FALSE;
686  }
687 
688  return success;
689 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void traverse_tree(ptr_node n, int flag)
Definition: modules.c:640
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:633
ptr_node attr_list
Definition: def_struct.h:171
long c_put_raw ( )

Definition at line 205 of file raw.c.

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

206 {
208  ptr_definition types[1];
209 
210  types[0] = real;
211 
212  begin_builtin (c_put_raw, 1, 0, types);
213 
214  (void)putchar ((char) val[0]);
215  (void)fflush (stdout);
216  success = TRUE;
217  end_builtin ();
218 }
#define begin_builtin(FUNCNAME, NBARGS, NBARGSIN, TYPES)
Definition: def_macro.h:198
long c_put_raw()
Definition: raw.c:205
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 ( )

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

156 {
157  ptr_psi_term t,result,ans;
158  long success=TRUE;
159 
160  t=aim->aaaa_1;
162  result=aim->bbbb_1;
163  deref_ptr(result);
164  ans=stack_psi_term(4);
165  ans->type = NOTQUIET ? lf_false : lf_true;
166  push_goal(unify,result,ans,NULL);
167  return success;
168 }
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)
Definition: login.c:555
#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)
Definition: lefun.c:15
ptr_definition lf_false
Definition: def_glob.h:89
ptr_goal aim
Definition: def_glob.h:49
#define unify
Definition: def_const.h:274
#define deref_args(P, S)
Definition: def_macro.h:145
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
long c_random ( )

Definition at line 5626 of file built_ins.c.

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

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

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

919 {
920  ptr_psi_term arg1=NULL;
921  ptr_psi_term arg2=NULL;
922  ptr_psi_term arg3=NULL;
923  ptr_psi_term call;
924  int success=FALSE;
925  ptr_node n;
926 
927  call=aim->aaaa_1;
928  deref_ptr(call);
929 
930  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
931  n=find(FEATCMP,three,call->attr_list);
932  if (n)
933  arg3=(ptr_psi_term)n->data;
934 
935  if(arg1 && arg2 && arg3) {
936  deref_ptr(arg1);
937  deref_ptr(arg2);
938  deref_ptr(arg3);
939  replace(arg1->type,arg2->type,arg3);
940  success=TRUE;
941  }
942  else {
943  Errorline("argument missing in '%P'\n",call);
944  }
945 
946  return success;
947 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define FEATCMP
Definition: def_const.h:257
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)
Definition: modules.c:834
#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)
Definition: trees.c:341
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
long c_reset_window_flag ( )

Definition at line 309 of file raw.c.

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

311 {
312  deref_ptr (aim->a);
313 #ifdef X11
315 #endif
316 
317  return TRUE;
318 }
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 ( )

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

485 {
486  ptr_psi_term arg1,arg2;
487  ptr_psi_term call;
488 
489  call=aim->aaaa_1;
490  deref_ptr(call);
491  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
492 
493  if(arg1) {
495  return TRUE;
496  }
497  else {
498  Errorline("argument missing in '%P'\n",call);
499  return FALSE;
500  }
501 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
void Errorline(char *format,...)
Definition: error.c:414
#define 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)
Definition: modules.c:67
char * string_val(ptr_psi_term term)
Definition: modules.c:164
ptr_module set_current_module(ptr_module module)
Definition: modules.c:95
ptr_node attr_list
Definition: def_struct.h:171
long c_string_length ( )

Definition at line 5389 of file built_ins.c.

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

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

Definition at line 5444 of file built_ins.c.

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

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

Definition at line 65 of file bi_sys.c.

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

66 {
67  ptr_psi_term t;
68 
69  t=aim->aaaa_1;
72  return TRUE;
73 }
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 ( )

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

21 {
22  long success=TRUE;
23  ptr_psi_term t,arg1,arg2;
24 
25  t=aim->aaaa_1;
27  get_two_args(t->attr_list,&arg1,&arg2);
28  if (arg1) {
29  deref_ptr(arg1);
30  if (is_top(arg1)) {
32  trace=FALSE;
33  }
34  else if (arg1->type==lf_true)
35  trace=TRUE;
36  else if (arg1->type==lf_false)
37  trace=FALSE;
38  else {
39  Errorline("bad first argument in %P.\n",t);
40  /* report_error(t,"bad first argument"); */
41  success=FALSE;
42  }
43  }
44  if (arg2) {
45  deref_ptr(arg2);
46  if (is_top(arg2)) {
49  }
50  else if (arg2->type==lf_true)
51  stepflag=TRUE;
52  else if (arg2->type==lf_false)
54  else {
55  Errorline("bad second argument in %P.\n",t);
56  /* report_error(t,"bad second argument"); */
57  success=FALSE;
58  }
59  }
60  if (!arg1 && !arg2)
61  toggle_trace();
62  return success;
63 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define is_top(T)
Definition: def_macro.h:108
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
#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 ( )

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

797 {
798  ptr_psi_term arg1,arg2;
799  ptr_psi_term call;
800  int success=TRUE;
801 
802 
803  call=aim->aaaa_1;
804  deref_ptr(call);
805  get_two_args(call->attr_list,(ptr_psi_term *)&arg1,(ptr_psi_term *)&arg2);
806 
807  if(arg1) {
808  deref_ptr(arg1);
809  if(arg1->type==lf_true)
811  else
812  if(arg1->type==lf_false)
814  else {
815  Errorline("argument should be boolean in '%P'\n",call);
816  success=FALSE;
817  }
818  }
819  else /* No argument: toggle */
821 
822  return success;
823 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
long 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 ( )

Definition at line 284 of file raw.c.

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

286 {
287  deref_ptr (aim->a);
288 #ifdef X11
290 #else
292 #endif
293 
294  return TRUE;
295 }
void unify_bool_result(ptr_psi_term t, long v)
Definition: built_ins.c:329
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 
)
void check_attr ( ptr_node n)

Definition at line 985 of file memory.c.

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

987 {
988  while (unchecked(n,sizeof(node))) {
989  check_attr(&((*n)->left));
990  check_string(&((*n)->key));
991  check_psi_term((struct wl_psi_term **)&((*n)->data));
992 
993  n = &((*n)->right);
994  /* check_attr(&((*n)->right)); 9.6 */
995  }
996 }
static void check_string(GENERIC *s)
Definition: memory.c:375
static long unchecked(GENERIC *p, long len)
Definition: memory.c:309
void check_psi_term(ptr_psi_term *t)
Definition: memory.c:920
void check_attr(ptr_node *n)
Definition: memory.c:985
void check_definition ( ptr_definition d)

Definition at line 612 of file memory.c.

References check_code(), check_keyword(), check_kids(), check_operator_data(), check_pair_list(), check_psi_term(), check_triple_list(), type_it, and unchecked().

614 {
615  if(unchecked(d,sizeof(definition))) {
616 
617  check_keyword(&((*d)->keyword)); /* RM: Jan 12 1993 */
618 
619 #ifdef prlDEBUG
620  printf("%lx %20s %ld\n",*d,(*d)->keyword->symbol,amount_used);
621 #endif
622 
623  check_code(&((*d)->code));
624  check_pair_list(&((*d)->rule));
625  check_triple_list(&((*d)->properties));
626 
627  if ((*d)->type_def==(def_type)type_it) {
628  check_kids(&((*d)->parents));
629  check_kids(&((*d)->children));
630  }
631 
632  check_psi_term(&((*d)->global_value)); /* RM: Feb 9 1993 */
633  check_psi_term(&((*d)->init_value)); /* RM: Mar 23 1993 */
634 
635  check_operator_data(&((*d)->op_data)); /* PVR 5.6 */
636 
637 #ifdef CLIFE
638  check_block_def(&((*d)->block_def)); /* RM: Jan 27 1993 */
639 #endif /* CLIFE */
640  }
641 }
static void check_operator_data(ptr_operator_data *op)
Definition: memory.c:506
ptr_keyword keyword
Definition: def_struct.h:124
static void check_pair_list(ptr_pair_list *p)
Definition: memory.c:460
char * symbol
Definition: def_struct.h:91
static long unchecked(GENERIC *p, long len)
Definition: memory.c:309
#define type_it
Definition: def_const.h:363
static void check_kids(ptr_int_list *c)
Definition: memory.c:492
static void check_triple_list(ptr_triple_list *p)
Definition: memory.c:476
void check_psi_term(ptr_psi_term *t)
Definition: memory.c:920
static void check_code(ptr_int_list *c)
Definition: memory.c:448
static void check_keyword()
void check_definition_list ( )

Definition at line 648 of file memory.c.

References check_definition(), and first_definition.

650 {
651  ptr_definition *d;
652 
653  d= &first_definition;
654 
655  while(*d) {
656  check_definition(d);
657  d= &((*d)->next);
658  }
659 }
void check_definition(ptr_definition *d)
Definition: memory.c:612
ptr_definition first_definition
Definition: def_glob.h:3
void check_disj ( ptr_psi_term  t)

Definition at line 845 of file lefun.c.

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

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

Definition at line 861 of file lefun.c.

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

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

Definition at line 1008 of file memory.c.

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

1009 {
1010  long i;
1011 
1013  for (i=0;i<type_count;i++)
1014  check_def_code(&(gamma_table[i]));
1015  }
1016 }
long type_count
Definition: def_glob.h:46
static long unchecked(GENERIC *p, long len)
Definition: memory.c:309
static void check_def_code(ptr_definition *d)
Definition: memory.c:667
ptr_definition * gamma_table
Definition: def_glob.h:309
void check_hash_table ( ptr_hash_table  table)

Definition at line 576 of file memory.c.

References check_keyword().

579 {
580  long i;
581 
582  for(i=0;i<table->size;i++)
583  if(table->data[i])
584  check_keyword(&(table->data[i]));
585 }
ptr_keyword * data
Definition: def_struct.h:114
static void check_keyword()
long check_legal_cons ( ptr_psi_term  t,
ptr_definition  t_type 
)

Definition at line 642 of file print.c.

References count_features(), FEATCMP, find(), one, and two.

646 {
647  return (t->type==t_type &&
648  count_features(t->attr_list)==2 &&
649  find(FEATCMP,one,t->attr_list) &&
650  find(FEATCMP,two,t->attr_list));
651 }
#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)
Definition: trees.c:341
ptr_definition type
Definition: def_struct.h:165
ptr_node attr_list
Definition: def_struct.h:171
long check_opargs ( ptr_node  n)

Definition at line 815 of file print.c.

References featcmp().

817 {
818  if (n) {
819  long f=check_opargs(n->left) | check_opargs(n->right);
820  if (!featcmp(n->key,"1")) return 1 | f;
821  if (!featcmp(n->key,"2")) return 2 | f;
822  return 4 | f;
823  }
824  else
825  return 0;
826 }
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
long featcmp(char *str1, char *str2)
Definition: trees.c:89
ptr_node right
Definition: def_struct.h:184
long check_out ( ptr_psi_term  t)

Definition at line 999 of file lefun.c.

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

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

Definition at line 214 of file print.c.

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

216 {
217  ptr_node n;
218 
219  if (p) {
220  deref_ptr(p);
221  n=find(INTCMP,(char *)p,pointer_names);
222  if (n==NULL) {
223  (void)heap_insert(INTCMP,(char *)p,&pointer_names,(GENERIC)NULL);
224  go_through(p);
225  }
226  else
227  n->data=(GENERIC)no_name;
228  }
229 }
#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)
Definition: trees.c:276
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)
Definition: trees.c:341
unsigned long * GENERIC
Definition: def_struct.h:17
void check_psi_term ( ptr_psi_term t)

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

922 {
923  ptr_list *l;
924 
925  while (unchecked(t,sizeof(psi_term))) {
926 
927  /* A psi-term on the heap has no residuation list. */
928  if (pass==1 && (GENERIC)(*t)>=heap_pointer && (GENERIC)(*t)<mem_limit) {
929  assert((*t)->resid==NULL);
930  }
931  check_definition(&((*t)->type));
932  check_attr(&((*t)->attr_list));
933 
934  if ((*t)->value_3) {
935 
936  if ((*t)->type==alist) { /* RM: Dec 15 1992 Should be removed */
937  l=(ptr_list *) &((*t)->value_3);
938  if (l)
939  printf("Found an old list!\n");
940  }
941  else
942 
943  if (sub_type((*t)->type,real))
944  (void)unchecked(&((*t)->value_3),sizeof(REAL));
945  else if (sub_type((*t)->type,quoted_string))
946  check_string(&((*t)->value_3));
947  /* DENYS: BYTEDATA */
948  else if (sub_type((*t)->type,sys_bytedata))
949  check_bytedata(&((*t)->value_3));
950 #ifdef CLIFE
951  else if ((*t)->type->type==block) { /* RM: Jan 27 1993 */
952  check_block_value(&((*t)->value_3));
953  }
954 #endif /* CLIFE */
955  else if ((*t)->type==cut) { /* RM: Oct 28 1993 */
956  /* assert((*t)->value_3 <= (GENERIC)choice_stack); 12.7 17.7 */
957  if (pass==1 && (*t)->value_3>(GENERIC)choice_stack)
958  (*t)->value_3=(GENERIC)choice_stack;
959  (void)unchecked(&((*t)->value_3),LONELY);
960  }
961  else if (sub_type((*t)->type,variable)) /* 8.8 */
962  check_string(&((*t)->value_3));
963  else if ((*t)->type!=stream)
964  Errorline("non-NULL value field in garbage collector, type='%s', value=%d.\n",
965  (*t)->type->keyword->combined_name,
966  (*t)->value_3);
967  }
968 
969  /* check_psi_term(&((*t)->coref)); 9.6 */
970  if ((*t)->resid)
971  check_resid(&((*t)->resid));
972 
973  t = &((*t)->coref);
974  }
975 }
static void check_bytedata(GENERIC *s)
Definition: memory.c:416
static void check_resid(ptr_residuation *r)
Definition: memory.c:851
GENERIC mem_limit
Definition: def_glob.h:13
ptr_definition stream
Definition: def_glob.h:103
static void check_string(GENERIC *s)
Definition: memory.c:375
static long pass
Definition: memory.c:17
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
static long unchecked(GENERIC *p, long len)
Definition: memory.c:309
struct wl_list * ptr_list
Definition: def_struct.h:38
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
void check_definition(ptr_definition *d)
Definition: memory.c:612
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:20
unsigned long * GENERIC
Definition: def_struct.h:17
void check_attr(ptr_node *n)
Definition: memory.c:985
ptr_definition variable
Definition: def_glob.h:111
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define assert(N)
Definition: memory.c:104
long check_real ( ptr_psi_term  t,
REAL v,
long *  n 
)

Definition at line 217 of file built_ins.c.

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

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

Definition at line 900 of file memory.c.

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

902 {
903  if (*rb) {
904  if (unchecked(rb,sizeof(resid_block))) {
905  check_goal_stack(&((*rb)->ra));
906  check_resid_list(&((*rb)->rv)); /* 21.9 */
907  /* unchecked(&((*rb)->rl),LONELY); 12.6 */ /* 10.6 */
908  (void)unchecked(&((*rb)->md),LONELY); /* 10.6 */
909  /* check_goal_stack(&((*rb)->rl)); 10.6 */
910  /* check_psi_term(&((*rb)->md)); 10.6 */
911  }
912  }
913 }
static void check_resid_list()
static void check_goal_stack(ptr_goal *g)
Definition: memory.c:739
static long unchecked(GENERIC *p, long len)
Definition: memory.c:309
#define LONELY
Definition: memory.c:20
void check_sys_definitions ( )

Definition at line 1740 of file sys.c.

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

1741 {
1742  check_definition(&sys_bytedata); /* DENYS: BYTEDATA */
1753 #ifdef LIFE_NDBM
1754  check_ndbm_definitions();
1755 #endif
1756 }
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:1379
ptr_definition sys_bitvector
Definition: def_glob.h:130
ptr_definition sys_process_stopped
Definition: sys.c:1380
ptr_definition sys_process_continued
Definition: sys.c:1381
void check_definition(ptr_definition *d)
Definition: memory.c:612
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:1378
ptr_definition sys_process_no_children
Definition: sys.c:1377
long check_type ( ptr_psi_term  t)

Definition at line 922 of file lefun.c.

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

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

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

1777 {
1778  long success=FALSE;
1779  ptr_pair_list *p;
1780  ptr_psi_term head,body,rule_head,rule_body;
1781 
1782  head=(ptr_psi_term)aim->aaaa_1;
1783  body=(ptr_psi_term)aim->bbbb_1;
1784  p=(ptr_pair_list *)aim->cccc_1;
1785 
1786  if ((unsigned long)(*p)>MAX_BUILT_INS) {
1787  success=TRUE;
1788  /* deref(head); 17.9 */
1789 
1790  if ((*p)->next) {
1791  if (r) {
1792  traceline("pushing 'retract' choice point for %P\n", head);
1793  push_choice_point(del_clause,head,(ptr_psi_term)body,(GENERIC)&((*p)->next));
1794  /* push_choice_point(del_clause,head,body,p); */
1795  }
1796  else {
1797  traceline("pushing 'clause' choice point for %P\n", head);
1798  push_choice_point(clause,head,(ptr_psi_term)body,(GENERIC)&((*p)->next));
1799  }
1800  }
1801 
1802  if (r)
1804  if ((*p)->aaaa_2) {
1805  clear_copy();
1806  rule_head=quote_copy((*p)->aaaa_2,STACK);
1807  rule_body=quote_copy((*p)->bbbb_2,STACK);
1808 
1809  push_goal(unify,(ptr_psi_term)body,(ptr_psi_term)rule_body,NULL);
1810  push_goal(unify,(ptr_psi_term)head,(ptr_psi_term)rule_head,NULL);
1811 
1812  rule_head->status=4;
1813  rule_body->status=4;
1814 
1815  (void)i_eval_args(rule_body->attr_list);
1816  (void)i_eval_args(rule_head->attr_list);
1817 
1818  traceline("fetching next clause for %s\n", head->type->keyword->symbol);
1819  }
1820  else {
1821  success=FALSE;
1822  traceline("following clause had been retracted\n");
1823  }
1824  }
1825  else if ((unsigned long)(*p)>0) {
1826  if (r)
1827  Errorline("the built-in %P cannot be retracted.\n",head);
1828  else
1829  Errorline("the definition of built-in %P is not accessible.\n",head);
1830  }
1831 
1832  return success;
1833 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void clear_copy()
Definition: copy.c:52
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
Definition: login.c:555
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)
Definition: copy.c:200
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)
Definition: lefun.c:817
#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)
Definition: login.c:591
#define STACK
Definition: def_const.h:148
void clean_undo_window ( long  disp,
long  wind 
)

Definition at line 792 of file login.c.

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

794 {
795  // ptr_stack *prev,u;
796  // ptr_choice_point c;
797 
798 #ifdef X11
799  /* Remove entries on the trail */
800  u = undo_stack;
801  prev = &undo_stack;
802  while (u) {
803  if ((u->type & undo_action) &&
804  ((unsigned long)u->aaaa_3==disp) && ((unsigned long)u->bbbb_3==wind)) {
805  *prev = u->next;
806  }
807  prev = &(u->next);
808  u = u->next;
809  }
810 
811  /* Remove entries at the *tops* of trail entry points from the */
812  /* choice point stack. It's only necessary to look at the tops, */
813  /* since those are the only ones that haven't been touched by */
814  /* the previous while loop. */
815  c = choice_stack;
816  while (c) {
817  u = c->undo_point;
818  prev = &(c->undo_point);
819  while (u && (u->type & undo_action) &&
820  ((unsigned long)u->aaaa_3==disp) && ((unsigned long)u->bbbb_3==wind)) {
821  *prev = u->next;
822  prev = &(u->next);
823  u = u->next;
824  }
825  c = c->next;
826  }
827 #endif
828 }
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)

Definition at line 326 of file types.c.

References wl_definition::already_loaded, and FALSE.

328 {
329  ptr_definition d;
330 
331  if (n) {
332  d=((ptr_keyword)n->data)->definition;
336  }
337 }
char already_loaded
Definition: def_struct.h:137
void clear_already_loaded(ptr_node n)
Definition: types.c:326
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 ( )

Definition at line 685 of file types.c.

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

687 {
688  ptr_definition d;
689 
690  for(d=first_definition;d;d=d->next)
691  if (d->type_def==(def_type)type_it) d->code=NOT_CODED;
692 }
#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 ( )

Definition at line 52 of file copy.c.

References hashfree, and hashtime.

53 {
54  hashtime++;
55  hashfree=0;
56 }
static long hashfree
Definition: copy.c:23
static long hashtime
Definition: copy.c:22
ptr_psi_term collect_symbols ( long  sel)

Definition at line 3446 of file built_ins.c.

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

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

Definition at line 164 of file types.c.

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

167 {
168  ptr_int_list n;
169 
170  n=HEAP_ALLOC(int_list);
171  n->value_1=v;
172  n->next=l;
173 
174  return n;
175 }
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 
)

Definition at line 219 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, FALSE, wl_psi_term::flags, function_it, global, global_time_stamp, HEAP, heap_pointer, HEAPDONE, insert_translation(), mark_quote_c(), NEW, NULL, QUOTE_FLAG, QUOTE_STUB, QUOTED_TRUE, wl_psi_term::resid, stack_pointer, wl_psi_term::status, traceline(), translate(), TRUE, type_it, and wl_psi_term::value_3.

222 {
223  ptr_psi_term u;
224  long old_status;
225  long local_copy_flag;
226  long *infoptr;
227 
228 
229  if ((u=t)) {
230  deref_ptr(t); /* Always dereference when copying */
231 
232  if (HEAPDONE(t)) return t;
233  u = translate(t,&infoptr);
234 
235  if (u && *infoptr!=QUOTE_STUB) { /* 24.8 */
236  /* If it was eval-copied before, then quote it now. */
237  if (*infoptr==EVAL_FLAG && copy_flag==QUOTE_FLAG) { /* 24.8 25.8 */
238  mark_quote_c(t,heap_flag);
239  *infoptr=QUOTE_FLAG; /* I.e. don't touch this term any more */
240  }
241  if (copy_flag==EVAL_FLAG) { /* PVR 14.2.94 */
242  /* If any subterm has zero curr_status (i.e., if u->status==0),
243  then so does the whole term: */
244  old_status=curr_status;
245  curr_status=u->status;
246  if (curr_status) curr_status=old_status;
247  }
248  }
249  else {
251  Errorline("psi-term too large -- get a bigger Life!\n");
252  (void)abort_life(TRUE);
253  longjmp(env,FALSE); /* Back to main loop */ /* RM: Feb 15 1993 */
254  }
255  if (copy_flag==EVAL_FLAG && !t->type->evaluate_args) /* 24.8 25.8 */
256  local_copy_flag=QUOTE_FLAG; /* All arguments will be quoted 24.8 */
257  else /* 24.8 */
258  local_copy_flag=copy_flag;
259  if (copy_flag==EVAL_FLAG) {
260  old_status = curr_status;
261  curr_status = 4;
262  }
263  if (u) { /* 15.9 */
264  *infoptr=QUOTE_FLAG;
265  local_copy_flag=QUOTE_FLAG;
266  copy_flag=QUOTE_FLAG;
267  }
268  else {
269  u=NEW(t,psi_term);
270  insert_translation(t,u,local_copy_flag); /* 24.8 */
271  }
272  *u = *t;
273  u->resid=NULL; /* 24.8 Don't copy residuations */
274 #ifdef TS
275  u->time_stamp=global_time_stamp; /* 9.6 */
276 #endif
277 
278  if (t->attr_list)
279  u->attr_list=copy_tree(t->attr_list, local_copy_flag, heap_flag);
280 
281  if (copy_flag==EVAL_FLAG) {
282  switch((long)t->type->type_def) {
283  case (long)type_it:
284  if (t->type->properties)
285  curr_status=0;
286  break;
287 
288  case (long)function_it:
289  curr_status=0;
290  break;
291 
292  case (long)global: /* RM: Feb 8 1993 */
293  curr_status=0;
294  break;
295 
296  default:
297  break;
298  }
299  u->status=curr_status;
300  u->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
301  /* If any subterm has zero curr_status,
302  then so does the whole term: */
303  if (curr_status) curr_status=old_status;
304  } else if (copy_flag==QUOTE_FLAG) {
305  u->status=4;
306  u->flags=QUOTED_TRUE; /* 14.9 */
307  }
308  /* else copy_flag==EXACT_FLAG & u->status=t->status */
309 
310  if (heap_flag==HEAP) {
311  if (t->type==cut) u->value_3=NULL;
312  } else {
313  if (t->type==cut) {
315  traceline("current choice point is %x\n",choice_stack);
316  }
317  }
318  }
319  }
320 
321  return u;
322 }
#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)
Definition: copy.c:101
#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)
Definition: copy.c:63
#define NULL
Definition: def_const.h:203
#define NEW(A, TYPE)
Definition: def_macro.h:279
long abort_life(int nlflag)
Definition: built_ins.c:2124
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)
Definition: copy.c:139
static long curr_status
Definition: copy.c:215
#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)
Definition: copy.c:396
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:19
#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)

Definition at line 760 of file types.c.

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

762 {
763  ptr_int_list code;
764 
765  code = HEAP_ALLOC(int_list);
766  code->value_1=0;
767  code->next=NULL;
768 
769  or_codes(code, u);
770 
771  return code;
772 }
#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)
Definition: types.c:780
ptr_int_list next
Definition: def_struct.h:55
long count_features ( ptr_node  t)

Definition at line 619 of file print.c.

622 {
623  long c=0;
624  if(t) {
625  if(t->left)
626  c+=count_features(t->left);
627  c++;
628  if(t->right)
629  c+=count_features(t->right);
630  }
631  return c;
632 }
ptr_node left
Definition: def_struct.h:183
ptr_node right
Definition: def_struct.h:184
long count_sorts ( long  c0)

Definition at line 669 of file types.c.

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

671 {
672  ptr_definition d;
673 
674  for(d=first_definition;d;d=d->next)
675  if (d->type_def==(def_type)type_it) c0++;
676 
677  return c0;
678 }
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)

Definition at line 67 of file modules.c.

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

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

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

639 {
640  psi_term t,t1,t2,t3;
641  long op1,op2,op3;
642 
643  if(parse_ok && prec>=look() && parser_stack_index>limit) {
644 
645  (void)pop(&t1,&op1);
646 
647  switch(op1) {
648 
649  case nop:
650  (void)pop(&t2,&op2);
651  if(op2==fx)
652  t=make_life_form(&t2,&t1,NULL);
653  else
654  if(op2==xfx) {
655  (void)pop(&t3,&op3);
656  if(op3==nop)
657  t=make_life_form(&t2,&t3,&t1);
658  else {
659  printf("*** Parser: ooops, NOP expected.\n");
660  parse_ok=FALSE;
661  t= *error_psi_term;
662  }
663  }
664  break;
665 
666  case xf:
667  (void)pop(&t2,&op2);
668  if(op2==nop)
669  t=make_life_form(&t1,&t2,NULL);
670  else {
671  printf("*** Parser: ugh, NOP expected.\n");
672  t= *error_psi_term;
673  parse_ok=FALSE;
674  }
675  break;
676 
677  default:
678  printf("*** Parser: yuck, weirdo operator.\n");
679  }
680 
681  push(t,look(),nop);
682 
683  crunch(prec,limit);
684  }
685 }
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
long look()
Definition: parser.c:146
void push(psi_term tok, long prec, long op)
Definition: parser.c:91
#define NULL
Definition: def_const.h:203
#define nop
Definition: def_const.h:260
long pop(ptr_psi_term tok, long *op)
Definition: parser.c:115
void crunch(long prec, long limit)
Definition: parser.c:636
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)
Definition: parser.c:546
long parser_stack_index
Definition: def_glob.h:24
long parse_ok
Definition: def_glob.h:171
void curry ( )

Definition at line 157 of file lefun.c.

References can_curry, curried, and TRUE.

158 {
159  if (can_curry)
160  curried=TRUE;
161 }
#define TRUE
Definition: def_const.h:127
long can_curry
Definition: def_glob.h:224
long curried
Definition: def_glob.h:223
long declare_operator ( ptr_psi_term  t)

Definition at line 5114 of file built_ins.c.

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

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

Definition at line 1678 of file types.c.

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

1680 {
1681  ptr_int_list c2,c3,c4,result=NULL,*prev;
1682  long p;
1683 
1684  p=bit_length(c);
1685 
1686  while (p) {
1687  p--;
1688  c2=gamma_table[p]->code;
1689  result=cons((GENERIC)gamma_table[p],result);
1690  prev= &c4;
1691  *prev=NULL;
1692 
1693  while (c2) {
1694  c3=STACK_ALLOC(int_list);
1695  *prev=c3;
1696  prev= &(c3->next);
1697  *prev=NULL;
1698 
1699  c3->value_1=(GENERIC)(((unsigned long)(c->value_1)) & ~((unsigned long)(c2->value_1)));
1700 
1701  c=c->next;
1702  c2=c2->next;
1703  }
1704 
1705  c=c4;
1706  p=bit_length(c);
1707  }
1708 
1709  return result;
1710 }
ptr_definition * gamma_table
Definition: types.c:16
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
#define NULL
Definition: def_const.h:203
long bit_length(ptr_int_list c)
Definition: types.c:1648
#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 
)

Definition at line 466 of file trees.c.

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

469 {
470  long cmp;
471  ptr_node new,r;
472 
473  if (*n) {
474  cmp=featcmp(s,(*n)->key);
475  if (cmp<0)
476  delete_attr(s,&((*n)->left));
477  else if (cmp>0)
478  delete_attr(s,&((*n)->right));
479  else if ((*n)->left) {
480  if ((*n)->right) {
481  r=(*n)->right;
482  new=heap_insert(FEATCMP,r->key,&((*n)->left),r->data);
483  new->left=r->left;
484  new->right=r->right;
485  *n = (*n) -> left;
486  }
487  else
488  *n = (*n)->left;
489  }
490  else
491  *n = (*n)->right;
492  }
493 }
#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)
Definition: trees.c:276
long featcmp(char *str1, char *str2)
Definition: trees.c:89
void delete_attr(char *s, ptr_node *n)
Definition: trees.c:466
ptr_node right
Definition: def_struct.h:184
void deref2_eval ( ptr_psi_term  t)

Definition at line 1224 of file lefun.c.

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

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

Definition at line 1245 of file lefun.c.

References deref_ptr, and deref_rec_body().

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

Definition at line 1175 of file lefun.c.

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

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

Definition at line 1087 of file lefun.c.

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

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

Definition at line 1159 of file lefun.c.

References deref_ptr, and deref_rec_body().

1161 {
1162  ptr_psi_term t1;
1163 
1164  if (n) {
1165  deref_rec_args(n->right);
1166  t1 = (ptr_psi_term) (n->data);
1167  deref_ptr(t1);
1168  deref_rec_body(t1);
1169  deref_rec_args(n->left);
1170  }
1171 }
void deref_rec_args(ptr_node n)
Definition: lefun.c:1159
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void deref_rec_body(ptr_psi_term t)
Definition: lefun.c:1135
ptr_node right
Definition: def_struct.h:184
void deref_rec_args_exc ( ptr_node  n,
long  set 
)

Definition at line 1203 of file lefun.c.

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

1206 {
1207  ptr_psi_term t;
1208 
1209  if (n) {
1210  deref_rec_args_exc(n->right,set);
1211  if (!in_set(n->key,set)) {
1212  t = (ptr_psi_term) (n->data);
1213  deref_ptr(t);
1214  deref_rec_body(t);
1215  }
1216  deref_rec_args_exc(n->left,set);
1217  }
1218 }
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
char * key
Definition: def_struct.h:182
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void deref_rec_body(ptr_psi_term t)
Definition: lefun.c:1135
void deref_rec_args_exc(ptr_node n, long set)
Definition: lefun.c:1203
long in_set(char *str, long set)
Definition: lefun.c:1192
ptr_node right
Definition: def_struct.h:184
void deref_rec_body ( ptr_psi_term  t)

Definition at line 1135 of file lefun.c.

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

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

Definition at line 1123 of file lefun.c.

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

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

Definition at line 1525 of file login.c.

References TRUE.

1526 {
1527  // ptr_psi_term u,v;
1528  // ptr_list l;
1529  long success=TRUE;
1530 
1531  printf("Call to disjunct_aim\nThis routine inhibited by RM: Dec 9 1992\n");
1532 
1533  return success;
1534 }
#define TRUE
Definition: def_const.h:127
void display_couple ( ptr_psi_term  u,
char *  s,
ptr_psi_term  v 
)

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

1520 {
1521  GENERIC old_heap_pointer;
1522  ptr_tab_brk new;
1523 
1524  output_stream=stdout;
1526  old_heap_pointer=heap_pointer;
1527 
1530  gen_sym_counter=0;
1531  check_pointer(u);
1532  check_pointer(v);
1534 
1535  indent=FALSE;
1536  const_quote=TRUE;
1539  *buffer=0;
1541  new_tab(&new);
1542  mark_tab(new);
1544  prettyf(s);
1546  end_tab();
1547 
1548  if (indent) {
1549  work_out_length();
1550  pretty_output();
1551  }
1552 
1553  heap_pointer=old_heap_pointer;
1554 }
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 
)

Definition at line 1460 of file print.c.

References main_display_psi_term(), and outfile.

1463 {
1464  outfile=s;
1466 }
FILE * outfile
Definition: def_glob.h:333
void display_psi_stderr ( ptr_psi_term  t)

Definition at line 1438 of file print.c.

References main_display_psi_term(), and outfile.

1440 {
1441  outfile=stderr;
1443 }
FILE * outfile
Definition: def_glob.h:333
void display_psi_stdout ( ptr_psi_term  t)

Definition at line 1427 of file print.c.

References main_display_psi_term(), and outfile.

1429 {
1430  outfile=stdout;
1432 }
FILE * outfile
Definition: def_glob.h:333
void display_psi_stream ( ptr_psi_term  t)

Definition at line 1449 of file print.c.

References main_display_psi_term(), outfile, and output_stream.

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

Definition at line 358 of file copy.c.

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

360 {
361  ptr_psi_term res;
362 
363  res=STACK_ALLOC(psi_term);
364  *res= *t;
365 #ifdef TS
366  res->time_stamp=global_time_stamp; /* 9.6 */
367 #endif
368  /* res->coref=distinct_copy(t->coref); */
370 
371  return res;
372 }
ptr_node distinct_tree(ptr_node t)
Definition: copy.c:334
#define STACK_ALLOC(A)
Definition: def_macro.h:16
unsigned long global_time_stamp
Definition: login.c:19
ptr_node attr_list
Definition: def_struct.h:171
ptr_node distinct_tree ( ptr_node  t)

Definition at line 334 of file copy.c.

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

336 {
337  ptr_node n;
338 
339  n=NULL;
340  if (t) {
341  n=STACK_ALLOC(node);
342  n->key=t->key;
343  n->data=t->data;
344  n->left=distinct_tree(t->left);
345  n->right=distinct_tree(t->right);
346  }
347 
348  return n;
349 }
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node distinct_tree(ptr_node t)
Definition: copy.c:334
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 ( )

Definition at line 359 of file lefun.c.

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

360 {
361  ptr_psi_term funct,result;
362 
363  /* PVR 5.11 undo(resid_limit); */
364  /* PVR 5.11 choice_stack=cut_point; */
366  funct=(ptr_psi_term )resid_aim->aaaa_1;
367  result=(ptr_psi_term )resid_aim->bbbb_1;
368 
369  traceline("currying %P\n",funct);
370 
371  push_goal(unify_noeval,funct,result,NULL);
372  resid_aim=NULL;
373 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_goal goal_stack
Definition: def_glob.h:50
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
#define NULL
Definition: def_const.h:203
ptr_goal resid_aim
Definition: def_glob.h:220
void traceline(char *format,...)
Definition: error.c:157
#define unify_noeval
Definition: def_const.h:275
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_psi_term bbbb_1
Definition: def_struct.h:225
ptr_goal next
Definition: def_struct.h:227
void do_pretty_attr ( ptr_node  t,
ptr_tab_brk  tab,
long *  cnt,
long  two,
long  depth 
)

Definition at line 1109 of file print.c.

References COMMA_PREC, display_modules, extract_module_from_name(), mark_tab(), wl_module::module_name, pretty_tag_or_psi_term(), prettyf(), prettyf_quote(), str_to_int(), and strip_module_name().

1115 {
1116  long v;
1117  /* char *s="nnn"; 18.5 */
1118  char s[4];
1119  ptr_module module;
1120 
1121 
1122  if (t) {
1123  if (t->left) {
1124  do_pretty_attr(t->left,tab,cnt,two,depth);
1125  prettyf(",");
1126  }
1127 
1128  /* Don't start each argument on a new line, */
1129  /* unless printing a function body: */
1130  mark_tab(tab);
1131 
1132  v=str_to_int(t->key);
1133  if (v<0) {
1134  if(display_modules) { /* RM: Jan 21 1993 */
1135  module=extract_module_from_name(t->key);
1136  if(module) {
1137  prettyf(module->module_name);
1138  prettyf("#");
1139  }
1140  }
1142 
1143  prettyf(" => ");
1144  }
1145  else if (v== *cnt)
1146  (*cnt)++ ;
1147  else {
1148  (void)snprintf(s,4,"%ld",v);
1149  prettyf(s); /* 6.10 */
1150  prettyf(" => ");
1151  }
1152 
1153  /* pretty_tag_or_psi_term(t->data,(two?COMMA_PREC:MAX_PRECEDENCE+1)); */
1155 
1156  if (t->right) {
1157  prettyf(",");
1158  do_pretty_attr(t->right,tab,cnt,two,depth);
1159  }
1160  }
1161 }
char * two
Definition: def_glob.h:251
char * strip_module_name(char *str)
Definition: modules.c:139
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)
Definition: modules.c:111
char * module_name
Definition: def_struct.h:75
ptr_node right
Definition: def_struct.h:184
long do_residuation ( )

Definition at line 313 of file lefun.c.

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

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

Definition at line 306 of file lefun.c.

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

307 {
308  goal_stack=resid_aim->next; /* reset goal stack */
309  return do_residuation();
310 }
long do_residuation()
Definition: lefun.c:313
ptr_goal goal_stack
Definition: def_glob.h:50
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_goal next
Definition: def_struct.h:227
int dummy_printf ( char *  f,
char *  s,
char *  t 
)

Definition at line 2482 of file login.c.

2485 {
2486  return strlen(f);
2487 }
void encode_types ( )

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

1016 {
1017  long p=0,i,possible,ok=TRUE;
1018  ptr_int_list layer,l,kids,dads,code;
1019  ptr_definition xdef,kdef,ddef; //,err;
1020 
1021  if (types_modified) {
1022 
1023  nothing->parents=NULL;
1025 
1026  top->parents=NULL;
1027  top->children=NULL;
1028 
1029  /* The following definitions are vital to avoid crashes */
1031  make_type_link(lf_true,boolean);
1032  make_type_link(lf_false,boolean);
1033 
1034  /* These just might be useful */
1036  make_type_link(boolean,built_in);
1038 
1040 
1041  type_count=count_sorts(-1); /* bottom does not count */
1042  clear_coding();
1043  nothing->parents=NULL; /* Must be cleared before all_sorts */
1044  all_sorts();
1045  if (type_cyclicity(nothing,NULL)) {
1046  clear_coding();
1047  return;
1048  }
1049  clear_coding();
1050  nothing->parents=NULL; /* Must be cleared before least_sorts */
1051  least_sorts();
1052 
1053  nothing->code=NULL;
1054 
1055  /* RM: Feb 17 1993 */
1056  traceline("*** Codes:\n%C= %s\n", NULL, nothing->keyword->symbol);
1057 
1059 
1060  layer=nothing->parents;
1061 
1062  while (layer) {
1063  l=layer;
1064  do {
1065  xdef=(ptr_definition)l->value_1;
1066  if (xdef->code==NOT_CODED && xdef!=top) {
1067 
1068  kids=xdef->children;
1069  code=two_to_the(p);
1070 
1071  while (kids) {
1072  kdef=(ptr_definition)kids->value_1;
1073  or_codes(code,kdef->code);
1074  kids=kids->next;
1075  }
1076 
1077  xdef->code=code;
1078  gamma_table[p]=xdef;
1079 
1080  /* RM: Feb 17 1993 */
1081  traceline("%C = %s\n", code, xdef->keyword->symbol);
1082  p=p+1;
1083  }
1084 
1085  l=l->next;
1086 
1087  } while (l);
1088 
1089  l=layer;
1090  layer=NULL;
1091 
1092  do {
1093  xdef=(ptr_definition)l->value_1;
1094  dads=xdef->parents;
1095 
1096  while (dads) {
1097  ddef=(ptr_definition)dads->value_1;
1098  if(ddef->code==NOT_CODED) {
1099 
1100  possible=TRUE;
1101  kids=ddef->children;
1102 
1103  while(kids && possible) {
1104  kdef=(ptr_definition)kids->value_1;
1105  if(kdef->code==NOT_CODED)
1106  possible=FALSE;
1107  kids=kids->next;
1108  }
1109  if(possible)
1110  layer=cons((GENERIC)ddef,layer);
1111  }
1112  dads=dads->next;
1113  }
1114  l=l->next;
1115  } while(l);
1116  }
1117 
1118  top->code=two_to_the(p);
1119  for (i=0;i<p;i++)
1120  or_codes(top->code,two_to_the(i));
1121 
1122  gamma_table[p]=top;
1123 
1124  /* RM: Jan 13 1993 */
1125  /* Added the following line because type_count is now over generous
1126  because the same definition can be referenced several times in
1127  the symbol table because of modules
1128  */
1129  type_count=p+1;
1130  for(i=type_count;i<type_count;i++)
1131  gamma_table[i]=NULL;
1132 
1133  traceline("%C = @\n\n", top->code);
1134  equalize_codes(p/32+1);
1135 
1137 
1138  /* Inherit 'FALSE' always_check flags to all types' children */
1140 
1141  traceline("*** Encoding done, %d sorts\n",type_count);
1142 
1144  Errorline("the sorts 'real' and 'string' are not disjoint.\n");
1145  ok=FALSE;
1146  }
1147 
1148  /* RM: Dec 15 1992 I don't think this really matters any more
1149  if (overlap_type(real,alist)) {
1150  Errorline("the sorts 'real' and 'list' are not disjoint.\n");
1151  ok=FALSE;
1152  }
1153  */
1154 
1155  /* RM: Dec 15 1992 I don't think this really matters any more
1156  if (overlap_type(alist,quoted_string)) {
1157  Errorline("the sorts 'list' and 'string' are not disjoint.\n");
1158  ok=FALSE;
1159  }
1160  */
1161 
1162  if (!ok) {
1163  perr("*** Internal problem:\n");
1164  perr("*** Wild_Life may behave abnormally because some basic types\n");
1165  perr("*** have been defined incorrectly.\n\n");
1166  }
1167 
1169  types_done=TRUE;
1170  }
1171 }
long type_cyclicity(ptr_definition d, ptr_int_list anc)
Definition: types.c:907
ptr_definition * gamma_table
Definition: types.c:16
void least_sorts()
Definition: types.c:700
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)
Definition: types.c:731
void propagate_definitions()
Definition: types.c:622
void clear_coding()
Definition: types.c:685
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
ptr_keyword keyword
Definition: def_struct.h:124
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
void make_sys_type_links()
Definition: sys.c:1726
char * symbol
Definition: def_struct.h:91
long types_modified
Definition: def_glob.h:47
void inherit_always_check()
Definition: types.c:994
void traceline(char *format,...)
Definition: error.c:157
void make_type_link(ptr_definition t1, ptr_definition t2)
Definition: types.c:848
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()
Definition: types.c:716
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)
Definition: types.c:806
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)
Definition: types.c:669
ptr_int_list children
Definition: def_struct.h:131
GENERIC heap_alloc(long s)
Definition: memory.c:1518
void or_codes(ptr_int_list u, ptr_int_list v)
Definition: types.c:780
ptr_int_list next
Definition: def_struct.h:55
ptr_int_list parents
Definition: def_struct.h:130
void end_tab ( )

Definition at line 497 of file print.c.

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

498 {
499  if (indent) {
500  indx->str=(char *)heap_alloc(strlen(buffer)+1);
501  strcpy(indx->str,buffer);
502  indx++;
503  *buffer=0;
504  }
505 }
char * str
Definition: def_struct.h:311
ptr_item indx
Definition: def_glob.h:329
GENERIC heap_alloc(long s)
Definition: memory.c:1518
void end_terminal_io ( )

Definition at line 431 of file token.c.

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

432 {
433  if (inchange) {
436  old_state=NULL; /* RM: Feb 17 1993 */
437  }
438  if (outchange)
440 }
#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:399
static long outchange
Definition: token.c:397
void restore_state(ptr_psi_term t)
Definition: token.c:267
static long inchange
Definition: token.c:397
static FILE * out
Definition: token.c:398
FILE * output_stream
Definition: def_glob.h:41
void equalize_codes ( int  len)

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

808 {
809  ptr_definition d;
810  ptr_int_list c,*ci;
811  long i;
812  int w;
813 
814  for(d=first_definition;d;d=d->next)
815  if (d->type_def==(def_type)type_it) {
816  c = d->code;
817  ci = &(d->code); /* RM: Feb 15 1993 */
818  w=len;
819 
820  /* Count how many words have to be added */
821  while (c) {
822  ci= &(c->next);
823  c=c->next;
824  w--;
825  }
826  assert(w>=0);
827  /* Add the words */
828  for (i=0; i<w; i++) {
829  *ci = HEAP_ALLOC(int_list);
830  (*ci)->value_1=0;
831  ci= &((*ci)->next);
832  }
833  (*ci)=NULL;
834  }
835 }
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:104
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)
Definition: print.c:1460
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
Definition: print.c:147
void print_def_type(def_type t)
Definition: types.c:21
#define FALSE
Definition: def_const.h:128
long parse_ok
Definition: def_glob.h:171
void print_operator_kind(FILE *s, long kind)
Definition: print.c:173
#define assert(N)
Definition: memory.c:104
long eval_aim ( )

Definition at line 456 of file lefun.c.

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

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

Definition at line 826 of file lefun.c.

References check_out(), and TRUE.

828 {
829  long flag=TRUE;
830 
831  if (n) {
832  flag = eval_args(n->right);
833  flag = check_out((ptr_psi_term)n->data) && flag;
834  flag = eval_args(n->left) && flag;
835  }
836 
837  return flag;
838 }
long eval_args(ptr_node n)
Definition: lefun.c:826
long check_out(ptr_psi_term t)
Definition: lefun.c:999
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define TRUE
Definition: def_const.h:127
ptr_node right
Definition: def_struct.h:184
ptr_psi_term eval_copy ( ptr_psi_term  t,
long  heap_flag 
)

Definition at line 205 of file copy.c.

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

208 { 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)
Definition: copy.c:219
long to_heap
Definition: def_glob.h:264
#define FALSE
Definition: def_const.h:128
void eval_global_var ( ptr_psi_term  t)

Definition at line 1291 of file lefun.c.

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

1294 {
1295  deref_ptr(t);
1296 
1297  /* Global variable (not persistent) */
1298 
1299  traceline("dereferencing variable %P\n",t);
1300 
1301  /* Trails the heap RM: Nov 10 1993 */
1302  if(!t->type->global_value) {
1303 
1304  /* Trail the heap !! */
1305  {
1306  ptr_stack n;
1307  n=STACK_ALLOC(stack);
1308  n->type=psi_term_ptr;
1309  n->aaaa_3= (GENERIC *) &(t->type->global_value);
1310  n->bbbb_3= (GENERIC *) NULL;
1311  n->next=undo_stack;
1312  undo_stack=n;
1313  }
1314 
1315 
1316  clear_copy();
1318 
1319  }
1320 
1321  /* var_occurred=TRUE; RM: Feb 4 1994 */
1322 
1323  if(t->type->type_def==(def_type)global && t!=t->type->global_value) {
1324  /*traceline("dereferencing variable %P\n",t);*/
1325  push_psi_ptr_value(t,(GENERIC *)&(t->coref));
1326  t->coref=t->type->global_value;
1327  }
1328 }
ptr_psi_term init_value
Definition: def_struct.h:142
void clear_copy()
Definition: copy.c:52
#define global
Definition: def_const.h:364
GENERIC * bbbb_3
Definition: def_struct.h:218
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
Definition: login.c:443
def_type type_def
Definition: def_struct.h:133
#define NULL
Definition: def_const.h:203
void traceline(char *format,...)
Definition: error.c:157
ptr_stack undo_stack
Definition: def_glob.h:53
#define deref_ptr(P)
Definition: def_macro.h:95
type_ptr type
Definition: def_struct.h:216
ptr_psi_term global_value
Definition: def_struct.h:141
ptr_psi_term coref
Definition: def_struct.h:172
#define STACK_ALLOC(A)
Definition: def_macro.h:16
GENERIC * aaaa_3
Definition: def_struct.h:217
ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
Definition: copy.c:205
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_stack next
Definition: def_struct.h:219
#define STACK
Definition: def_const.h:148
#define psi_term_ptr
Definition: def_const.h:170
ptr_psi_term exact_copy ( ptr_psi_term  t,
long  heap_flag 
)

Definition at line 195 of file copy.c.

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

198 { 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)
Definition: copy.c:219
long to_heap
Definition: def_glob.h:264
#define FALSE
Definition: def_const.h:128
void exit_if_true ( long  exitflag)

Definition at line 40 of file lib.c.

42 {
43  if (exitflag) {
44  printf("\n\n*** Execution is not allowed to continue.\n");
45  /*exit_life(TRUE);*/
46  exit(EXIT_FAILURE);
47  }
48 }
void exit_life ( long  nl_flag)

Definition at line 2090 of file built_ins.c.

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

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

Definition at line 449 of file token.c.

References STRLEN.

451 {
452  char *r;
453  char *home; // *getenv();
454  struct passwd *pw;
455  /* char *user="eight character name"; 18.5 */
456  char userbuf[STRLEN];
457  char *user=userbuf;
458  char *t1,*t2;
459 
460  r=s;
461  if (s[0]=='~') {
462  t1=s+1;
463  t2=user;
464  while (*t1!=0 && *t1!='/') {
465  *t2= *t1;
466  *t2++;
467  *t1++;
468  }
469  *t2=0;
470  if ((int)strlen(user)>0) {
471  pw = getpwnam(user);
472  if (pw) {
473  user=pw->pw_dir;
474  r=(char *)malloc(strlen(user)+strlen(t1)+1);
475  sprintf(r,"%s%s",user,t1);
476  }
477  else
478  /* if (warning()) printf("couldn't find user '%s'.\n",user) */;
479  }
480  else {
481  home=getenv("HOME");
482  if (home) {
483  r=(char *)malloc(strlen(home)+strlen(s)+1);
484  sprintf(r,"%s%s",home,s+1);
485  }
486  else
487  /* if (warning()) printf("no HOME directory.\n") */;
488  }
489  }
490 
491  /* printf("*** Using file name: '%s'\n",r); */
492 
493  return r;
494 }
#define STRLEN
Definition: def_const.h:86
ptr_module extract_module_from_name ( char *  str)

Definition at line 111 of file modules.c.

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

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

Definition at line 992 of file lefun.c.

References check_func_flag, check_out(), and TRUE.

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

Definition at line 165 of file memory.c.

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

166 {
167  output_stream=stdout;
171  (void)abort_life(TRUE);
172  /* printf("\n*** Abort\n"); */
173  stdin_cleareof();
174  (void)open_input_file("stdin");
175 }
ptr_goal goal_stack
Definition: def_glob.h:50
#define NULL
Definition: def_const.h:203
long abort_life(int nlflag)
Definition: built_ins.c:2124
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()
Definition: token.c:42
long open_input_file(char *file)
Definition: token.c:504
ptr_choice_point choice_stack
Definition: def_glob.h:51
long featcmp ( char *  str1,
char *  str2 
)

Definition at line 89 of file trees.c.

References is_int().

91 {
92  long len1,len2,sgn1,sgn2;
93  char *s1,*s2;
94 
95  if(str1==str2)
96  return 0;
97 
98  /* if (*str1==0 && *str2==0) return 0; "" bug is unaffected -- PVR 23.2.94 */
99 
100  if(*(str1+1)==0 && *(str2+1)==0)
101  return *str1 - *str2;
102 
103 
104  s1=str1; /* Local copies of the pointers */
105  s2=str2;
106 
107  if (is_int(&s1,&len1,&sgn1)) {
108  if (is_int(&s2,&len2,&sgn2)) {
109  if (sgn1!=sgn2) return (sgn2-sgn1); /* Check signs first */
110  if (len1!=len2) return (len1-len2); /* Then check lengths */
111  return strcmp(s1,s2); /* Use strcmp only if same sign and length */
112  }
113  else
114  return -1;
115  }
116  else {
117  if (is_int(&s2,&len2,&sgn2))
118  return 1;
119  else
120  return strcmp(s1,s2);
121  }
122 }
long is_int(char **s, long *len, long *sgn)
Definition: trees.c:27
void feature_insert ( char *  keystr,
ptr_node tree,
ptr_psi_term  psi 
)

Definition at line 225 of file parser.c.

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

229 {
230  ptr_node loc;
231  ptr_psi_term stk_psi;
232 
233  // printf("before find in feature_insert feature=%s\n",keystr);
234  if ((loc=find(FEATCMP,keystr,*tree))) {
235  /* Give an error message if there is a duplicate feature: */
236  Syntaxerrorline("duplicate feature %s\n",keystr);
237  }
238  else {
239  /* If the feature does not exist, insert it. */
240  stk_psi=stack_copy_psi_term(*psi); // 19.8 */
241  stack_insert_copystr(keystr,tree,(GENERIC)stk_psi); /* 10.8 */
242  }
243 }
#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)
Definition: parser.c:183
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
unsigned long * GENERIC
Definition: def_struct.h:17
void stack_insert_copystr(char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:260
void fetch_def ( ptr_psi_term  u,
long  allflag 
)

Definition at line 1128 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, prove, push2_ptr_value(), push_goal(), RMASK, SMASK, STACK, wl_psi_term::status, traceline(), and unify.

1131 {
1132  ptr_triple_list prop;
1133  ptr_psi_term v,w;
1134  ptr_definition utype;
1135 
1136  /* Uses SMASK because called from check_out */
1138  u->status=(4 & SMASK) | (u->status & RMASK);
1139 
1140  utype=u->type;
1141  prop=u->type->properties;
1142  if (prop) {
1143 
1144  traceline("fetching definition of %P\n",u);
1145 
1146  while (prop) {
1147  if (allflag || prop->cccc_4==utype) {
1148  clear_copy();
1149  v=eval_copy(prop->aaaa_4,STACK);
1150  w=eval_copy(prop->bbbb_4,STACK);
1151 
1153 
1154  deref_ptr(v);
1155  v->status=4;
1157  (void)i_eval_args(v->attr_list);
1158  }
1159  prop=prop->next;
1160  }
1161  }
1162 }
#define prove
Definition: def_const.h:273
void push2_ptr_value(type_ptr t, GENERIC *p, GENERIC v)
Definition: login.c:531
void clear_copy()
Definition: copy.c:52
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
Definition: login.c:555
#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)
Definition: lefun.c:817
ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
Definition: copy.c:205
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_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 
)

Definition at line 1188 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, prove, push_goal(), push_ptr_value(), STACK, wl_psi_term::status, traceline(), and unify.

1193 {
1194  ptr_triple_list prop;
1195  ptr_psi_term v,w;
1196  long checked1, checked2;
1197  long m1, m2;
1198 
1199  if (!u->type->always_check) if (u->attr_list==NULL) return;
1200 
1202  u->status=4;
1203 
1204  prop=u->type->properties;
1205  if (prop) {
1206  traceline("fetching partial definition of %P\n",u);
1207 
1208  checked1 = old1attr || old1->always_check;
1209  checked2 = old2attr || old2->always_check;
1210 
1211  /* checked1 = (old1stat==4); */ /* 18.2.94 */
1212  /* checked2 = (old2stat==4); */
1213 
1214  while (prop) {
1215  /* Only do those constraints that have not yet been done: */
1216  /* In matches, mi is TRUE iff oldi <| prop->cccc_1. */
1217  if (!checked1) m1=FALSE; else (void)matches(old1,prop->cccc_4,&m1);
1218  if (!checked2) m2=FALSE; else (void)matches(old2,prop->cccc_4,&m2);
1219  if (!m1 && !m2) {
1220  /* At this point, prop->cccc_1 is an attribute that has not yet */
1221  /* been checked. */
1222  clear_copy();
1223  v=eval_copy(prop->aaaa_4,STACK);
1224  w=eval_copy(prop->bbbb_4,STACK);
1225 
1227 
1228  deref_ptr(v);
1229  v->status=4;
1231  (void)i_eval_args(v->attr_list);
1232  }
1233  prop=prop->next;
1234  }
1235  }
1236 }
#define prove
Definition: def_const.h:273
void clear_copy()
Definition: copy.c:52
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
Definition: login.c:555
long matches(ptr_definition t1, ptr_definition t2, long *smaller)
Definition: types.c:1565
#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)
Definition: lefun.c:817
ptr_psi_term eval_copy(ptr_psi_term t, long heap_flag)
Definition: copy.c:205
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_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)
Definition: login.c:360
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)

Definition at line 1622 of file built_ins.c.

References expand_file_name(), FALSE, and TRUE.

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

Definition at line 571 of file sys.c.

References BYTEDATA_DATA, FP_NONE, and make_bytedata().

574 {
575  ptr_psi_term result = make_bytedata(typ,sizeof(struct a_stream));
576  ((ptr_stream)BYTEDATA_DATA(result))->fp = fp;
577  ((ptr_stream)BYTEDATA_DATA(result))->op = FP_NONE;
578  return result;
579 }
struct a_stream * ptr_stream
#define FP_NONE
Definition: sys.c:558
#define BYTEDATA_DATA(X)
Definition: sys.c:128
Definition: sys.c:562
static ptr_psi_term make_bytedata(ptr_definition sort, unsigned long bytes)
Definition: sys.c:113
ptr_node find ( long  comp,
char *  keystr,
ptr_node  tree 
)

Definition at line 341 of file trees.c.

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

345 {
346  ptr_node result;
347  long cmp;
348  long to_do=TRUE;
349 
350  /*
351  if(comp==strcmp)
352  printf("%s ",keystr);
353  */
354 
355  do {
356  if (tree==NULL) {
357  result=NULL;
358  to_do=FALSE;
359  }
360  else {
361  if (comp == INTCMP)
362  cmp = intcmp((long)keystr,(long) (tree)->key);
363  else if (comp == FEATCMP)
364  cmp = featcmp(keystr,(tree)->key);
365  else if (comp == STRCMP)
366  cmp = strcmp(keystr,(tree)->key);
367  else
368  Errorline("Bad comp in general_insert.\n");
369 
370  if (cmp<0)
371  tree=tree->left;
372  else
373  if (cmp==0) {
374  result=tree;
375  to_do=FALSE;
376  }
377  else
378  tree=tree->right;
379  }
380  } while (to_do);
381 
382 
383  /* RM: Jan 27 1993
384  if(comp==strcmp)
385  printf("Find: '%s' -> %x\n",keystr,result);
386  */
387 
388  return result;
389 }
#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)
Definition: trees.c:12
long featcmp(char *str1, char *str2)
Definition: trees.c:89
ptr_node right
Definition: def_struct.h:184
void find_adults ( )

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

518 {
519  ptr_definition d;
520  ptr_int_list l;
521 
522  for(d=first_definition;d;d=d->next)
523  if(d->type_def==(def_type)type_it && d->parents==NULL) {
524  l=HEAP_ALLOC(int_list);
525  l->value_1=(GENERIC)d;
526  l->next=adults;
527  adults=l;
528  }
529 }
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 
)

Definition at line 399 of file trees.c.

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

402 {
403  ptr_node r=NULL;
404 
405  if(t)
406  if(t->data==p)
407  r=t;
408  else {
409  r=find_data(p,t->left);
410  if(r==NULL)
411  r=find_data(p,t->right);
412  }
413 
414  return r;
415 }
ptr_node find_data(GENERIC p, ptr_node t)
Definition: trees.c:399
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)

Definition at line 48 of file modules.c.

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

51 {
52  ptr_node nodule;
53 
54  nodule=find(FEATCMP,(char *)module,module_table);
55  if(nodule)
56  return (ptr_module)(nodule->data);
57  else
58  return NULL;
59 }
ptr_node module_table
Definition: modules.c:12
#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)
Definition: trees.c:341
void forbid_variables ( ptr_node  n)

Definition at line 309 of file print.c.

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

311 {
312  ptr_psi_term v;
313 
314  if(n) {
316  v=(ptr_psi_term )n->data;
317  deref_ptr(v);
318  (void)heap_insert(INTCMP,(char *)v,&printed_pointers,(GENERIC)n->key);
320  }
321 }
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)
Definition: trees.c:276
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 ( )

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

1431 {
1432  GENERIC addr;
1433  struct tms garbage_start_time,garbage_end_time;
1434  long start_number_cells, end_number_cells;
1435 
1436  start_number_cells = (stack_pointer-mem_base) + (mem_limit-heap_pointer);
1437 
1438  (void)times(&garbage_start_time);
1439 
1440  /* Time elapsed since last garbage collection */
1441  life_time=(garbage_start_time.tms_utime - last_garbage_time.tms_utime)/60.0;
1442 
1443 
1444  if (verbose) {
1445  fprintf(stderr,"*** Garbage Collect "); /* RM: Jan 26 1993 */
1446  fprintf(stderr,"\n*** Begin");
1448  (void)fflush(stderr);
1449  }
1450 
1451 
1452  /* reset the other base */
1453  for (addr = other_base; addr < other_limit; addr ++)
1454  *addr = 0;
1455 
1456  pass=1;
1457 
1458  check();
1459 #ifdef GCVERBOSE
1460  fprintf(stderr,"- Done pass 1 ");
1461 #endif
1462 
1464  compress();
1465 #ifdef GCVERBOSE
1466  fprintf(stderr,"- Done compress ");
1467 #endif
1468 
1469  pass=2;
1470 
1471  check();
1473 #ifdef GCVERBOSE
1474  fprintf(stderr,"- Done pass 2\n");
1475 #endif
1476 
1477  clear_copy();
1478 
1481 
1482  (void)times(&garbage_end_time);
1483  gc_time=(garbage_end_time.tms_utime - garbage_start_time.tms_utime)/60.0;
1485 
1486  if (verbose) {
1487  fprintf(stderr,"*** End ");
1488  print_gc_info(TRUE); /* RM: Jan 26 1993 */
1489  stack_info(stderr);
1490  (void)fflush(stderr);
1491  }
1492 
1493  last_garbage_time=garbage_end_time;
1494 
1495  end_number_cells = (stack_pointer-mem_base) + (mem_limit-heap_pointer);
1496  assert(end_number_cells<=start_number_cells);
1497 
1498  ignore_eff=FALSE;
1499 
1500 }
ptr_node printed_pointers
Definition: def_glob.h:28
static void check()
Definition: memory.c:1208
void clear_copy()
Definition: copy.c:52
GENERIC mem_limit
Definition: def_glob.h:13
static float gc_time
Definition: memory.c:23
long verbose
Definition: def_glob.h:273
static long pass
Definition: memory.c:17
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)
Definition: memory.c:1396
#define TRUE
Definition: def_const.h:127
static float life_time
Definition: memory.c:23
#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()
Definition: memory.c:195
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()
Definition: memory.c:121
static struct tms last_garbage_time
Definition: memory.c:22
#define assert(N)
Definition: memory.c:104
ptr_node general_insert ( long  comp,
char *  keystr,
ptr_node tree,
GENERIC  info,
long  heapflag,
long  copystr,
long  bkflag 
)

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

190 {
191  long cmp;
192  ptr_node result;
193  long to_do=TRUE;
194 
195 
196  do {
197  if (*tree==NULL) {
198  if (bkflag==1) push_ptr_value(int_ptr,(GENERIC *)tree);
199  else if (bkflag==2) push_ptr_value_global(int_ptr,(GENERIC *)tree);
200  *tree = (heapflag==HEAP) ? HEAP_ALLOC(node): STACK_ALLOC(node);
201  result= *tree;
202  (*tree)->key = copystr ? heap_copy_string(keystr) : keystr;
203  (*tree)->left=NULL;
204  (*tree)->right=NULL;
205  (*tree)->data=info;
206  to_do=FALSE;
207  }
208  else {
209  if (comp == INTCMP)
210  cmp = intcmp((long)keystr,(long) (*tree)->key);
211  else if (comp == FEATCMP)
212  cmp = featcmp(keystr,(*tree)->key);
213  else if (comp == STRCMP)
214  cmp = strcmp(keystr,(*tree)->key);
215  else
216  Errorline("Bad comp in general_insert.\n");
217 
218  if (cmp<0)
219  tree=(&((*tree)->left));
220  else
221  if (cmp==0) {
222  if (bkflag)
223  Errorline("attempt to overwrite an existing feature; ignored.\n");
224  else
225  (*tree)->data=info;
226  result= *tree;
227  to_do=FALSE;
228  }
229  else
230  tree=(&((*tree)->right));
231  }
232  } while (to_do);
233 
234  return result;
235 }
#define HEAP
Definition: def_const.h:147
#define FEATCMP
Definition: def_const.h:257
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
#define INTCMP
Definition: def_const.h:256
void push_ptr_value_global(type_ptr t, GENERIC *p)
Definition: login.c:488
char * heap_copy_string(char *s)
Definition: trees.c:147
#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)
Definition: trees.c:12
#define STACK_ALLOC(A)
Definition: def_macro.h:16
long featcmp(char *str1, char *str2)
Definition: trees.c:89
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 
)

Definition at line 20 of file templates.c.

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

24 {
25  ptr_node n;
26 
27 
28  if ((n = find (FEATCMP, number, g->attr_list)))
29  return (*arg = (ptr_psi_term) n->data) ? TRUE: FALSE;
30  else
31  return FALSE;
32 }
#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)
Definition: trees.c:341
ptr_node attr_list
Definition: def_struct.h:171
GENERIC get_attr ( ptr_psi_term  t,
char *  attrname 
)

Definition at line 210 of file token.c.

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

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

Definition at line 1207 of file modules.c.

References deref_ptr, Errorline(), FALSE, find_module(), NULL, overlap_type(), quoted_string, and TRUE.

1211 {
1212  int success=TRUE;
1213  char *s;
1214 
1215  *module=NULL;
1216 
1217  deref_ptr(psi);
1218  if(overlap_type(psi->type,quoted_string) && psi->value_3)
1219  s=(char *)psi->value_3;
1220  else
1221  s=psi->type->keyword->symbol;
1222 
1223  *module=find_module(s);
1224  if(!(*module)) {
1225  Errorline("undefined module \"%s\"\n",s);
1226  success=FALSE;
1227  }
1228 
1229  return success;
1230 }
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)
Definition: types.c:1486
void Errorline(char *format,...)
Definition: error.c:414
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
GENERIC value_3
Definition: def_struct.h:170
ptr_module find_module(char *module)
Definition: modules.c:48
ptr_definition type
Definition: def_struct.h:165
void get_one_arg ( ptr_node  t,
ptr_psi_term a 
)

Definition at line 86 of file login.c.

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

89 {
90  ptr_node n;
91 
92  *a=NULL;
93  if (t) {
94  if (t->key==one) {
95  *a=(ptr_psi_term)t->data;
96  }
97  else {
98  n=find(FEATCMP,one,t);
99  if (n==NULL)
100  *a=NULL;
101  else
102  *a=(ptr_psi_term)n->data;
103  }
104  }
105 }
#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)
Definition: trees.c:341
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void get_one_arg_addr ( ptr_node  t,
ptr_psi_term **  a 
)

Definition at line 115 of file login.c.

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

118 {
119  ptr_node n;
120  // ptr_psi_term *b;
121 
122  *a=NULL;
123  if (t) {
124  if (t->key==one)
125  *a= (ptr_psi_term *)(&t->data);
126  else {
127  n=find(FEATCMP,one,t);
128  if (n==NULL)
129  *a=NULL;
130  else
131  *a= (ptr_psi_term *)(&n->data);
132  }
133  }
134 }
#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)
Definition: trees.c:341
long get_real_value ( ptr_psi_term  t,
REAL v,
long *  n 
)

Definition at line 246 of file built_ins.c.

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

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

Definition at line 219 of file token.c.

References get_attr(), and STREAM.

221 {
222  return (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
223 }
#define STREAM
Definition: def_const.h:225
GENERIC get_attr(ptr_psi_term t, char *attrname)
Definition: token.c:210
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 
)

Definition at line 37 of file login.c.

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

41 {
42  ptr_node n;
43 
44  *a=NULL;
45  *b=NULL;
46  if (t) {
47  if (t->key==one) {
48  *a=(ptr_psi_term )t->data;
49  n=t->right;
50  if (n)
51  if (n->key==two)
52  *b=(ptr_psi_term )n->data;
53  else {
54  n=find(FEATCMP,two,t);
55  if(n==NULL)
56  *b=NULL;
57  else
58  *b=(ptr_psi_term )n->data;
59  }
60  else
61  *b=NULL;
62  }
63  else {
64  n=find(FEATCMP,one,t);
65  if (n==NULL)
66  *a=NULL;
67  else
68  *a=(ptr_psi_term )n->data;
69  n=find(FEATCMP,two,t);
70  if (n==NULL)
71  *b=NULL;
72  else
73  *b=(ptr_psi_term )n->data;
74  }
75  }
76 }
#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)
Definition: trees.c:341
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_node right
Definition: def_struct.h:184
int GetBoolOption ( char *  name)

Definition at line 54 of file memory.c.

References GetStrOption().

56 {
57  char *s;
58  s=GetStrOption(name,"off");
59  return strcmp(s,"off");
60 }
char * name
Definition: def_glob.h:325
char * GetStrOption(char *name, char *def)
Definition: memory.c:33
int GetIntOption ( char *  name,
int  def 
)

Definition at line 64 of file memory.c.

References GetStrOption().

67 {
68  char *s;
69  char buffer_loc[40];
70  (void)snprintf(buffer_loc,40,"%d",def);
71  s=GetStrOption(name,buffer_loc);
72  return atof(s);
73 }
char * name
Definition: def_glob.h:325
char * GetStrOption(char *name, char *def)
Definition: memory.c:33
char* GetStrOption ( char *  name,
char *  def 
)

Definition at line 33 of file memory.c.

References arg_c, and arg_v.

36 {
37  int i;
38  char *result=def;
39  int l=strlen(name);
40 
41  for(i=1;i<arg_c;i++)
42  if(arg_v[i][0]=='-' && (int)strlen(arg_v[i])>=l+1)
43  if(!strncmp(arg_v[i]+1,name,l))
44  if(arg_v[i][l+1]=='=')
45  result=arg_v[i]+l+2;
46  else
47  result=arg_v[i]+l+1;
48 
49  return result;
50 }
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 
)

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

1393 {
1394  ptr_int_list c1,c2;
1395  long result=0;
1396  unsigned long v1,v2,v3;
1397  int e1,e2,b; /* RM: May 7 1993 */
1398 
1399 
1400 
1401  *c3=NULL;
1402 
1403  if (t1==t2) {
1404  result=1;
1405  *t3= t1;
1406  }
1407  else if (t1==top) {
1408  *t3= t2;
1409  if (t2==top)
1410  result=1;
1411  else
1412  result=3;
1413  }
1414  else if (t2==top) {
1415  result=2;
1416  *t3= t1;
1417  }
1418  else {
1419  /* printf("glb of %s and %s\n",
1420  t1->keyword->combined_name,
1421  t2->keyword->combined_name); */
1422 
1423  c1=t1->code;
1424  c2=t2->code;
1425 
1426  e1=TRUE;e2=TRUE;b=TRUE;
1427 
1428  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1429  result=0;
1430  while (c1 && c2) {
1431 
1432  *c3 = STACK_ALLOC(int_list);
1433  (*c3)->next=NULL;
1434 
1435  v1=(unsigned long)(c1->value_1);
1436  v2=(unsigned long)(c2->value_1);
1437  v3=v1 & v2;
1438 
1439  /* printf("v1=%d, v2=%d, v3=%d\n",v1,v2,v3); */
1440 
1441  (*c3)->value_1=(GENERIC)v3;
1442 
1443  if(v3!=v1) /* RM: May 7 1993 */
1444  e1=FALSE;
1445  if(v3!=v2)
1446  e2=FALSE;
1447  if(v3)
1448  b=FALSE;
1449 
1450  c1=c1->next;
1451  c2=c2->next;
1452  c3= &((*c3)->next);
1453  }
1454  *t3=NULL;
1455 
1456  if(b) /* RM: May 7 1993 */
1457  result=0; /* 0 if T3 = bottom */
1458  else
1459  if(e1)
1460  if(e2)
1461  result=1; /* 1 if T1 = T2 */
1462  else
1463  result=2; /* 2 if T1 <| T2 ( T3 = T1 ) */
1464  else
1465  if(e2)
1466  result=3; /* 3 if T1 |> T2 ( T3 = T2 ) */
1467  else
1468  result=4; /* 4 otherwise */
1469  }
1470  }
1471 
1472  if (!result) *t3=nothing;
1473 
1474  /* printf("result=%d\n\n",result); */
1475 
1476  return result;
1477 }
#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 
)

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

1266 {
1267  long result=0;
1268  unsigned long v1,v2,v3;
1269  ptr_int_list cd1,cd2,*cd3; /* sort codes */
1270 
1271  /* First, the cases where c1 & c2 are ptr_definitions: */
1272  if (f1 && f2) {
1273  if ((ptr_definition)c1==(ptr_definition)c2) {
1274  *c3=c1;
1275  result=1;
1276  }
1277  else if ((ptr_definition)c1==top) {
1278  *c3=c2;
1279  if ((ptr_definition)c2==top)
1280  result=1;
1281  else
1282  result=3;
1283  }
1284  else if ((ptr_definition)c2==top) {
1285  *c3=c1;
1286  result=2;
1287  }
1288  /* If both inputs are either top or the same ptr_definition */
1289  /* then can return quickly with a ptr_definition. */
1290  if (result) {
1291  *f3=TRUE; /* c3 is ptr_definition (an interned symbol) */
1292  return result;
1293  }
1294  }
1295  /* In the other cases, can't return with a ptr_definition: */
1296  cd1=(ptr_int_list)(f1?(GENERIC)((ptr_definition)c1)->code:c1);
1297  cd2=(ptr_int_list)(f2?(GENERIC)((ptr_definition)c2)->code:c2);
1298  cd3=(ptr_int_list*)c3;
1299  *f3=FALSE; /* cd3 is ptr_int_list (a sort code) */
1300  if (cd1==NOT_CODED) {
1301  if (cd2==NOT_CODED) {
1302  if (c1==c2) {
1303  *cd3=cd1;
1304  result=1;
1305  }
1306  else
1307  result=0;
1308  }
1309  else if (cd2==top->code) {
1310  *cd3=cd1;
1311  result=2;
1312  }
1313  else
1314  result=0;
1315  }
1316  else if (cd1==top->code) {
1317  if (cd2==top->code) {
1318  *cd3=cd1;
1319  result=1;
1320  }
1321  else {
1322  *cd3=cd2;
1323  result=3;
1324  }
1325  }
1326  else if (cd2==NOT_CODED)
1327  result=0;
1328  else if (cd2==top->code) {
1329  *cd3=cd1;
1330  result=2;
1331  }
1332  else while (cd1 && cd2) {
1333  /* Bit operations needed only if c1 & c2 coded & different from top */
1334  *cd3 = STACK_ALLOC(int_list);
1335  (*cd3)->next=NULL;
1336 
1337  v1=(unsigned long)(cd1->value_1);
1338  v2=(unsigned long)(cd2->value_1);
1339  v3=v1 & v2;
1340  (*cd3)->value_1=(GENERIC)v3;
1341 
1342  if (v3) {
1343  if (v3<v1 && v3<v2)
1344  result=4;
1345  else if (result!=4)
1346  if (v1<v2)
1347  result=2;
1348  else if (v1>v2)
1349  result=3;
1350  else
1351  result=1;
1352  }
1353  else if (result)
1354  if (v1 || v2)
1355  result=4;
1356 
1357  cd1=cd1->next;
1358  cd2=cd2->next;
1359  cd3= &((*cd3)->next);
1360  }
1361 
1362  return result;
1363 }
#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 
)

Definition at line 1206 of file types.c.

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

1211 {
1212  ptr_int_list code;
1213 
1214  if (!result) return FALSE;
1215  if (value1==NULL) {
1216  *value=value2;
1217  return TRUE;
1218  }
1219  if (value2==NULL) {
1220  *value=value1;
1221  return TRUE;
1222  }
1223  /* At this point, both value fields are non-NULL */
1224  /* and must be compared. */
1225 
1226  /* Get a pointer to the sort code */
1227  code = f ? ((ptr_definition)c)->code : (ptr_int_list)c;
1228 
1229  /* This rather time-consuming analysis is necessary if both objects */
1230  /* have non-NULL value fields. Note that only those objects with a */
1231  /* non-NULL value field needed for disentailment are looked at. */
1232  if (sub_CodeType(code,real->code)) {
1233  *value=value1;
1234  return (*(REAL *)value1 == *(REAL *)value2);
1235  }
1236  else if (sub_CodeType(code,quoted_string->code)) {
1237  *value=value1;
1238  return (!strcmp((char *)value1,(char *)value2));
1239  }
1240  else {
1241  /* All other sorts with 'value' fields always return TRUE, that is, */
1242  /* the value field plays no role in disentailment. */
1243  *value=value1;
1244  return TRUE;
1245  }
1246 }
long sub_CodeType()
#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 *  eval2 
)

Definition at line 2428 of file built_ins.c.

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

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

Definition at line 2482 of file built_ins.c.

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

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

Definition at line 2466 of file built_ins.c.

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

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

Definition at line 1035 of file modules.c.

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

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

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

1121 {
1122  int success=TRUE;
1123  ptr_node temp;
1124  long cmp;
1125 
1126  if(u)
1127  if(v) {
1128  /* RM: Feb 16 1993 Avoid C optimiser bug */
1129  (void)dummy_printf("%s %s\n",u->key,v->key);
1130 
1131  cmp=featcmp(u->key,v->key);
1132  if(cmp<0) {
1133  temp=u->right;
1134  u->right=NULL;
1135  success=global_unify_attr(u,v->left) && global_unify_attr(temp,v);
1136  u->right=temp;
1137  }
1138  else
1139  if(cmp>0) {
1140  temp=u->left;
1141  u->left=NULL;
1142  success=global_unify_attr(u,v->right) && global_unify_attr(temp,v);
1143  u->left=temp;
1144  }
1145  else {
1146  success=
1147  global_unify_attr(u->left,v->left) &&
1148  global_unify_attr(u->right,v->right) &&
1150  }
1151  }
1152  else
1153  success=FALSE;
1154 
1155  return success;
1156 }
int global_unify_attr(ptr_node, ptr_node)
Definition: modules.c:1117
int global_unify(ptr_psi_term u, ptr_psi_term v)
Definition: modules.c:1035
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)
Definition: login.c:2482
long featcmp(char *str1, char *str2)
Definition: trees.c:89
ptr_node right
Definition: def_struct.h:184
void go_through ( ptr_psi_term  t)

Definition at line 258 of file print.c.

References go_through_tree().

260 {
261  // ptr_list l;
262 
263  if (t->attr_list)
265 
266  /*
267  if(r=t->resid)
268  while(r) {
269  if(r->goal->pending)
270  go_through(r->goal->aaaa_1);
271  r=r->next;
272  } */
273 }
ptr_node attr_list
Definition: def_struct.h:171
void go_through_tree ( ptr_node  t)

Definition at line 236 of file print.c.

References check_pointer().

238 {
239  if (t) {
240  if (t->left) {
241  go_through_tree(t->left);
242  }
244  if (t->right) {
246  }
247  }
248 
249 }
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 
)

Definition at line 22 of file lib.c.

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

25 {
26  *f=NULL;
27  if(n) {
28  if(n->left)
29  f=group_features(f,n->left);
30  *f=n->key;
31  f++;
32  if(n->right)
33  f=group_features(f,n->right);
34  }
35 
36  return f;
37 }
#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)
Definition: lib.c:22
ptr_node right
Definition: def_struct.h:184
void handle_interrupt ( )

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

44 {
45  ptr_psi_term old_state_loc;
46  char *old_prompt;
47  int old_quiet; /* 21.1 */
48  long c,d; /* 21.12 (prev. char) */
49  long count;
50 
51  if (interrupted) printf("\n");
53  old_prompt=prompt;
54  old_quiet=quietflag; /* 21.1 */
56 
57  /* new_state(&old_state_loc); */
58  old_state_loc=input_state;
59  (void)open_input_file("stdin");
61 
62  StartAgain:
63  do {
64  printf("*** Command ");
65  prompt="(q,c,a,s,t,h)?";
66  quietflag=FALSE; /* 21.1 */
67 
68  do {
69  c=read_char();
70  } while (c!=EOLN && c>0 && c<=32);
71 
72  d=c;
73  count=0;
74  while (DIGIT(d)) { count=count*10+(d-'0'); d=read_char(); }
75 
76  while (d!=EOLN && d!=EOF) d=read_char();
77 
78  if (c=='h' || c=='?') {
79  printf("*** [Quit (q), Continue (c), Abort (a), Step (s,RETURN), Trace (t), Help (h,?)]\n");
80  }
81 
82  } while (c=='h' || c=='?');
83 
84  prompt=old_prompt;
85  quietflag=old_quiet; /* 21.1 */
86 
87  switch (c) {
88  case 'v':
89  case 'V':
90  verbose=TRUE;
91  break;
92  case 'q':
93  case 'Q':
94  case EOF:
95  if (c==EOF) printf("\n");
97  break;
98  case 'a':
99  case 'A':
100  (void)abort_life(FALSE);
101  show_count();
102  break;
103  case 'c':
104  case 'C':
105  trace=FALSE;
106  stepflag=FALSE;
107  break;
108  case 't':
109  case 'T':
110  trace=TRUE;
111  stepflag=FALSE;
112  break;
113  case 's':
114  case 'S':
115  case EOLN:
116  trace=TRUE;
117  stepflag=TRUE;
118  break;
119  case '0': case '1': case '2': case '3': case '4':
120  case '5': case '6': case '7': case '8': case '9':
121  trace=TRUE;
122  stepflag=TRUE;
123  if (count>0) {
124  stepcount=count;
125  stepflag=FALSE;
126  }
127  break;
128  default:
129  goto StartAgain;
130  }
131  input_state=old_state_loc;
133 }
void exit_life(long nl_flag)
Definition: built_ins.c:2090
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()
Definition: login.c:1085
ptr_psi_term input_state
Definition: def_glob.h:199
long steptrace
Definition: def_glob.h:274
long abort_life(int nlflag)
Definition: built_ins.c:2124
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)
Definition: token.c:267
char * prompt
Definition: def_glob.h:42
long read_char()
Definition: token.c:587
long interrupted
Definition: interrupt.c:8
void stdin_cleareof()
Definition: token.c:42
long open_input_file(char *file)
Definition: token.c:504
long has_non_alpha ( char *  s)

Definition at line 386 of file print.c.

References FALSE, ISALPHA, and TRUE.

388 {
389  while (*s) {
390  if (!ISALPHA(*s)) return TRUE;
391  s++;
392  }
393  return FALSE;
394 }
#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)

Definition at line 4799 of file built_ins.c.

References FALSE, NULL, and TRUE.

4801 {
4802  if (r==NULL) return FALSE;
4803  while (r) {
4804  if (r->aaaa_2!=NULL) return TRUE;
4805  r=r->next;
4806  }
4807  return FALSE;
4808 }
ptr_psi_term aaaa_2
Definition: def_struct.h:189
ptr_pair_list next
Definition: def_struct.h:191
#define NULL
Definition: def_const.h:203
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
int hash_code ( ptr_hash_table  table,
char *  symbol 
)

Definition at line 81 of file hash_table.c.

References rand_array.

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

Definition at line 26 of file hash_table.c.

References NULL, and wl_hash_table::size.

29 {
30  ptr_hash_table new;
31  int i;
32 
33  new=(ptr_hash_table)malloc(sizeof(struct wl_hash_table));
34  new->size=size;
35  new->used=0;
36  new->data=(ptr_keyword *)malloc(size*sizeof(ptr_keyword));
37  for(i=0;i<size;i++)
38  new->data[i]=NULL;
39  return new;
40 }
#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)

Definition at line 182 of file hash_table.c.

References hash_code().

186 {
187  int i;
188  int n;
189  char *s;
190  int c=0;
191  int t=0;
192 
193  printf("*** Hash table %lx:\n",(long)table);
194  printf("Size: %d\n",table->size);
195  printf("Used: %d\n",table->used);
196 
197  for(i=0;i<table->size;i++)
198  if(table->data[i]) {
199  t++;
200  s=table->data[i]->symbol;
201  n=hash_code(table,s);
202 
203  printf("%4d %4d %s %s\n",
204  i,
205  n,
206  i==n?"ok ":"*bad*",
207  s);
208 
209  if(i!=n)
210  c++;
211  }
212 
213  printf("Really used: %d\n",t);
214  printf("Collisions: %d = %1.3f%%\n",
215  c,
216  100.0*c/(double)t);
217 }
ptr_keyword * data
Definition: def_struct.h:114
char * symbol
Definition: def_struct.h:91
int hash_code(ptr_hash_table table, char *symbol)
Definition: hash_table.c:81
void hash_expand ( ptr_hash_table  table,
int  new_size 
)

Definition at line 48 of file hash_table.c.

References hash_insert(), and NULL.

52 {
53  ptr_keyword *old_data;
54  int old_size;
55  int i;
56 
57 
58  old_data=table->data;
59  old_size=table->size;
60 
61  table->size=new_size; /* Must be power of 2 */
62  table->used=0;
63  table->data=(ptr_keyword *)malloc(new_size*sizeof(ptr_keyword));
64 
65  for(i=0;i<new_size;i++)
66  table->data[i]=NULL;
67 
68  for(i=0;i<old_size;i++)
69  if(old_data[i])
70  hash_insert(table,old_data[i]->symbol,old_data[i]);
71 
72  free(old_data);
73 }
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)
Definition: hash_table.c:155
int hash_find ( ptr_hash_table  table,
char *  symbol 
)

Definition at line 106 of file hash_table.c.

References hash_code().

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

Definition at line 155 of file hash_table.c.

References hash_expand(), and hash_find().

160 {
161  int n;
162 
163 
164  n=hash_find(table,symbol);
165 
166  /* printf("inserting %s at %d keyword %x\n",symbol,n,keyword); */
167 
168  if(!table->data[n])
169  table->used++;
170  table->data[n]=keyword;
171 
172  if(table->used*2>table->size)
173  hash_expand(table,table->size*2);
174 }
ptr_keyword * data
Definition: def_struct.h:114
int hash_find(ptr_hash_table table, char *symbol)
Definition: hash_table.c:106
void hash_expand(ptr_hash_table table, int new_size)
Definition: hash_table.c:48
ptr_keyword hash_lookup ( ptr_hash_table  table,
char *  symbol 
)

Definition at line 133 of file hash_table.c.

References hash_find().

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

Definition at line 58 of file token.c.

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

62 {
63  ptr_psi_term t1;
64 
65  t1=heap_psi_term(4);
66  t1->type=integer;
67  t1->value_3=heap_alloc(sizeof(REAL));
68  *(REAL *)t1->value_3 = (REAL) value;
69 
70  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list), (GENERIC)t1);
71 }
#define FEATCMP
Definition: def_const.h:257
ptr_psi_term heap_psi_term(long stat)
Definition: lefun.c:63
#define REAL
Definition: def_const.h:72
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:276
char * heap_copy_string(char *s)
Definition: trees.c:147
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)
Definition: memory.c:1518
void heap_add_psi_attr ( ptr_psi_term  t,
char *  attrname,
ptr_psi_term  g 
)

Definition at line 184 of file token.c.

References FEATCMP, heap_copy_string(), and heap_insert().

188 {
189  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
190 }
#define FEATCMP
Definition: def_const.h:257
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:276
char * heap_copy_string(char *s)
Definition: trees.c:147
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 
)

Definition at line 122 of file token.c.

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

126 {
127  ptr_psi_term t1;
128 
129  t1=heap_psi_term(4);
130  t1->type=quoted_string;
131  t1->value_3=(GENERIC)heap_copy_string(str);
132 
133  (void)heap_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
134 }
#define FEATCMP
Definition: def_const.h:257
ptr_psi_term heap_psi_term(long stat)
Definition: lefun.c:63
ptr_node heap_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:276
char * heap_copy_string(char *s)
Definition: trees.c:147
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)

Definition at line 1518 of file memory.c.

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

1520 {
1521  if (s & (ALIGN-1))
1522  s = s - (s & (ALIGN-1))+ALIGN;
1523  /* assert(s % sizeof(*heap_pointer) == 0); */
1524  s /= sizeof (*heap_pointer);
1525 
1526  heap_pointer -= s;
1527 
1529  Errorline("the heap overflowed into the stack.\n");
1530 
1531  return heap_pointer;
1532 }
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)

Definition at line 202 of file parser.c.

References global_time_stamp, and HEAP_ALLOC.

204 {
205  ptr_psi_term p;
206 
207  p=HEAP_ALLOC(psi_term);
208  (*p)=t;
209 #ifdef TS
210  p->time_stamp=global_time_stamp; /* 9.6 */
211 #endif
212 
213  return p;
214 }
unsigned long global_time_stamp
Definition: login.c:19
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
char* heap_copy_string ( char *  s)

Definition at line 147 of file trees.c.

References heap_ncopy_string().

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

Definition at line 276 of file trees.c.

References FALSE, general_insert(), and HEAP.

281 {
282 
283  return general_insert(comp,keystr,tree,info,HEAP,FALSE,0L);
284 }
#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)
Definition: trees.c:184
void heap_insert_copystr ( char *  keystr,
ptr_node tree,
GENERIC  info 
)

Definition at line 245 of file trees.c.

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

249 {
250  (void)general_insert(FEATCMP,keystr,tree,info,HEAP,TRUE,0L);
251 }
#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)
Definition: trees.c:184
void heap_mod_int_attr ( ptr_psi_term  t,
char *  attrname,
long  value 
)

Definition at line 91 of file token.c.

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

95 {
96  ptr_node n;
97  ptr_psi_term t1;
98 
99  n=find(FEATCMP,attrname,t->attr_list);
100  t1=(ptr_psi_term)n->data;
101  *(REAL *)t1->value_3 = (REAL) value;
102 }
#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)
Definition: trees.c:341
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 
)

Definition at line 153 of file token.c.

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

157 {
158  ptr_node n;
159  ptr_psi_term t1;
160 
161  n=find(FEATCMP,attrname,t->attr_list);
162  t1=(ptr_psi_term)n->data;
163  t1->value_3=(GENERIC)heap_copy_string(str);
164 }
#define FEATCMP
Definition: def_const.h:257
GENERIC data
Definition: def_struct.h:185
char * heap_copy_string(char *s)
Definition: trees.c:147
GENERIC value_3
Definition: def_struct.h:170
ptr_node find(long comp, char *keystr, ptr_node tree)
Definition: trees.c:341
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
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 
)

Definition at line 128 of file trees.c.

References heap_alloc(), one, and two.

131 {
132  char *p;
133 
134  if (s==one || s==two) return s;
135 
136  p=(char *)heap_alloc(n+1);
137  strncpy(p,s,n);
138  p[n]='\0';
139 
140  return p;
141 }
char * two
Definition: def_glob.h:251
char * one
Definition: def_glob.h:250
GENERIC heap_alloc(long s)
Definition: memory.c:1518
char* heap_nice_name ( )

Definition at line 55 of file print.c.

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

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

Definition at line 63 of file lefun.c.

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

65 {
66  ptr_psi_term result;
67 
68  result=HEAP_ALLOC(psi_term);
69  result->type=top;
70  result->status=stat;
71  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
72  result->attr_list=NULL;
73  result->coref=NULL;
74 #ifdef TS
75  result->time_stamp=global_time_stamp; /* 9.6 */
76 #endif
77  result->resid=NULL;
78  result->value_3=NULL;
79 
80  return result;
81 }
ptr_residuation resid
Definition: def_struct.h:173
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term coref
Definition: def_struct.h:172
unsigned long global_time_stamp
Definition: login.c:19
ptr_definition type
Definition: def_struct.h:165
#define QUOTED_TRUE
Definition: def_const.h:123
#define HEAP_ALLOC(A)
Definition: def_macro.h:15
ptr_node attr_list
Definition: def_struct.h:171
long hidden_type ( ptr_definition  t)

Definition at line 3421 of file built_ins.c.

References comment, constant, functor, and variable.

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

Definition at line 985 of file lefun.c.

References check_func_flag, check_out(), and FALSE.

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

Definition at line 817 of file lefun.c.

References check_func_flag, eval_args(), and FALSE.

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

Definition at line 1192 of file lefun.c.

References FALSE, featcmp(), and TRUE.

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

Definition at line 211 of file copy.c.

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

213 { 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)
Definition: copy.c:219
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)
Definition: print.c:1460
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
Definition: print.c:147
void print_def_type(def_type t)
Definition: types.c:21
#define FALSE
Definition: def_const.h:128
long parse_ok
Definition: def_glob.h:171
void print_operator_kind(FILE *s, long kind)
Definition: print.c:173
#define assert(N)
Definition: memory.c:104
void inherit_always_check ( )

Definition at line 994 of file types.c.

References FALSE, and one_pass_always_check().

995 {
996  long change;
997 
998  do {
999  change=FALSE;
1000  one_pass_always_check(&change);
1001  } while (change);
1002 }
void one_pass_always_check(long *ch)
Definition: types.c:976
#define FALSE
Definition: def_const.h:128
void init_built_in_types ( )

Definition at line 5805 of file built_ins.c.

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

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

Definition at line 34 of file copy.c.

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

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

Definition at line 1337 of file lefun.c.

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

1339 {
1340  ptr_definition def;
1341 
1342  /* printf("initializing global vars...\n"); */
1343 
1344  /*
1345  for(def=first_definition;def;def=def->next) {
1346  if(def->type==global && ((GENERIC)def->global_value<heap_pointer)) {
1347  clear_copy();
1348  def->global_value=eval_copy(def->init_value,STACK);
1349  }
1350  }
1351  */
1352 
1353  for(def=first_definition;def;def=def->next)
1355  def->global_value=NULL;
1356 }
#define NULL
Definition: def_const.h:203
ptr_definition next
Definition: def_struct.h:148
ptr_definition first_definition
Definition: def_glob.h:3
ptr_psi_term global_value
Definition: def_struct.h:141
GENERIC heap_pointer
Definition: def_glob.h:12
unsigned long * GENERIC
Definition: def_struct.h:17
void init_interrupt ( )

Definition at line 28 of file interrupt.c.

References interrupt().

29 {
30  void (*f)(); /* RM: Apr 7 1993 Weird problem in GCC and C89 */
31  f=interrupt;
32  if (signal(SIGINT,SIG_IGN)!=SIG_IGN)
33  (void)signal(SIGINT,f);
34 }
void interrupt()
Definition: interrupt.c:13
void init_io ( )

Definition at line 53 of file lib.c.

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

54 {
55 #ifdef DJD_PORT_FALSE
56  struct stat buffer_loc;
57 
58  fstat(fileno(stdin), &buffer_loc);
59  /* True iff stdin is from a terminal */
60  stdin_terminal=(S_IFCHR & buffer.st_mode)!=0;
63  output_stream=stdout;
64 #else
68  output_stream=stdout;
69 #endif
70 }
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 ( )

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

1573 {
1574  alloc_words=GetIntOption("memory",ALLOC_WORDS);
1575  mem_size=alloc_words*sizeof(long);
1576 
1577  mem_base = (GENERIC) malloc(mem_size);
1578  other_base = (GENERIC) malloc(mem_size);
1579 
1580  if (mem_base && other_base) {
1581  /* Rewrote some rather poor code... RM: Mar 1 1994 */
1582  ALIGNUP(mem_base);
1584 
1585  mem_limit=mem_base+alloc_words-2;
1586  ALIGNUP(mem_limit);
1588 
1591 
1592  other_limit=other_base+alloc_words-2;
1594 
1596  buffer = (char *) malloc (PRINT_BUFFER); /* The printing buffer */
1597 
1598  /* RM: Oct 22 1993 */
1599  /* Fill the memory with rubbish data */
1600  /*
1601  {
1602  int i;
1603 
1604  for(i=0;i<alloc_words;i++) {
1605  mem_base[i]= -1234;
1606  other_base[i]= -1234;
1607  }
1608  }
1609  */
1610  }
1611  else
1612  Errorline("Wild_life could not allocate sufficient memory to run.\n\n");
1613 }
GENERIC mem_limit
Definition: def_glob.h:13
int alloc_words
Definition: def_glob.h:10
static long delta
Definition: memory.c:8
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)
Definition: memory.c:64
unsigned long * GENERIC
Definition: def_struct.h:17
void init_modules ( )

Definition at line 30 of file modules.c.

References create_module(), and set_current_module().

31 {
32  bi_module=create_module("built_ins");
33  no_module=create_module("no_module");
35  syntax_module=create_module("syntax");
36  user_module=create_module("user"); /* RM: Jan 27 1993 */
38 
40 }
ptr_module user_module
Definition: modules.c:20
ptr_module sys_module
Definition: modules.c:17
ptr_module bi_module
Definition: modules.c:15
ptr_module create_module(char *module)
Definition: modules.c:67
ptr_module x_module
Definition: modules.c:21
ptr_module no_module
Definition: modules.c:14
ptr_module set_current_module(ptr_module module)
Definition: modules.c:95
ptr_module syntax_module
Definition: modules.c:16
void init_parse_state ( )

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

382 {
383  line_count=0;
385  saved_char=0;
386  old_saved_char=0;
389  eof_flag=FALSE;
391 }
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 ( )

Definition at line 48 of file print.c.

References PRINT_POWER, and seg_format.

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

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

78 {
79 #ifdef X11
81 #endif
85  undo_stack=NULL; /* 7.8 */
86  var_tree=NULL;
87 
88  /* RM: Oct 13 1993 */
90  prompt=PROMPT;
91  else {
94  }
95 
98 
99 #ifdef X11
100  /* RM: Dec 15 1992 */
102 #endif
103 
104  init_global_vars(); /* RM: Feb 15 1993 */
105 }
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)
Definition: lib.c:40
void init_global_vars()
Definition: lefun.c:1337
#define FALSE
Definition: def_const.h:128
GENERIC mem_base
Definition: def_glob.h:11
ptr_psi_term stack_nil()
Definition: built_ins.c:29
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()
Definition: memory.c:1622
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 ( )

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

1319 {
1325  new_built_in(syntax_module,"mod",(def_type)function_it,c_mod); /* PVR 24.2.94 */
1339 }
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
Definition: built_ins.c:5054
#define function_it
Definition: def_const.h:362
static long c_shift_right()
Definition: bi_math.c:857
static long c_sin()
Definition: bi_math.c:631
static long c_mod()
Definition: bi_math.c:930
static long c_floor()
Definition: bi_math.c:487
static long c_mult()
Definition: bi_math.c:43
static long c_tan()
Definition: bi_math.c:641
static long c_cos()
Definition: bi_math.c:620
static long c_shift_left()
Definition: bi_math.c:852
static long c_div()
Definition: bi_math.c:150
static long c_log()
Definition: bi_math.c:1216
static long c_bit_or()
Definition: bi_math.c:783
ptr_module syntax_module
Definition: def_glob.h:159
static long c_bit_not()
Definition: bi_math.c:648
static long c_sub()
Definition: bi_math.c:1113
static long c_bit_and()
Definition: bi_math.c:702
static long c_add()
Definition: bi_math.c:1001
ptr_module bi_module
Definition: def_glob.h:155
static long c_sqrt()
Definition: bi_math.c:508
static long c_intdiv()
Definition: bi_math.c:276
static long c_ceiling()
Definition: bi_math.c:498
static long c_exp()
Definition: bi_math.c:1273
void insert_own_prop ( ptr_definition  d)

Definition at line 539 of file types.c.

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

541 {
542  ptr_int_list l;
543  ptr_pair_list rule;
544  ptr_triple_list *t;
545  long flag;
546 
547  l=HEAP_ALLOC(int_list);
548  l->value_1=(GENERIC)d;
549  l->next=children;
550  children=l;
551 
552  rule = d->rule;
553  while (rule) {
554  t= &(d->properties);
555  flag=TRUE;
556 
557  while (flag) {
558  if (*t)
559  if ((*t)->aaaa_4==rule->aaaa_2 && (*t)->bbbb_4==rule->bbbb_2 && (*t)->cccc_4==d)
560  flag=FALSE;
561  else
562  t= &((*t)->next);
563  else {
564  *t = HEAP_ALLOC(triple_list);
565  (*t)->aaaa_4=rule->aaaa_2;
566  (*t)->bbbb_4=rule->bbbb_2;
567  (*t)->cccc_4=d;
568  (*t)->next=NULL;
569  flag=FALSE;
570  }
571  }
572  rule=rule->next;
573  }
574 }
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 
)

Definition at line 580 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, TRUE, and wl_int_list::value_1.

583 {
584  ptr_int_list l;
585  ptr_triple_list *t;
586  long flag;
587 
588  l=HEAP_ALLOC(int_list);
589  l->value_1=(GENERIC)d;
590  l->next=children;
591  children=l;
592 
593  while (prop) {
594  t= &(d->properties);
595  flag=TRUE;
596 
597  while (flag) {
598  if (*t)
599  if ((*t)->aaaa_4==prop->aaaa_4 && (*t)->bbbb_4==prop->bbbb_4 && (*t)->cccc_4==prop->cccc_4)
600  flag=FALSE;
601  else
602  t= &((*t)->next);
603  else {
604  *t = HEAP_ALLOC(triple_list);
605  (*t)->aaaa_4=prop->aaaa_4;
606  (*t)->bbbb_4=prop->bbbb_4;
607  (*t)->cccc_4=prop->cccc_4;
608  (*t)->next=NULL;
609  flag=FALSE;
610  }
611  }
612  prop=prop->next;
613  }
614 }
#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 ( )

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

1761 {
1762  ptr_module curmod = current_module;
1764 
1765  sys_bytedata =update_symbol(sys_module,"bytedata"); /* DENYS: BYTEDATA */
1766  sys_bitvector =update_symbol(sys_module,"bitvector");
1767  sys_regexp =update_symbol(sys_module,"regexp");
1768  sys_stream =update_symbol(sys_module,"stream");
1769  sys_file_stream =update_symbol(sys_module,"file_stream");
1770  sys_socket_stream =update_symbol(sys_module,"socket_stream");
1771  sys_process_no_children=update_symbol(sys_module,"process_no_children");
1772  sys_process_exited =update_symbol(sys_module,"process_exited");
1773  sys_process_signaled =update_symbol(sys_module,"process_signaled");
1774  sys_process_stopped =update_symbol(sys_module,"process_stopped");
1775  sys_process_continued =update_symbol(sys_module,"process_continued");
1776 
1777  /* DENYS: BYTEDATA */
1778  /* purely for illustration
1779  new_built_in(sys_module,"string_to_bytedata",(def_type)function_it,c_string_to_bytedata);
1780  new_built_in(sys_module,"bytedata_to_string",(def_type)function_it,c_bytedata_to_string);
1781  */
1824 #ifdef LIFE_DBM
1826 #endif
1827 #ifdef LIFE_NDBM
1828  insert_ndbm_builtins();
1829 #endif
1832  (void)set_current_module(curmod);
1833 }
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
Definition: built_ins.c:5054
#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()
Definition: sys.c:155
static long c_bitvector_not()
Definition: sys.c:308
static long c_wait()
Definition: sys.c:1437
ptr_module current_module
Definition: def_glob.h:161
static long c_accept()
Definition: sys.c:1212
static long c_fwrite()
Definition: sys.c:664
static long c_call_once()
Definition: sys.c:1662
static long c_stream2sys_stream()
Definition: sys.c:974
static long c_ftell()
Definition: sys.c:924
static long c_regexp_compile()
Definition: sys.c:453
static long c_int2stream()
Definition: sys.c:598
static long c_kill()
Definition: sys.c:1470
ptr_definition sys_file_stream
Definition: def_glob.h:133
static long c_fseek()
Definition: sys.c:955
static long c_get_record()
Definition: sys.c:883
ptr_definition sys_stream
Definition: def_glob.h:132
static long c_getpid()
Definition: sys.c:1715
static long c_get_code()
Definition: sys.c:903
static long c_bitvector_set()
Definition: sys.c:387
static long c_fclose()
Definition: sys.c:642
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
static long c_apply1()
Definition: sys.c:1698
static long c_bitvector_xor()
Definition: sys.c:238
static long c_fflush()
Definition: sys.c:684
static long c_fopen()
Definition: sys.c:623
static long c_connect()
Definition: sys.c:1157
static long c_listen()
Definition: sys.c:1179
static long c_import_symbol()
Definition: sys.c:1305
static long c_waitpid()
Definition: sys.c:1453
ptr_definition sys_process_signaled
Definition: sys.c:1379
ptr_definition sys_bitvector
Definition: def_glob.h:130
static long c_fork()
Definition: sys.c:1326
ptr_definition sys_process_stopped
Definition: sys.c:1380
ptr_definition sys_process_continued
Definition: sys.c:1381
static long c_bitvector_count()
Definition: sys.c:314
void insert_dbm_builtins()
static long c_wait_on_feature()
Definition: sys.c:1590
static long c_bind()
Definition: sys.c:1146
static long c_errno()
Definition: sys.c:1231
static long c_regexp_execute()
Definition: sys.c:538
ptr_module sys_module
Definition: def_glob.h:162
static long c_cuserid()
Definition: sys.c:1494
static long c_bitvector_or()
Definition: sys.c:232
static long c_socket()
Definition: sys.c:1059
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:1378
static long c_bitvector_and()
Definition: sys.c:226
static long c_lazy_project()
Definition: sys.c:1552
static long c_my_wait_on_feature()
Definition: sys.c:1628
static long c_bitvector_get()
Definition: sys.c:381
static long c_bitvector_clear()
Definition: sys.c:393
ptr_module bi_module
Definition: def_glob.h:155
static long c_sys_stream2stream()
Definition: sys.c:994
static long c_gethostname()
Definition: sys.c:1516
ptr_module set_current_module(ptr_module module)
Definition: modules.c:95
static long c_get_buffer()
Definition: sys.c:710
ptr_definition sys_process_no_children
Definition: sys.c:1377
static long c_errmsg()
Definition: sys.c:1253
void insert_system_builtins ( )

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

627 {
634  new_built_in(bi_module,"quiet",(def_type)function_it,c_quiet); /* 21.1 */
646 }
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
Definition: built_ins.c:5054
static long c_mresiduate()
Definition: bi_sys.c:581
static long c_garbage()
Definition: bi_sys.c:299
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
static long c_step()
Definition: bi_sys.c:79
static long c_realtime()
Definition: bi_sys.c:201
static long c_verbose()
Definition: bi_sys.c:93
static long c_residuate()
Definition: bi_sys.c:550
static long c_getenv()
Definition: bi_sys.c:313
long c_trace()
Definition: bi_sys.c:20
static long c_warning()
Definition: bi_sys.c:111
static long c_system()
Definition: bi_sys.c:349
static long c_cputime()
Definition: bi_sys.c:175
static long c_residList()
Definition: bi_sys.c:504
static long c_encode()
Definition: bi_sys.c:395
static long c_localtime()
Definition: bi_sys.c:231
ptr_module bi_module
Definition: def_glob.h:155
static long c_maxint()
Definition: bi_sys.c:129
static long c_statistics()
Definition: bi_sys.c:265
long c_tprove()
Definition: bi_sys.c:65
long c_quiet()
Definition: bi_sys.c:155
void insert_translation ( ptr_psi_term  a,
ptr_psi_term  b,
long  info 
)

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

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

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

656 {
657  /* Sort comparisons */
670 
671 
672  /* Type checks */
679 
680  /* Sort hierarchy maneuvering */
687 }
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
Definition: built_ins.c:5054
static long c_isa_cmp()
Definition: bi_type.c:344
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
static long c_smallest()
Definition: bi_type.c:149
long c_lub()
Definition: bi_type.c:614
static long c_is_number()
Definition: bi_type.c:490
static long c_is_predicate()
Definition: bi_type.c:413
static long c_isa_lt()
Definition: bi_type.c:299
static long c_isa_ncmp()
Definition: bi_type.c:349
long c_glb()
Definition: bi_type.c:553
static long c_children()
Definition: bi_type.c:26
static long c_isa_nle()
Definition: bi_type.c:319
static long c_isa_ge()
Definition: bi_type.c:304
long c_isa_subsort()
Definition: bi_type.c:515
static long c_isa_nlt()
Definition: bi_type.c:324
static long c_isa_ngt()
Definition: bi_type.c:334
static long c_isa_gt()
Definition: bi_type.c:309
ptr_module syntax_module
Definition: def_glob.h:159
static long c_is_value()
Definition: bi_type.c:465
static long c_isa_nge()
Definition: bi_type.c:329
static long c_parents()
Definition: bi_type.c:89
static long c_is_sort()
Definition: bi_type.c:438
static long c_is_function()
Definition: bi_type.c:359
static long c_isa_eq()
Definition: bi_type.c:314
ptr_module bi_module
Definition: def_glob.h:155
static long c_isa_le()
Definition: bi_type.c:294
static long c_is_persistent()
Definition: bi_type.c:384
static long c_isa_neq()
Definition: bi_type.c:339
void insert_variables ( ptr_node  vars,
long  force 
)

Definition at line 281 of file print.c.

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

284 {
285  ptr_psi_term p;
286  ptr_node n;
287 
288  if(vars) {
289  insert_variables(vars->right,force);
290  p=(ptr_psi_term )vars->data;
291  deref_ptr(p);
292  n=find(INTCMP,(char *)p,pointer_names);
293  if (n)
294  if (n->data || force)
295  n->data=(GENERIC)vars->key;
296  insert_variables(vars->left,force);
297  }
298 }
#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)
Definition: trees.c:341
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 
)

Definition at line 12 of file trees.c.

16 {
17 #ifdef CMPDBG
18  printf("intcmp a = %ld b = %ld a - b = %ld\n", a ,b , a - b);
19 #endif
20  return a - b;
21 }
void interrupt ( )

Definition at line 13 of file interrupt.c.

References interrupted, and TRUE.

14 {
15  void (*f)(); /* RM: Apr 7 1993 Weird problem in GCC and C89 */
16 
18  f=interrupt;
19  (void)signal(SIGINT,f);/* RM: Feb 15 1993 */
20 }
void interrupt()
Definition: interrupt.c:13
#define TRUE
Definition: def_const.h:127
long interrupted
Definition: interrupt.c:8
GENERIC intListNext ( ptr_int_list  p)

Definition at line 430 of file bi_sys.c.

432 {
433  return (GENERIC )(p->next);
434 }
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)

Definition at line 424 of file bi_sys.c.

References makePsiTerm().

426 {
427  return makePsiTerm((void *)p->value_1);
428 }
ptr_psi_term makePsiTerm(ptr_definition x)
Definition: bi_sys.c:468
GENERIC value_1
Definition: def_struct.h:54
long is_built_in ( ptr_pair_list  r)

Definition at line 4811 of file built_ins.c.

References MAX_BUILT_INS.

4813 {
4814  return ((unsigned long)r>0 && (unsigned long)r<MAX_BUILT_INS);
4815 }
#define MAX_BUILT_INS
Definition: def_const.h:82
long is_int ( char **  s,
long *  len,
long *  sgn 
)

Definition at line 27 of file trees.c.

References FALSE, and TRUE.

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

Definition at line 408 of file print.c.

References DIGIT, FALSE, and TRUE.

410 {
411  if (!*s) return FALSE;
412  if (*s=='-') s++;
413  while (*s) {
414  if (!DIGIT(*s)) return FALSE;
415  s++;
416  }
417  return TRUE;
418 }
#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)

Definition at line 1068 of file sys.c.

References NULL.

1070 {
1071  if (s==NULL) return 0;
1072  while (*s)
1073  if (!isdigit(*s) && *s!='.') return 0;
1074  else s++;
1075  return 1;
1076 }
#define NULL
Definition: def_const.h:203
int isSubTypeValue ( ptr_psi_term  arg1,
ptr_psi_term  arg2 
)

Definition at line 163 of file bi_type.c.

References FALSE, integer, quoted_string, REAL, real, and TRUE.

165 {
166  long ans=TRUE;
167 
168  /* we already know that either arg1->type == arg2->type or that at both
169  * of the two are either long or real
170  */
171 
172  if (arg2->value_3) {
173  if (arg1->value_3) {
174  if (arg1->type==real || arg1->type==integer) {
175  ans=( *(REAL *)arg1->value_3 == *(REAL *)arg2->value_3);
176  }
177  else if (arg1->type==quoted_string) {
178  ans=(strcmp((char *)arg1->value_3,(char *)arg2->value_3)==0);
179  }
180  }
181  else
182  ans=FALSE;
183  }
184  else {
185  if (arg1->value_3 && (arg1->type==real || arg1->type==integer)) {
186  if (arg2->type==integer)
187  ans=(*(REAL *)arg1->value_3 == floor(*(REAL *)arg1->value_3));
188  else
189  ans=TRUE;
190  }
191  }
192  return ans;
193 }
#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)

Definition at line 541 of file bi_type.c.

References NULL.

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

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

702 {
703  ptr_definition d;
704 
705  for(d=first_definition;d;d=d->next)
706  if (d->type_def==(def_type)type_it && d->children==NULL && d!=nothing)
708 }
def_type type_def
Definition: def_struct.h:133
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
#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)

Definition at line 861 of file token.c.

References DIGIT, LOWER, and UPPER.

863 {
864  return
865  UPPER(c) ||
866  LOWER(c) ||
867  DIGIT(c);
868 
869  /* || c=='\'' RM: Dec 16 1992 */ ;
870 }
#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 
)

Definition at line 63 of file list.c.

References NULL.

66 {
67  RefListGetLinksProc getLinks = header->GetLinks;
68 
69  /* Link to the end of list */
70 
71  if (header->Last != NULL)
72  (*getLinks)(header->Last)->Next = atom;
73 
74  else /* The list is empty */
75  header->First = atom;
76 
77  /* Update links of atom to insert */
78 
79  (*getLinks)(atom)->Prev = header->Last;
80  (*getLinks)(atom)->Next = NULL;
81 
82  /* Update last element of header */
83 
84  header->Last = atom;
85 }
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)

Definition at line 410 of file list.c.

References List_CountAtom(), and List_Enum().

412 {
413  long n = 0;
414 
415  (void)List_Enum (header,(RefListEnumProc) List_CountAtom, &n);
416  return n;
417 }
int(* RefListEnumProc)()
Definition: def_struct.h:262
static long List_CountAtom(Ref p, Ref nbR)
Definition: list.c:400
long List_Enum(RefListHeader header, RefListEnumProc proc, Ref closure)
Definition: list.c:341
void List_Concat ( RefListHeader  header1,
RefListHeader  header2 
)

Definition at line 277 of file list.c.

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

280 {
281  RefListGetLinksProc getLinks = header1->GetLinks;
282 
283  if (header1->GetLinks == header2->GetLinks)
284  {
285 #ifdef prlDEBUG
286  OS_PrintMessage ("List_Concat: ERROR concat different lists\n");
287 #endif
288  return;
289  }
290 
291  /* Concatenate only if the second list is not empty */
292 
293  if (header2->First != NULL)
294  {
295  /* Obvious concatenate when the first list is empty */
296 
297  if (header1->First == NULL)
298  header1->First = header2->First;
299 
300  else /* Concatenate the two non empty lists */
301  {
302  (*getLinks)(header1->Last)->Next = header2->First;
303  (*getLinks)(header2->First)->Prev = header1->Last;
304  }
305  header1->Last = header2->Last;
306  }
307 }
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 
)

Definition at line 429 of file list.c.

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

433 {
434  RefListGetLinksProc getLinks = header->GetLinks;
435 
436  if (atom != List_Last (header))
437  {
438  newHeader->First = List_Next (header, atom);
439  newHeader->Last = header->Last;
440 
441  header->Last = atom;
442 
443  /* Update the links */
444  (*getLinks)(atom)->Next = NULL;
445  (*getLinks)(newHeader->First)->Prev = NULL;
446  }
447 }
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 
)

Definition at line 341 of file list.c.

References List_EnumFrom().

353 {
354  return (List_EnumFrom (header, header->First, proc, closure));
355 }
long List_EnumFrom(RefListHeader header, Ref atom, RefListEnumProc proc, Ref closure)
Definition: list.c:311
long List_EnumBack ( RefListHeader  header,
RefListEnumProc  proc,
Ref  closure 
)

Definition at line 389 of file list.c.

References List_EnumBackFrom().

393 {
394  return (List_EnumBackFrom (header, header->Last, proc, closure));
395 }
long List_EnumBackFrom(RefListHeader header, Ref atom, RefListEnumProc proc, Ref closure)
Definition: list.c:359
long List_EnumBackFrom ( RefListHeader  header,
Ref  atom,
RefListEnumProc  proc,
Ref  closure 
)

Definition at line 359 of file list.c.

References List_Prev, NULL, and TRUE.

364 {
365  Ref cur, prev;
366  int notInterrupted = TRUE;
367 
368 #ifdef prlDEBUG
369  header->Lock += 1;
370 #endif
371 
372  cur = atom;
373  while (cur != NULL && notInterrupted)
374  {
375  prev = List_Prev (header, cur);
376  notInterrupted = (*proc)(cur, closure);
377  cur = prev;
378  }
379 
380 #ifdef prlDEBUG
381  header->Lock -=1;
382 #endif
383 
384  return (notInterrupted);
385 }
#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 
)

Definition at line 311 of file list.c.

References List_Next, NULL, and TRUE.

316 {
317  Ref cur, next;
318  int notInterrupted = TRUE;
319 
320 #ifdef prlDEBUG
321  header->Lock += 1;
322 #endif
323 
324  cur = atom;
325  while (cur != NULL && notInterrupted)
326  {
327  next = List_Next (header, cur);
328  notInterrupted = (*proc)(cur, closure);
329  cur = next;
330  }
331 
332 #ifdef prlDEBUG
333  header->Lock -=1;
334 #endif
335 
336  return (notInterrupted);
337 }
#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 
)

Definition at line 119 of file list.c.

References List_InsertAhead(), and NULL.

123 {
124  RefListGetLinksProc getLinks = header->GetLinks;
125 
126 #ifdef prlDEBUG
127  if (header->Lock > 1)
128  OS_PrintMessage ("List_InsertAfter: Warning insert after on recursive List_Enum call !!\n");
129 #endif
130 
131  if (mark != NULL)
132  {
133  (*getLinks)(atom)->Prev = mark;
134 
135  if (mark != header->Last)
136  {
137  (*getLinks)(atom)->Next = (*getLinks)(mark)->Next;
138  (*getLinks)((*getLinks)(mark)->Next)->Prev = atom;
139  }
140  else /* Insert at the end of the list */
141  {
142  (*getLinks)(atom)->Next = NULL;
143  header->Last = atom;
144  }
145 
146  (*getLinks)(mark)->Next = atom;
147  }
148  else /* Insert ahead the list */
149  List_InsertAhead (header, atom);
150 }
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)
Definition: list.c:39
void List_InsertAhead ( RefListHeader  header,
Ref  atom 
)

Definition at line 39 of file list.c.

References NULL.

42 {
43  RefListGetLinksProc getLinks = header->GetLinks;
44 
45  /* Update links of atom to insert */
46 
47  (*getLinks)(atom)->Next = header->First;
48  (*getLinks)(atom)->Prev = NULL;
49 
50  /* Link to the head of list */
51 
52  if (header->First != NULL)
53  (*getLinks)(header->First)->Prev = atom;
54 
55  else /* The list is empty */
56  header->Last = atom;
57 
58  header->First = atom;
59 }
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 
)

Definition at line 89 of file list.c.

References List_Append(), wl_ListLinks::Next, and NULL.

93 {
94  RefListGetLinksProc getLinks = header->GetLinks;
95 
96  if (mark != NULL)
97  {
98  (*getLinks)(atom)->Next = mark;
99 
100  if (mark != header->First)
101  {
102  (*getLinks)(atom)->Prev = (*getLinks)(mark)->Prev;
103  (*getLinks)((*getLinks)(mark)->Prev)->Next = atom;
104  }
105  else /* Insert ahead the list */
106  {
107  (*getLinks)(atom)->Prev = NULL;
108  header->First = atom;
109  }
110 
111  (*getLinks)(mark)->Prev = atom;
112  }
113  else /* Append to the list */
114  List_Append (header, atom);
115 }
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)
Definition: list.c:63
long List_IsUnlink ( RefListLinks  links)

Definition at line 421 of file list.c.

References NULL.

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

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

258 {
259  psi_term nihil;
260 
261  if(type==disjunction) /* RM: Feb 1 1993 */
262  nihil.type=disj_nil;
263  else
264  nihil.type=nil;
265 
266  nihil.status=0;
267  nihil.flags=FALSE; /* 14.9 */
268  nihil.attr_list=NULL;
269  nihil.resid=NULL;
270  nihil.value_3=NULL;
271  nihil.coref=NULL;
272 
273  return nihil;
274 }
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 
)

Definition at line 230 of file list.c.

References NULL.

233 {
234 /*-----------------------------------------------------------------------------
235 
236 WARNING
237  - The container is 'updated' two times if the first and last atom
238  of list is the only one to remove.
239 
240 -----------------------------------------------------------------------------*/
241 
242  RefListGetLinksProc getLinks = header->GetLinks;
243 
244 #ifdef prlDEBUG
245  if (header->Lock > 1)
246  OS_PrintMessage ("List_Remove: Warning remove on recursive List_Enum call !!\n");
247 #endif
248 
249  /* Update the DownStream links */
250 
251  if ((*getLinks)(atom)->Prev != NULL)
252  {
253  (*getLinks)((*getLinks)(atom)->Prev)->Next =
254  (*getLinks)(atom)->Next;
255  }
256  else /* Atom is the first of list */
257  header->First = (*getLinks)(atom)->Next;
258 
259  /* Update the UpStream links */
260 
261  if ((*getLinks)(atom)->Next != NULL)
262  {
263  (*getLinks)((*getLinks)(atom)->Next)->Prev =
264  (*getLinks)(atom)->Prev;
265  }
266  else /* Atom is the last of list */
267  header->Last = (*getLinks)(atom)->Prev;
268 
269  /* Reset the atom links */
270 
271  (*getLinks)(atom)->Prev = NULL;
272  (*getLinks)(atom)->Next = NULL;
273 }
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)

Definition at line 206 of file list.c.

References List_SwapLinks(), and NULL.

208 {
209  Ref cur, next;
210  RefListGetLinksProc getLinks = header->GetLinks;
211 
212  /* This traverse cannot be done with function List_Enum() */
213 
214  cur = header->First;
215 
216  /* Swap the headers */
217  header->First = header->Last;
218  header->Last = cur;
219 
220  while (cur != NULL)
221  {
222  next = (*getLinks)(cur)->Next;
223  (void)List_SwapLinks (header, cur);
224  cur = next;
225  }
226 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
static long List_SwapLinks(RefListHeader header, Ref atom)
Definition: list.c:193
#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 
)

Definition at line 21 of file list.c.

References NULL.

24 {
25  header->First = NULL;
26  header->Last = NULL;
27 
28 #ifdef prlDEBUG
29  header->Lock = 0;
30 #endif
31 
32  header->GetLinks = getLinks;
33 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
#define NULL
Definition: def_const.h:203
void list_special ( ptr_psi_term  t)

Definition at line 4820 of file built_ins.c.

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

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

Definition at line 154 of file list.c.

158 {
159  RefListGetLinksProc getLinks = header->GetLinks;
160 
161  /* Don't swap if the input is wrong */
162 
163  if ((*getLinks)(first)->Next != second)
164  {
165 #ifdef prlDEBUG
166  OS_PrintMessage ("List_Swap: WARNING wrong input data, swap not done..\n");
167 #endif
168  return;
169  }
170 
171  /* Special Cases */
172 
173  if (header->First == first)
174  header->First = second;
175  else
176  (*getLinks)((*getLinks)(first)->Prev)->Next = second;
177 
178  if (header->Last == second)
179  header->Last = first;
180  else
181  (*getLinks)((*getLinks)(second)->Next)->Prev = first;
182 
183  /* Swap the atoms */
184 
185  (*getLinks)(second)->Prev = (*getLinks)(first)->Prev;
186  (*getLinks)(first)->Next = (*getLinks)(second)->Next;
187  (*getLinks)(first)->Prev = second;
188  (*getLinks)(second)->Next = first;
189 }
RefListGetLinksProc GetLinks
Definition: def_struct.h:288
RefListLinks(* RefListGetLinksProc)()
Definition: def_struct.h:261
void listing_pred_write ( ptr_node  n,
long  fflag 
)

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

1344 {
1345  long old_print_depth;
1346 
1348  func_flag=fflag;
1349  indent=TRUE;
1350  const_quote=TRUE;
1356  old_print_depth=print_depth;
1358  main_pred_write(n);
1359  print_depth=old_print_depth;
1360  (void)fflush(outfile);
1361 }
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 ( )

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

2105 {
2106  long success=TRUE,exitloop;
2107  ptr_psi_term s;
2108  long sort;
2109  char *fn;
2110  long old_noisy,old_file_date;
2111  ptr_node old_var_tree;
2112  ptr_choice_point cutpt;
2113  long old_var_occurred; /* 18.8 */
2114  int end_of_file=FALSE; /* RM: Jan 27 1993 */
2115 
2116 
2120  old_file_date=file_date;
2121  file_date=(unsigned long)aim->bbbb_1;
2122  old_noisy=noisy;
2123  noisy=FALSE;
2124  fn=(char*)aim->cccc_1;
2125  exitloop=FALSE;
2126 
2127 
2128 
2129  do {
2130  /* Variables in queries in files are *completely independent* of top- */
2131  /* level variables. I.e.: top-level variables are *not* recognized */
2132  /* while loading files and variables in file queries are *not* added. */
2133  old_var_occurred=var_occurred; /* 18.8 */
2134  old_var_tree=var_tree;
2135  var_tree=NULL;
2136  s=stack_copy_psi_term(parse(&sort));
2137  var_tree=old_var_tree;
2138  var_occurred=old_var_occurred; /* 18.8 */
2139 
2140  if (s->type==eof) {
2141  encode_types();
2142  if (input_stream!=stdin) (void)fclose(input_stream);
2143  exitloop=TRUE;
2144  end_of_file=TRUE; /* RM: Jan 27 1993 */
2145  }
2146  else if (sort==FACT) {
2148  assert_clause(s);
2149  }
2150  else if (sort==QUERY) {
2151  encode_types();
2153  /* Handle both successful and failing queries correctly. */
2154  cutpt=choice_stack;
2159  exitloop=TRUE;
2160  }
2161  else {
2162  /* fprintf(stderr,"*** Error: in input file %c%s%c.\n",34,fn,34); */
2163  /* success=FALSE; */
2164  /* fail_all(); */
2165  if (input_stream!=stdin) (void)fclose(input_stream);
2166  (void)abort_life(TRUE);
2167  /* printf("\n*** Abort\n"); */
2168  /* main_loop_ok=FALSE; */
2169  }
2170  } while (success && !exitloop);
2171 
2172 
2173  /* RM: Jan 27 1993 */
2174  if(end_of_file || !success) {
2175  /*
2176  printf("END OF FILE %s, setting module to %s\n",
2177  ((ptr_psi_term)get_attr(input_state,
2178  INPUT_FILE_NAME))->value,
2179  ((ptr_psi_term)get_attr(input_state,
2180  CURRENT_MODULE))->value);
2181  */
2182 
2183  (void)set_current_module(
2184  find_module((char *)((ptr_psi_term)get_attr(input_state,
2185  CURRENT_MODULE))->value_3));
2186  }
2187 
2188 
2189  noisy=old_noisy;
2190  file_date=old_file_date;
2191  (void)open_input_file("stdin");
2192 
2193 
2194  return success;
2195 }
void assert_clause(ptr_psi_term t)
Definition: login.c:267
#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)
Definition: parser.c:877
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
Definition: login.c:555
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)
Definition: built_ins.c:2124
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)
Definition: parser.c:183
void restore_state(ptr_psi_term t)
Definition: token.c:267
#define load
Definition: def_const.h:288
void encode_types()
Definition: types.c:1015
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void save_state(ptr_psi_term t)
Definition: token.c:230
GENERIC get_attr(ptr_psi_term t, char *attrname)
Definition: token.c:210
ptr_module find_module(char *module)
Definition: modules.c:48
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)
Definition: token.c:504
ptr_module set_current_module(ptr_module module)
Definition: modules.c:95
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
Definition: login.c:591
ptr_choice_point choice_stack
Definition: def_glob.h:51
long look ( )

Definition at line 146 of file parser.c.

References int_stack, and parser_stack_index.

147 {
149 }
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 150 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.

154 {
155  ptr_definition ta; /* type of psi term a */
156  ptr_definition tb; /* type of psi term b */
157  long *flags; /* set to 1 if this type has been checked in
158  * the lub search.
159  */
160  ptr_int_list ans;
161  ptr_int_list pattern;
162  long found;
163 
164  ta = a->type;
165  tb = b->type;
166 
167  /* special cases first */
168 
169  if (isValue(a) && isValue(b) && sub_type(ta,tb) && sub_type(tb,ta))
170  {
171  /* special case of two values being of same type. Check that they
172  * might actually be same value before returning the type
173  */
174  if (isSubTypeValue(a, b))
175  {
176  /* since we alreadyuu know they are both values, isSubTypeValue
177  * returns TRUE if they are same value, else false
178  */
179 
180  *pp = a;
181  return NULL;
182  }
183  }
184 
185  if (sub_type(ta, tb)) return makeUnitList(tb);
186  if (sub_type(tb, ta)) return makeUnitList(ta);
187 
188  /* ta has the lub of tb&ta without the high bit set, search upwards for a
189  * type that has the same lower bits as ta
190  */
191 
192  /* get the pattern to search for */
193 
194  pattern = copyTypeCode(ta->code);
195  or_codes(pattern, tb->code); /* pattern to search for */
196  ans = copyTypeCode(pattern); /* resulting pattern */
197 
198  /* initialize the table to be non-searched */
199 
200  flags = (long *)stack_alloc(sizeof(unsigned long) * type_count);
201  memset(flags, 0, sizeof(unsigned long) * type_count);
202 
203  /* now do a breadth first search for each of arg1 and arg2 */
204 
205  found = bfs(ta, ans, pattern, flags);
206  found += bfs(tb, ans, pattern, flags);
207 
208  if (found)
209  ans = decode(ans);
210  else
211  ans = makeUnitList(top);
212 
213  return ans;
214 }
int isSubTypeValue(ptr_psi_term arg1, ptr_psi_term arg2)
Definition: bi_type.c:163
long type_count
Definition: def_glob.h:46
ptr_int_list decode(ptr_int_list c)
Definition: types.c:1678
static long bfs(ptr_definition p, ptr_int_list ans, ptr_int_list pattern, long *flags)
Definition: lub.c:66
void or_codes(ptr_int_list u, ptr_int_list v)
Definition: types.c:780
ptr_definition top
Definition: def_glob.h:106
#define NULL
Definition: def_const.h:203
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
ptr_int_list copyTypeCode(ptr_int_list u)
Definition: types.c:760
ptr_int_list code
Definition: def_struct.h:129
long isValue(ptr_psi_term p)
Definition: bi_type.c:541
ptr_definition type
Definition: def_struct.h:165
static ptr_int_list makeUnitList(ptr_definition x)
Definition: lub.c:132
GENERIC stack_alloc(long s)
Definition: memory.c:1542
int main ( int  argc,
char *  argv[] 
)

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

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

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

1472 {
1473  GENERIC old_heap_pointer;
1474  ptr_tab_brk new;
1475 
1477  if(t) {
1478 
1479  deref_ptr(t);
1480 
1481  old_heap_pointer=heap_pointer;
1484  gen_sym_counter=0;
1485  go_through(t);
1487 
1488  indent=FALSE;
1489  const_quote=TRUE;
1492  *buffer=0;
1494 
1495  new_tab(&new);
1496  mark_tab(new);
1498  end_tab();
1499  if (indent) {
1500  work_out_length();
1501  pretty_output();
1502  }
1503 
1504  heap_pointer=old_heap_pointer;
1505  }
1506  else
1507  printf("*null psi_term*");
1508 }
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)

Definition at line 1375 of file print.c.

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

1377 {
1378  if (n) {
1379  GENERIC old_heap_pointer;
1380  ptr_tab_brk new;
1381 
1382  if (!write_corefs) main_pred_write(n->left);
1383 
1384  old_heap_pointer=heap_pointer;
1387  gen_sym_counter=0;
1388  if (write_corefs)
1389  go_through_tree(n);
1390  else
1393 
1394  *buffer=0;
1395 
1397  new_tab(&new);
1398 
1399  if (write_corefs) {
1400  write_attributes(n,new);
1401  }
1402  else {
1403  mark_tab(new);
1405  }
1406 
1407  end_tab();
1408 
1409  if (indent) {
1410  work_out_length();
1411  pretty_output();
1412  }
1413 
1414  heap_pointer=old_heap_pointer;
1415 
1417  }
1418 }
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 ( )

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

2206 {
2207  long success=TRUE;
2208  ptr_pair_list *p;
2209  ptr_psi_term unused_match_date; /* 13.6 */
2210 
2211  xcount=0;
2215 
2216  while (main_loop_ok && goal_stack) {
2217 
2218  /* RM: Oct 28 1993 For debugging a horrible mess.
2219  {
2220  ptr_choice_point c=choice_stack;
2221  while(c) {
2222  if((ptr_psi_term)stack_pointer<(ptr_psi_term)c) {
2223  printf("########### Choice stack corrupted! %x\n",c);
2224  trace=TRUE;
2225  c=NULL;
2226  }
2227  else
2228  c=c->next;
2229  }
2230  }
2231  */
2232 
2233 
2234  aim=goal_stack;
2235  switch(aim->type) {
2236 
2237  case unify:
2238  goal_stack=aim->next;
2239  goal_count++;
2240  success=unify_aim();
2241  break;
2242 
2243  /* Same as above, but do not evaluate top level */
2244  /* Used to bind with unbound variables */
2245  case unify_noeval:
2246  goal_stack=aim->next;
2247  goal_count++;
2248  success=unify_aim_noeval();
2249  break;
2250 
2251  case prove:
2252  success=prove_aim();
2253  break;
2254 
2255  case eval:
2256  goal_stack=aim->next;
2257  goal_count++;
2258  success=eval_aim();
2259  break;
2260 
2261  case load:
2262  goal_stack=aim->next;
2263  goal_count++;
2264  success=load_aim();
2265  break;
2266 
2267  case match:
2268  goal_stack=aim->next;
2269  goal_count++;
2270  success=match_aim();
2271  break;
2272 
2273  case disj:
2274  goal_stack=aim->next;
2275  goal_count++;
2276  success=disjunct_aim();
2277  break;
2278 
2279  case general_cut:
2280  goal_stack=aim->next;
2281  goal_count++;
2282  /* assert((ptr_choice_point)aim->aaaa_1 <= choice_stack); 12.7 */
2283  /* choice_stack=(ptr_choice_point)aim->aaaa_1; */
2284  cut_to(aim->aaaa_1); /* 12.7 */
2285 #ifdef CLEAN_TRAIL
2287 #endif
2288 #ifdef TS
2289  /* RESTORE_TIME_STAMP; */ /* 9.6 */
2290 #endif
2291  break;
2292 
2293  case eval_cut:
2294  /* RESID */ restore_resid((ptr_resid_block)aim->cccc_1, &unused_match_date);
2295  if (curried)
2296  do_currying();
2297  else if (resid_vars) {
2298  success=do_residuation_user(); /* 21.9 */ /* PVR 9.2.94 */
2299  } else {
2300  if (resid_aim)
2301  traceline("result of %P is %P\n", resid_aim->aaaa_1, aim->aaaa_1);
2302  goal_stack=aim->next;
2303  goal_count++;
2304  /* resid_aim=NULL; 21.9 */
2305  /* PVR 5.11 choice_stack=(ptr_choice_point)aim->bbbb_1; */
2306  (void)i_check_out(aim->aaaa_1);
2307  }
2308  resid_aim=NULL; /* 21.9 */
2309  resid_vars=NULL; /* 22.9 */
2310  /* assert((ptr_choice_point)aim->bbbb_1<=choice_stack); 12.7 */
2311  /* PVR 5.11 */ /* choice_stack=(ptr_choice_point)aim->bbbb_1; */
2312  if (success) { /* 21.9 */
2313  cut_to(aim->bbbb_1); /* 12.7 */
2314 #ifdef CLEAN_TRAIL
2316 #endif
2317  /* match_date=NULL; */ /* 13.6 */
2318 #ifdef TS
2319  /* RESTORE_TIME_STAMP; */ /* 9.6 */
2320 #endif
2321  }
2322  break;
2323 
2324  case freeze_cut:
2325  /* RESID */ restore_resid((ptr_resid_block)aim->cccc_1, &unused_match_date);
2326  if (curried) {
2327  warningline("frozen goal has a missing parameter '%P' and fails.\n",aim->aaaa_1);
2328  success=FALSE;
2329  }
2330  else if (resid_vars) {
2331  success=do_residuation_user(); /* 21.9 */ /* PVR 9.2.94 */
2332  } else {
2333  if (resid_aim) traceline("releasing frozen goal: %P\n", aim->aaaa_1);
2334  /* resid_aim=NULL; 21.9 */
2335  /* PVR 5.12 choice_stack=(ptr_choice_point)aim->bbbb_1; */
2336  goal_stack=aim->next;
2337  goal_count++;
2338  }
2339  resid_aim=NULL; /* 21.9 */
2340  resid_vars=NULL; /* 22.9 */
2341  if (success) { /* 21.9 */
2342  /* assert((ptr_choice_point)aim->bbbb_1<=choice_stack); 12.7 */
2343  /* PVR 5.12 */ /* choice_stack=(ptr_choice_point)aim->bbbb_1; */
2344  cut_to(aim->bbbb_1); /* 12.7 */
2345 #ifdef CLEAN_TRAIL
2347 #endif
2348  /* match_date=NULL; */ /* 13.6 */
2349 #ifdef TS
2350  /* RESTORE_TIME_STAMP; */ /* 9.6 */
2351 #endif
2352  }
2353  break;
2354 
2355  case implies_cut: /* 12.10 */
2356  /* This 'cut' is actually more like a no-op! */
2357  restore_resid((ptr_resid_block)aim->cccc_1, &unused_match_date);
2358  if (curried) {
2359  warningline("implied goal has a missing parameter '%P' and fails.\n",aim->aaaa_1);
2360  success=FALSE;
2361  }
2362  else if (resid_vars)
2363  success=FALSE;
2364  else {
2365  if (resid_aim) traceline("executing implied goal: %P\n", aim->aaaa_1);
2366  goal_stack=aim->next;
2367  goal_count++;
2368  }
2369  resid_aim=NULL; /* 21.9 */
2370  resid_vars=NULL; /* 22.9 */
2371  break;
2372 
2373  case fail:
2374  goal_stack=aim->next;
2375  success=FALSE;
2376  break;
2377 
2378  case what_next:
2379  goal_stack=aim->next;
2380  success=what_next_aim();
2381  break;
2382 
2383  case type_disj:
2384  goal_stack=aim->next;
2385  goal_count++;
2386  type_disj_aim();
2387  break;
2388 
2389  case clause:
2390  goal_stack=aim->next;
2391  goal_count++;
2392  success=clause_aim(0);
2393  break;
2394 
2395  case del_clause:
2396  goal_stack=aim->next;
2397  goal_count++;
2398  success=clause_aim(1);
2399  break;
2400 
2401  case retract:
2402  goal_stack=aim->next;
2403  goal_count++;
2404  p=(ptr_pair_list*)aim->aaaa_1;
2405  traceline("deleting clause (%P%s%P)\n",
2406  (*p)->aaaa_2,((*p)->aaaa_2->type->type_def==(def_type)function_it?"->":":-"),(*p)->bbbb_2);
2407  (*p)->aaaa_2=NULL;
2408  (*p)->bbbb_2=NULL;
2409  (*p)=(*p)->next; /* Remove retracted element from pairlist */
2410  break;
2411 
2412  case c_what_next: /* RM: Mar 31 1993 */
2413  main_loop_ok=FALSE; /* Exit the main loop */
2414  break;
2415 
2416  default:
2417  Errorline("bad goal on stack %d.\n",goal_stack->type);
2418  goal_stack=aim->next;
2419  }
2420 
2421  if (main_loop_ok) {
2422 
2423  if (success) {
2424 
2425 #ifdef X11
2426  /* Polling on external events */
2427  if (xcount<=0 && aim->type==prove) {
2428  if (x_exist_event()) {
2429  /* printf("At event, xeventdelay = %ld.\n",xeventdelay); */
2430  xeventdelay=0;
2432  } else {
2434  /* If XEVENTDELAY=1000 it takes 90000 goals to get back */
2435  /* from 100 at the pace of 1%. */
2436  xeventdelay=(xeventdelay*101)/100+2;
2437  else
2439  }
2441  }
2442  else
2443  xcount--;
2444 #endif
2445 
2446  }
2447  else {
2448  if (choice_stack) {
2449  backtrack();
2450  traceline("backtracking\n");
2451  success=TRUE;
2452  }
2453  else /* if (goal_stack) */ {
2454  undo(NULL); /* 8.10 */
2455  infoline("\n*** No");
2456  /* printf("\n*** No (in main_prove)."); */
2457  show_count();
2458 #ifdef TS
2459  /* global_time_stamp=INIT_TIME_STAMP; */ /* 9.6 */
2460 #endif
2462  }
2463  }
2464 
2466  (void)memory_check();
2467 
2468  if (interrupted || (stepflag && steptrace))
2469  handle_interrupt();
2470  else if (stepcount>0) {
2471  stepcount--;
2472  if (stepcount==0 && !stepflag) {
2473  stepflag=TRUE;
2474  handle_interrupt();
2475  }
2476  }
2477  }
2478  }
2479 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
long load_aim()
Definition: login.c:2104
#define function_it
Definition: def_const.h:362
long main_loop_ok
Definition: def_glob.h:48
long do_residuation_user()
Definition: lefun.c:306
void restore_resid(ptr_resid_block rb, ptr_psi_term *match_date)
Definition: lefun.c:1270
void show_count()
Definition: login.c:1085
ptr_goal goal_stack
Definition: def_glob.h:50
void undo(ptr_stack limit)
Definition: login.c:646
long unify_aim()
Definition: login.c:1264
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()
Definition: login.c:1744
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)
Definition: lefun.c:414
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)
Definition: login.c:1775
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()
Definition: lefun.c:359
#define freeze_cut
Definition: def_const.h:280
#define TRUE
Definition: def_const.h:127
static void clean_trail(ptr_choice_point cutpt)
Definition: login.c:757
#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()
Definition: login.c:1259
#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()
Definition: lefun.c:456
#define load
Definition: def_const.h:288
long prove_aim()
Definition: login.c:1545
#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()
Definition: login.c:1525
void handle_interrupt()
Definition: interrupt.c:43
void backtrack()
Definition: login.c:724
#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()
Definition: memory.c:1622
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()
Definition: lefun.c:712
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
ptr_choice_point choice_stack
Definition: def_glob.h:51
long what_next_aim()
Definition: login.c:1942
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 
)

Definition at line 156 of file built_ins.c.

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

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

Definition at line 1239 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_module::symbol_table, TRUE, update_symbol(), and warningline().

1242 {
1243  int ok=TRUE;
1244  ptr_keyword key;
1245  ptr_definition def;
1246 
1247  deref_ptr(term);
1248 
1250 
1251  if(key) {
1252  /*
1253  if(key->definition->keyword->module!=current_module) {
1254  warningline("local definition of '%s' overrides '%s'\n",
1255  key->definition->keyword->symbol,
1256  key->definition->keyword->combined_name);
1257 
1258  new_definition(key);
1259  }
1260  */
1261 
1262  key->private_feature=TRUE;
1263  def=key->definition;
1264  }
1265  else {
1268  }
1269 
1270 
1271  if(ok && def->keyword->public) {
1272  warningline("feature '%s' is now private, but was also declared public\n",
1273  def->keyword->combined_name);
1274  }
1275 
1276  return ok;
1277 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
Definition: hash_table.c:133
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:13
char * symbol
Definition: def_struct.h:91
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
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 
)

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

548 {
549  // ptr_list l;
550  ptr_psi_term a1,a2;
551 
552  deref_ptr(tok);
553  tok->attr_list=NULL;
554  tok->resid=NULL;
555 
556 
557  /* Here beginneth a terrible FIX,
558  I will have to rewrite the tokeniser and the parser to handle
559  POINTERS to psi-terms instead of PSI_TERMS !!!
560  */
561 
562  a1=arg1;
563  a2=arg2;
564 
565  if (a1)
566  deref_ptr(a1);
567  if (a2)
568  deref_ptr(a2);
569 
570  /* End of extremely ugly fix. */
571 
572  if (/* UNI FALSE */ equ_tokch((*tok),':') && arg1 && arg2) {
573 
574  if (a1!=a2) {
575  if (a1->type==top &&
576  !a1->attr_list &&
577  !a1->resid) {
578  if (a1!=arg1)
579  /* push_ptr_value(psi_term_ptr,&(a1->coref)); 9.6 */
580  push_psi_ptr_value(a1,(GENERIC *)&(a1->coref));
581  a1->coref=stack_copy_psi_term(*arg2);
582  tok=arg1;
583  }
584  else
585  if(a2->type==top &&
586  !a2->attr_list &&
587  !a2->resid) {
588  if(a2!=arg2)
589  /* push_ptr_value(psi_term_ptr,&(a2->coref)); 9.6 */
590  push_psi_ptr_value(a2,(GENERIC *)&(a2->coref));
591  a2->coref=stack_copy_psi_term(*arg1);
592  tok=arg2;
593  }
594  else { /* RM: Feb 22 1993 Now reports an error */
595  Syntaxerrorline("':' occurs where '&' required (%E)\n");
596  *tok= *error_psi_term;
597  /* make_unify_pair(tok,arg1,arg2); Old code */
598  }
599  }
600  else
601  tok=arg1;
602  }
603  else {
604 
605  /* RM: Jun 21 1993 */
606  /* And now for another nasty hack: reading negative numbers */
607  if(tok->type==minus_symbol &&
608  a1 &&
609  !a2 &&
610  a1->value_3 &&
611  (a1->type==integer || a1->type==real)) {
612 
613  tok->type=a1->type;
614  tok->value_3=(GENERIC)heap_alloc(sizeof(REAL));
615  *(REAL *)tok->value_3 = - *(REAL *)a1->value_3;
616 
617  return *tok;
618  }
619  /* End of other nasty hack */
620 
622  if (arg2)
624  }
625 
626  return *tok;
627 }
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)
Definition: login.c:443
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)
Definition: trees.c:291
#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)
Definition: parser.c:183
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)
Definition: memory.c:1518
#define equ_tokch(A, B)
Definition: def_macro.h:66
char* make_module_token ( ptr_module  module,
char *  str 
)

Definition at line 185 of file modules.c.

References extract_module_from_name(), and module_buffer.

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

Definition at line 600 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, update_symbol(), and warningline().

604 {
605  int ok=TRUE;
606  ptr_keyword key;
607  ptr_definition def;
608 
609  deref_ptr(term);
610 
612  if(key) {
613 
614  if(key->definition->keyword->module!=current_module && !bool) {
615  warningline("local definition of '%s' overrides '%s'\n",
616  key->definition->keyword->symbol,
618 
619  (void)new_definition(key);
620  }
621 
622  key->public=bool;
623  }
624  else {
626  def->keyword->public=bool;
627  }
628 
629  return ok;
630 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
Definition: hash_table.c:133
char * combined_name
Definition: def_struct.h:92
ptr_definition new_definition(ptr_keyword key)
Definition: modules.c:215
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:13
char * symbol
Definition: def_struct.h:91
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
ptr_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 ( )

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

1727 {
1728 #ifdef LIFE_NDBM
1729  make_ndbm_type_links();
1730 #endif
1736  make_type_link(sys_bytedata ,built_in); /* DENYS: BYTEDATA */
1737 }
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)
Definition: types.c:848
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 
)

Definition at line 848 of file types.c.

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

850 {
851  if (t2!=top && !type_member(t2,t1->parents))
852  t1->parents=cons((GENERIC)t2,t1->parents);
853  if (t2!=top && !type_member(t1,t2->children))
854  t2->children=cons((GENERIC)t1,t2->children);
855 }
ptr_int_list cons(GENERIC v, ptr_int_list l)
Definition: types.c:164
ptr_definition top
Definition: def_glob.h:106
long type_member()
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
ptr_goal makeGoal ( ptr_psi_term  p)

Definition at line 533 of file bi_sys.c.

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

535 {
536  ptr_goal old = goal_stack;
537  ptr_goal g;
538 
540  g = goal_stack;
541  g->next=NULL;
542  goal_stack = old;
543  return g;
544 }
#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)
Definition: login.c:555
#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 
)

Definition at line 480 of file bi_sys.c.

References stack_cons(), and stack_nil().

485 {
486  ptr_psi_term result;
487 
488 
489  /* RM: Dec 14 1992: Added the new list representation */
490  result=stack_nil();
491 
492  while (head) {
493  result=stack_cons((*valueFunc)(head),result);
494  head=(*nextFunc)(head);
495  }
496  return result;
497 }
ptr_psi_term stack_cons(ptr_psi_term head, ptr_psi_term tail)
Definition: built_ins.c:47
ptr_psi_term stack_nil()
Definition: built_ins.c:29
ptr_psi_term makePsiTerm ( ptr_definition  x)

Definition at line 468 of file bi_sys.c.

References stack_psi_term(), and wl_psi_term::type.

470 {
471  ptr_psi_term p;
472 
473  p = stack_psi_term(4);
474  p->type = x;
475  return p;
476 }
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
ptr_definition type
Definition: def_struct.h:165
void mark_ancestors ( ptr_definition  def,
long *  flags 
)

Definition at line 45 of file lub.c.

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

48 {
49  ptr_int_list par;
50 
51  par=def->parents;
52  while (par) {
54  long len;
55 
56  p=(ptr_definition)par->value_1;
57  len=bit_length(p->code);
58  if (!flags[len]) {
59  flags[len]=1;
60  mark_ancestors(p, flags);
61  }
62  par=par->next;
63  }
64 }
long bit_length(ptr_int_list c)
Definition: types.c:1648
void mark_ancestors(ptr_definition def, long *flags)
Definition: lub.c:45
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)

Definition at line 452 of file copy.c.

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

454 {
455  clear_copy();
457  mark_eval_new(t);
458 }
void mark_eval_new(ptr_psi_term t)
Definition: copy.c:479
void clear_copy()
Definition: copy.c:52
#define FALSE
Definition: def_const.h:128
static long mark_nonstrict_flag
Definition: copy.c:442
void mark_eval_new ( ptr_psi_term  t)

Definition at line 479 of file copy.c.

References curr_status, deref_ptr, FALSE, function_it, global, insert_translation(), mark_eval_tree_new(), mark_nonstrict_flag, mark_quote_new(), mark_quote_tree_new(), QUOTED_TRUE, translate(), TRUE, and type_it.

481 {
482  // ptr_list l;
483  long *infoptr,flag;
484  ptr_psi_term u;
485  long old_status;
486 
487  if (t) {
488  deref_ptr(t);
489  flag = t->type->evaluate_args;
490  u=translate(t,&infoptr);
491  if (u) {
492  /* Quote the subgraph if it was already copied as to be evaluated. */
493  if (!flag && *infoptr) {
494  mark_quote_new(t);
495  *infoptr=FALSE;
496  }
497  /* If any subterm has zero curr_status (i.e., if t->status==0),
498  then so does the whole term: PVR 14.2.94 */
499  old_status=curr_status;
500  curr_status=(long)t->status;
501  if (curr_status) curr_status=old_status;
502  }
503  else {
505  old_status=curr_status;
506  curr_status=4;
507 
508  if (flag) /* 16.9 */
510  else
512 
513  switch((long)t->type->type_def) {
514  case type_it:
515  if (t->type->properties)
516  curr_status=0;
517  break;
518 
519  case function_it:
520  curr_status=0;
521  break;
522 
523  case global: /* RM: Feb 8 1993 */
524  curr_status=0;
525  break;
526 
527  default:
528  break;
529  }
530  if (mark_nonstrict_flag) { /* 25.8 */
531  if (curr_status) {
532  /* Only increase the status, never decrease it: */
533  t->status=curr_status;
534  }
535  }
536  else {
537  t->status=curr_status;
538  t->flags=curr_status?QUOTED_TRUE:FALSE; /* 14.9 */
539  }
540  /* If any subterm has zero curr_status, then so does the whole term: */
541  if (curr_status) curr_status=old_status;
542  }
543  }
544 }
#define function_it
Definition: def_const.h:362
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
Definition: copy.c:101
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)
Definition: copy.c:63
void mark_eval_tree_new(ptr_node n)
Definition: copy.c:546
#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)
Definition: copy.c:581
static long curr_status
Definition: copy.c:215
#define FALSE
Definition: def_const.h:128
void mark_quote_new(ptr_psi_term t)
Definition: copy.c:557
static long mark_nonstrict_flag
Definition: copy.c:442
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)

Definition at line 546 of file copy.c.

References mark_eval_new(), and mark_eval_tree_new().

548 {
549  if (n) {
553  }
554 }
void mark_eval_new(ptr_psi_term t)
Definition: copy.c:479
GENERIC data
Definition: def_struct.h:185
void mark_eval_tree_new(ptr_node n)
Definition: copy.c:546
ptr_node left
Definition: def_struct.h:183
ptr_node right
Definition: def_struct.h:184
void mark_nonstrict ( ptr_psi_term  t)

Definition at line 462 of file copy.c.

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

464 {
465  clear_copy();
467  mark_eval_new(t);
468 }
void mark_eval_new(ptr_psi_term t)
Definition: copy.c:479
void clear_copy()
Definition: copy.c:52
#define TRUE
Definition: def_const.h:127
static long mark_nonstrict_flag
Definition: copy.c:442
void mark_quote ( ptr_psi_term  t)

Definition at line 601 of file copy.c.

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

603 {
604  // ptr_list l;
605 
606  if (t && !(t->status&RMASK)) {
607  t->status = 4;
608  t->flags=QUOTED_TRUE; /* 14.9 */
609  t->status |= RMASK;
610  mark_quote(t->coref);
612  t->status &= ~RMASK;
613  }
614 }
#define RMASK
Definition: def_const.h:159
ptr_psi_term coref
Definition: def_struct.h:172
void mark_quote(ptr_psi_term t)
Definition: copy.c:601
#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 
)

Definition at line 396 of file copy.c.

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

399 {
400  // ptr_list l;
401  long *infoptr;
402  ptr_psi_term u;
403 
404  if (t) {
405  deref_ptr(t);
406  u=translate(t,&infoptr);
407  /* assert(u!=NULL); 15.9 */
408  if (u) {
409  if (*infoptr==EVAL_FLAG) {
410  *infoptr=QUOTE_FLAG;
411  u->status=4;
412  u->flags=QUOTED_TRUE; /* 14.9 */
413  mark_quote_tree_c(t->attr_list,heap_flag);
414  }
415  }
416  else { /* u does not exist yet */ /* 15.9 */
417  /* Create a stub & mark it as to-be-quoted. */
418  u=NEW(t,psi_term);
420  }
421  }
422 }
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
Definition: copy.c:101
void mark_quote_tree_c(ptr_node n, long heap_flag)
Definition: copy.c:424
#define QUOTE_STUB
Definition: def_const.h:329
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
Definition: copy.c:63
#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)

Definition at line 557 of file copy.c.

References deref_ptr, FALSE, insert_translation(), mark_quote_tree_new(), QUOTED_TRUE, translate(), and TRUE.

559 {
560  // ptr_list l;
561  long *infoptr;
562  ptr_psi_term u;
563 
564  if (t) {
565  deref_ptr(t);
566  u=translate(t,&infoptr);
567 
568  /* Return if the subgraph is already quoted. */
569  if (u && !*infoptr) return;
570 
571  /* Otherwise quote the subgraph */
573  else *infoptr = FALSE; /* sanjay */
574  t->status= 4;
575  t->flags=QUOTED_TRUE; /* 14.9 */
577  }
578 }
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
Definition: copy.c:101
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
Definition: copy.c:63
#define deref_ptr(P)
Definition: def_macro.h:95
#define TRUE
Definition: def_const.h:127
void mark_quote_tree_new(ptr_node n)
Definition: copy.c:581
#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)

Definition at line 471 of file copy.c.

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

473 {
474  clear_copy();
476  mark_quote_new(t);
477 }
void clear_copy()
Definition: copy.c:52
#define FALSE
Definition: def_const.h:128
void mark_quote_new(ptr_psi_term t)
Definition: copy.c:557
static long mark_nonstrict_flag
Definition: copy.c:442
void mark_quote_tree ( ptr_node  t)

Definition at line 616 of file copy.c.

References mark_quote(), and mark_quote_tree().

618 {
619  if (t) {
620  mark_quote_tree(t->left);
621  mark_quote((ptr_psi_term) (t->data));
623  }
624 }
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
void mark_quote(ptr_psi_term t)
Definition: copy.c:601
void mark_quote_tree()
ptr_node right
Definition: def_struct.h:184
void mark_quote_tree_c ( ptr_node  n,
long  heap_flag 
)

Definition at line 424 of file copy.c.

References mark_quote_c(), and mark_quote_tree_c().

427 {
428  if (n) {
429  mark_quote_tree_c(n->left,heap_flag);
430  mark_quote_c((ptr_psi_term) (n->data),heap_flag);
431  mark_quote_tree_c(n->right,heap_flag);
432  }
433 }
void mark_quote_tree_c(ptr_node n, long heap_flag)
Definition: copy.c:424
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)
Definition: copy.c:396
ptr_node right
Definition: def_struct.h:184
void mark_quote_tree_new ( ptr_node  n)

Definition at line 581 of file copy.c.

References mark_quote_new(), and mark_quote_tree_new().

583 {
584  if (n) {
588  }
589 }
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
void mark_quote_tree_new(ptr_node n)
Definition: copy.c:581
void mark_quote_new(ptr_psi_term t)
Definition: copy.c:557
ptr_node right
Definition: def_struct.h:184
void mark_tab ( ptr_tab_brk  t)

Definition at line 513 of file print.c.

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

515 {
516  end_tab();
517  indx->tab=t;
518 }
ptr_tab_brk tab
Definition: def_struct.h:312
ptr_item indx
Definition: def_glob.h:329
long match_aim ( )

Definition at line 712 of file lefun.c.

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

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

Definition at line 692 of file lefun.c.

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

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

Definition at line 552 of file lefun.c.

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

555 {
556  long cmp;
557  ptr_node temp;
558 
559  if (v) {
560  if (*u==NULL)
562  else {
563  cmp=featcmp((*u)->key,v->key);
564  if(cmp==0) {
565  ptr_psi_term t;
566  /* RESID */ match_attr1(&((*u)->right),v->right,rb);
567  t = (ptr_psi_term) (*u)->data;
568  /* RESID */ push_goal(match,(ptr_psi_term)(*u)->data,(ptr_psi_term)v->data,(GENERIC)rb);
569  /* deref2_eval(t); */
570  /* RESID */ match_attr1(&((*u)->left),v->left,rb);
571  }
572  else if (cmp>0) {
573  temp=v->right;
574  v->right=NULL;
575  /* RESID */ match_attr1(u,temp,rb);
576  /* RESID */ match_attr1(&((*u)->left),v,rb);
577  v->right=temp;
578  }
579  else {
580  temp=v->left;
581  v->left=NULL;
582  /* RESID */ match_attr1(&((*u)->right),v,rb);
583  /* RESID */ match_attr1(u,temp,rb);
584  v->left=temp;
585  }
586  }
587  }
588 }
static long attr_missing
Definition: lefun.c:10
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
#define TRUE
Definition: def_const.h:127
#define match
Definition: def_const.h:283
long featcmp(char *str1, char *str2)
Definition: trees.c:89
void match_attr1(ptr_node *u, ptr_node v, ptr_resid_block rb)
Definition: lefun.c:552
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node right
Definition: def_struct.h:184
void match_attr2 ( ptr_node u,
ptr_node  v,
ptr_resid_block  rb 
)

Definition at line 592 of file lefun.c.

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

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

Definition at line 643 of file lefun.c.

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

646 {
647  long cmp;
648  ptr_node temp;
649 
650  if (v) {
651  if (*u==NULL)
653  else {
654  cmp=featcmp((*u)->key,v->key);
655  if(cmp==0) {
656  ptr_psi_term t1,t2;
657  /* RESID */ match_attr3(&((*u)->right),v->right,rb);
658  t1 = (ptr_psi_term) (*u)->data;
659  t2 = (ptr_psi_term) v->data;
660  /* RESID */ /* push_goal(match,(*u)->data,v->data,rb); */
661  deref2_eval(t1); /* Assumes goal_stack is already restored. */
662  deref2_eval(t2); /* PVR 12.03 */
663  /* RESID */ match_attr3(&((*u)->left),v->left,rb);
664  }
665  else if (cmp>0) {
666  temp=v->right;
667  v->right=NULL;
668  /* RESID */ match_attr3(u,temp,rb);
669  /* RESID */ match_attr3(&((*u)->left),v,rb);
670  v->right=temp;
671  }
672  else {
673  temp=v->left;
674  v->left=NULL;
675  /* RESID */ match_attr3(&((*u)->right),v,rb);
676  /* RESID */ match_attr3(u,temp,rb);
677  v->left=temp;
678  }
679  }
680  }
681 }
void deref2_eval(ptr_psi_term t)
Definition: lefun.c:1224
static long attr_missing
Definition: lefun.c:10
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
#define TRUE
Definition: def_const.h:127
long featcmp(char *str1, char *str2)
Definition: trees.c:89
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void match_attr3(ptr_node *u, ptr_node v, ptr_resid_block rb)
Definition: lefun.c:643
ptr_node right
Definition: def_struct.h:184
long matches ( ptr_definition  t1,
ptr_definition  t2,
long *  smaller 
)

Definition at line 1565 of file types.c.

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

1569 {
1570  ptr_int_list c1,c2;
1571  long result=TRUE;
1572 
1573  *smaller=TRUE;
1574 
1575  if (t1!=t2)
1576  if (t2!=top)
1577  if (t1==top)
1578  *smaller=FALSE;
1579  else {
1580  c1=t1->code;
1581  c2=t2->code;
1582  result=FALSE;
1583 
1584  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1585  while (c1 && c2) {
1586  if ((unsigned long)c1->value_1 & (unsigned long)c2->value_1) result=TRUE;
1587  if ((unsigned long)c1->value_1 & ~(unsigned long)c2->value_1) *smaller=FALSE;
1588  c1=c1->next;
1589  c2=c2->next;
1590  }
1591  }
1592  else
1593  *smaller=FALSE;
1594  }
1595 
1596  return result;
1597 }
#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 ( )

Definition at line 1622 of file memory.c.

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

1623 {
1624  long success=TRUE;
1625 
1627  if(verbose) fprintf(stderr,"\n"); /* RM: Feb 1 1993 */
1628  garbage();
1629  /* Abort if didn't recover at least GC_THRESHOLD/10 of memory */
1631  fprintf(stderr,"*********************\n");
1632  fprintf(stderr,"*** OUT OF MEMORY ***\n");
1633  fprintf(stderr,"*********************\n");
1634  fail_all();
1635  success=FALSE;
1636  }
1637  }
1638  return success;
1639 }
void fail_all()
Definition: memory.c:165
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()
Definition: memory.c:1430
#define GC_THRESHOLD
Definition: def_const.h:65
GENERIC stack_pointer
Definition: def_glob.h:14
void merge ( ptr_node u,
ptr_node  v 
)

Definition at line 1061 of file login.c.

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

1063 {
1064  merge1(u,v); /* Unify corresponding arguments */
1065  merge2(u,v); /* Evaluate lone arguments (lazy failure + eager success) */
1066  merge3(u,v); /* Merge v's loners into u & evaluate corresponding arguments */
1067 }
void merge2(ptr_node *u, ptr_node v)
Definition: login.c:884
void merge3(ptr_node *u, ptr_node v)
Definition: login.c:934
void merge1(ptr_node *u, ptr_node v)
Definition: login.c:833
void merge1 ( ptr_node u,
ptr_node  v 
)

Definition at line 833 of file login.c.

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

835 {
836  long cmp;
837  ptr_node temp;
838 
839  if (v) {
840  if (*u==NULL) {
841  /* push_ptr_value(int_ptr,u); */
842  /* (*u)=STACK_ALLOC(node); */
843  /* **u= *v; */
844  /* more_v_attr=TRUE; */
845  }
846  else {
847  cmp=featcmp((*u)->key,v->key);
848  if (cmp==0) {
849  if (v->right)
850  merge1(&((*u)->right),v->right);
851 
853 
854  if (v->left)
855  merge1(&((*u)->left),v->left);
856  }
857  else if (cmp>0) {
858  temp=v->right;
859  v->right=NULL;
860  merge1(&((*u)->left),v);
861  merge1(u,temp);
862  v->right=temp;
863  }
864  else {
865  temp=v->left;
866  v->left=NULL;
867  merge1(&((*u)->right),v);
868  merge1(u,temp);
869  v->left=temp;
870  }
871  }
872  }
873  else if (*u!=NULL) {
874  /* more_u_attr=TRUE; */
875  }
876 }
void push_goal(goals t, ptr_psi_term aaaa_5, ptr_psi_term bbbb_5, GENERIC cccc_5)
Definition: login.c:555
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
#define unify
Definition: def_const.h:274
long featcmp(char *str1, char *str2)
Definition: trees.c:89
ptr_node right
Definition: def_struct.h:184
void merge1(ptr_node *u, ptr_node v)
Definition: login.c:833
void merge2 ( ptr_node u,
ptr_node  v 
)

Definition at line 884 of file login.c.

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

886 {
887  long cmp;
888  ptr_node temp;
889 
890  if (v) {
891  if (*u==NULL) {
892  ptr_psi_term t;
893  merge2(u,v->right);
894  t = (ptr_psi_term) v->data;
895  deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
896  merge2(u,v->left);
897  }
898  else {
899  cmp=featcmp((*u)->key,v->key);
900  if (cmp==0) {
901  /* if (v->right) */
902  merge2(&((*u)->right),v->right);
903 
904  /* if (v->left) */
905  merge2(&((*u)->left),v->left);
906  }
907  else if (cmp>0) {
908  temp=v->right;
909  v->right=NULL;
910  merge2(&((*u)->left),v);
911  merge2(u,temp);
912  v->right=temp;
913  }
914  else {
915  temp=v->left;
916  v->left=NULL;
917  merge2(&((*u)->right),v);
918  merge2(u,temp);
919  v->left=temp;
920  }
921  }
922  }
923  else if (*u!=NULL) {
924  ptr_psi_term t;
925  merge2(&((*u)->right),v);
926  t = (ptr_psi_term) (*u)->data;
927  deref2_rec_eval(t); /* Assumes goal_stack is already restored. */
928  merge2(&((*u)->left),v);
929  }
930 }
void deref2_rec_eval(ptr_psi_term t)
Definition: lefun.c:1245
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)
Definition: login.c:884
long featcmp(char *str1, char *str2)
Definition: trees.c:89
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 
)

Definition at line 934 of file login.c.

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

936 {
937  long cmp;
938  ptr_node temp;
939 
940  if (v) {
941  if (*u==NULL) {
943  (*u)=STACK_ALLOC(node);
944  **u= *v;
946  }
947  else {
948  ptr_psi_term t1; // ,t2;
949 
950  cmp=featcmp((*u)->key,v->key);
951  if (cmp==0) {
952  if (v->right)
953  merge3(&((*u)->right),v->right);
954 
955  t1 = (ptr_psi_term) (*u)->data;
956  /* t2 = (ptr_psi_term) v->data; */
957  deref2_eval(t1);
958  /* deref2_eval(t2); */
959  /* push_goal(unify,(ptr_psi_term)(*u)->data,(ptr_psi_term)v->data,NULL); */
960 
961  if (v->left)
962  merge3(&((*u)->left),v->left);
963  }
964  else if (cmp>0) {
965  temp=v->right;
966  v->right=NULL;
967  merge3(&((*u)->left),v);
968  merge3(u,temp);
969  v->right=temp;
970  }
971  else {
972  temp=v->left;
973  v->left=NULL;
974  merge3(&((*u)->right),v);
975  merge3(u,temp);
976  v->left=temp;
977  }
978  }
979  }
980  else if (*u!=NULL) {
982  }
983 }
long more_u_attr
Definition: def_glob.h:303
void deref2_eval(ptr_psi_term t)
Definition: lefun.c:1224
#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)
Definition: login.c:934
#define STACK_ALLOC(A)
Definition: def_macro.h:16
long featcmp(char *str1, char *str2)
Definition: trees.c:89
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)
Definition: login.c:360
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 
)

Definition at line 1070 of file login.c.

References merge1(), and merge3().

1072 {
1073  merge1(u,v); /* Unify corresponding arguments */
1074  merge3(u,v); /* Merge v's loners into u & evaluate corresponding arguments */
1075 }
void merge3(ptr_node *u, ptr_node v)
Definition: login.c:934
void merge1(ptr_node *u, ptr_node v)
Definition: login.c:833
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 
)

Definition at line 5054 of file built_ins.c.

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

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

Definition at line 215 of file modules.c.

References wl_definition::already_loaded, wl_definition::always_check, wl_definition::children, wl_definition::code, wl_definition::date, 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.

218 {
219  ptr_definition result;
220 
221 
222  /* printf("*** New definition: %s\n",key->combined_name); */
223 
224  /* Create a new definition */
225  result=HEAP_ALLOC(struct wl_definition);
226 
227  /* RM: Feb 3 1993 */
228  result->next=first_definition; /* Linked list of all definitions */
229  first_definition=result;
230 
231  result->keyword=key;
232  result->rule=NULL;
233  result->properties=NULL;
234  result->date=0;
235  result->type_def=(def_type)undef;
236  result->always_check=TRUE;
237  result->protected=TRUE;
238  result->evaluate_args=TRUE;
239  result->already_loaded=FALSE;
240  result->children=NULL;
241  result->parents=NULL;
242  result->code=NOT_CODED;
243  result->op_data=NULL;
244  result->global_value=NULL; /* RM: Feb 8 1993 */
245  result->init_value=NULL; /* RM: Mar 23 1993 */
246  key->definition=result;
247 
248  return result;
249 }
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 
)

Definition at line 4764 of file built_ins.c.

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

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

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

303 {
304  ptr_psi_term t1;
305 
306  *t=heap_psi_term(4);
307  (*t)->type=inputfilesym;
308 
309  t1=heap_psi_term(4);
310  t1->type=stream;
312  heap_add_psi_attr(*t,STREAM,t1);
313 
314  /* RM: Jan 27 1993 */
316 
317  /*
318  printf("Creating new state for file '%s', module '%s'\n",
319  input_file_name,
320  current_module->module_name);
321  */
322 
327 
330 
333 
334  t1=heap_psi_term(4);
337 
338  t1=heap_psi_term(4);
341 }
#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)
Definition: lefun.c:63
#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)
Definition: token.c:122
void heap_add_psi_attr(ptr_psi_term t, char *attrname, ptr_psi_term g)
Definition: token.c:184
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)
Definition: token.c:58
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)

Definition at line 525 of file print.c.

References FALSE, and HEAP_ALLOC.

527 {
528  (*t)=HEAP_ALLOC(tab_brk);
529  (*t)->broken=FALSE;
530  (*t)->printed=FALSE;
531  (*t)->column=0;
532 }
#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 ( )

Definition at line 1838 of file login.c.

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

1839 {
1841 }
#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)

Definition at line 423 of file print.c.

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

425 {
426  if (!s[0]) return FALSE;
427 
428  if (s[0]=='%') return FALSE;
429  if (SINGLE(s[0]) && s[1]==0) return TRUE;
430  if (s[0]=='_' && s[1]==0) return FALSE;
431  if (all_symbol(s)) return TRUE;
432 
433  if (!LOWER(s[0])) return FALSE;
434  s++;
435  while (*s) {
436  if (!ISALPHA(*s)) return FALSE;
437  s++;
438  }
439  return TRUE;
440 }
#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)
Definition: types.c:1486
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 ( )

Definition at line 1845 of file login.c.

References choice_stack, and wl_choice_point::next.

1846 {
1847  long num;
1848  ptr_choice_point cp;
1849 
1850  num=0;
1851  cp=choice_stack;
1852  while (cp) {
1853  num++;
1854  cp=cp->next;
1855  }
1856  return num;
1857 }
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)

Definition at line 1861 of file login.c.

1863 {
1864  // long num;
1865 
1866  return (vt?(num_vars(vt->left)+1+num_vars(vt->right)):0);
1867 }
long num_vars(ptr_node vt)
Definition: login.c:1861
ptr_node left
Definition: def_struct.h:183
ptr_node right
Definition: def_struct.h:184
ptr_node one_attr ( )

Definition at line 4749 of file built_ins.c.

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

4750 {
4751  ptr_node n;
4752 
4753  n = STACK_ALLOC(node);
4754  n->key = one;
4755  n->data = NULL; /* To be filled in later */
4756  n->left = NULL;
4757  n->right = NULL;
4758 
4759  return n;
4760 }
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
char * one
Definition: def_glob.h:250
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_node right
Definition: def_struct.h:184
void one_pass_always_check ( long *  ch)

Definition at line 976 of file types.c.

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

978 {
979  ptr_definition d;
980 
981 
982  for(d=first_definition;d;d=d->next)
983  if (d->type_def==(def_type)type_it && !d->always_check)
985 }
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)
Definition: types.c:950
ptr_definition first_definition
Definition: def_glob.h:3
long only_arg1 ( ptr_psi_term  t,
ptr_psi_term arg1 
)

Definition at line 1528 of file built_ins.c.

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

1531 {
1532  ptr_node n=t->attr_list;
1533 
1534  if (n && n->left==NULL && n->right==NULL && !featcmp(n->key,one)) {
1535  *arg1=(ptr_psi_term)n->data;
1536  return TRUE;
1537  }
1538  else
1539  return FALSE;
1540 }
GENERIC data
Definition: def_struct.h:185
#define NULL
Definition: def_const.h:203
ptr_node left
Definition: def_struct.h:183
char * key
Definition: def_struct.h:182
#define TRUE
Definition: def_const.h:127
#define FALSE
Definition: def_const.h:128
char * one
Definition: def_glob.h:250
long featcmp(char *str1, char *str2)
Definition: trees.c:89
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_node attr_list
Definition: def_struct.h:171
ptr_node right
Definition: def_struct.h:184
long opcheck ( ptr_psi_term  t,
long *  prec,
long *  type 
)

Definition at line 834 of file print.c.

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

838 {
839  long op;
840  long result=NOTOP;
841  long numarg=check_opargs(t->attr_list);
842  ptr_operator_data opdat=t->type->op_data;
843 
844  *prec=0;
845  if (numarg!=1 && numarg!=3) return NOTOP;
846  while (opdat) {
847  op=opdat->type;
848  if (numarg==1) {
849  if (op==xf || op==yf) { result=POSTFIX; break; }
850  if (op==fx || op==fy) { result=PREFIX; break; }
851  }
852  if (numarg==3)
853  if (op==xfx || op==xfy || op==yfx) { result=INFIX; break; }
854  opdat=opdat->next;
855  }
856  if (opdat==NULL) return NOTOP;
857  *prec=opdat->precedence;
858  *type=op;
859  return result;
860 }
#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)

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

506 {
507  long ok=TRUE;
508  long stdin_flag;
509 
510  /* Save global input file state */
512 
513  file=expand_file_name(file);
514 
515  if ((stdin_flag=(!strcmp(file,"stdin")))) {
516  input_stream=stdin;
517  noisy=TRUE;
518  }
519  else {
520  input_stream=fopen(file,"r");
521  noisy=FALSE;
522  }
523 
524  if (input_stream==NULL) {
525  Errorline("file '%s' does not exist.\n",file);
526  file="stdin";
527  input_stream=stdin;
528  noisy=TRUE;
529  ok=FALSE;
530  }
531 
532  if (!stdin_flag || stdin_state==NULL) {
533  /* Initialize a new global input file state */
534  strcpy(input_file_name,file);
536  /* Create a new state containing the new global values */
538  if (stdin_flag) stdin_state=input_state;
539  }
540  else {
543  }
544 
545  return ok;
546 }
void init_parse_state()
Definition: token.c:381
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)
Definition: token.c:230
#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)
Definition: token.c:267
#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)
Definition: token.c:449
void new_state(ptr_psi_term *t)
Definition: token.c:301
void open_module_one ( ptr_psi_term  t,
int *  onefailed 
)

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

553 {
554  ptr_module open_module;
555  ptr_int_list opens;
556  ptr_keyword key1,key2;
557  int i;
558  int found=FALSE;
559 
560  open_module=find_module(string_val(t));
561  if (open_module) {
562 
563  for (opens=current_module->open_modules;opens;opens=opens->next)
564  if (opens->value_1 == (GENERIC)open_module) {
565  /* warningline("module \"%s\" is already open\n",
566  open_module->module_name); */ /* RM: Jan 27 1993 */
567  found=TRUE;
568  }
569 
570  if (!found) {
571  opens=HEAP_ALLOC(struct wl_int_list);
572  opens->value_1=(GENERIC)open_module;
575 
576  /* Check for name conflicts */
577  /* RM: Feb 23 1993 */
578  for (i=0;i<open_module->symbol_table->size;i++)
579  if ((key1=open_module->symbol_table->data[i]) && key1->public) {
581  if (key2 && key1->definition!=key2->definition)
582  Errorline("symbol clash '%s' and '%s'\n",
583  key1->combined_name,
584  key2->combined_name);
585  }
586  }
587  }
588  else {
589  Errorline("module \"%s\" not found\n",string_val(t));
590  *onefailed=TRUE;
591  }
592 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
Definition: hash_table.c:133
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:13
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)
Definition: modules.c:164
ptr_module find_module(char *module)
Definition: modules.c:48
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 
)

Definition at line 533 of file modules.c.

References open_module_one().

536 {
537  if (n) {
538  ptr_psi_term t;
539  open_module_tree(n->left,onefailed);
540 
541  t=(ptr_psi_term)n->data;
542  open_module_one(t,onefailed);
543 
544  open_module_tree(n->right,onefailed);
545  }
546 }
void open_module_tree(ptr_node n, int *onefailed)
Definition: modules.c:533
GENERIC data
Definition: def_struct.h:185
void open_module_one(ptr_psi_term t, int *onefailed)
Definition: modules.c:550
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 
)

Definition at line 780 of file types.c.

References HEAP_ALLOC, NULL, and wl_int_list::value_1.

782 {
783  while (v) {
784  u->value_1= (GENERIC)(((unsigned long)(u->value_1)) | ((unsigned long)(v->value_1)));
785  v=v->next;
786  if (u->next==NULL && v) {
788  u=u->next;
789  u->value_1=0;
790  u->next=NULL;
791  }
792  else
793  u=u->next;
794  }
795 }
#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)
Definition: print.c:1460
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
Definition: print.c:147
void print_def_type(def_type t)
Definition: types.c:21
#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)
Definition: print.c:173
#define assert(N)
Definition: memory.c:104
long overlap_type ( ptr_definition  t1,
ptr_definition  t2 
)

Definition at line 1486 of file types.c.

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

1489 {
1490  ptr_int_list c1,c2;
1491  long result=TRUE;
1492 
1493  if (t1!=t2 && t1!=top && t2!=top) {
1494 
1495  c1=t1->code;
1496  c2=t2->code;
1497  result=FALSE;
1498 
1499  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1500  while (!result && c1 && c2) {
1501  result=(((unsigned long)(c1->value_1)) & ((unsigned long)(c2->value_1)));
1502  c1=c1->next;
1503  c2=c2->next;
1504  }
1505  }
1506  }
1507 
1508  /*
1509  printf("overlap_type(%s,%s) => %ld\n",t1->def->keyword->symbol,t2->def->keyword->symbol,result);
1510  */
1511 
1512  return result;
1513 }
#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)

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

879 {
880  psi_term s,t,u;
881  long c;
882 
884  parse_ok=TRUE;
885 
886  /*s=read_life_form('.','?');*/
887  s=read_life_form(0,0);
888 
889  if (parse_ok) {
890  if (s.type!=eof) {
891  read_token(&t);
892 
893  /*
894  if (equ_tokch(t,'?'))
895  *q=QUERY;
896  else if (equ_tokch(t,'.'))
897  *q=FACT;
898  */
899 
900  /* RM: Jul 7 1993 */
901  if (t.type==final_question)
902  {
903  *q=QUERY;
904  }
905  else if (t.type==final_dot)
906  {
907  *q=FACT;
908  }
909  else
910  {
912  else {
913 
914  /*
915  perr("*** Syntax error ");psi_term_error();perr(": ");
916  display_psi_stderr(&t);
917  perr(".\n");
918  */
919 
920  /* RM: Feb 1 1993 */
921  Syntaxerrorline("'%P' (%E)\n",&t);
922 
923  }
924  *q=ERROR;
925  }
926  }
927  }
928 
929 
930  if (!parse_ok) {
931 
932  while (saved_psi_term!=NULL) read_token(&u);
933 
934  prompt="error>";
935  while((c=read_char()) && c!=EOF && c!='.' && c!='?' && c!=EOLN) {}
936 
937  *q=ERROR;
938  }
939  else if (saved_char)
940  do {
941  c=read_char();
942  if (c==EOLN)
943  c=0;
944  else if (c<0 || c>32) {
945  put_back_char(c);
946  c=0;
947  }
948  } while(c && c!=EOF);
949 
950  /* Make sure arguments of nonstrict terms are marked quoted. */
951  if (parse_ok) mark_nonstrict(&s); /* 25.8 */
952 
953  /* mark_eval(&s); 24.8 XXX */
954 
955  /* Mark all the psi-terms corresponding to variables in the var_tree as */
956  /* quoted. This is needed for correct parsing of inputs; otherwise vars */
957  /* that occur in an increment of a query are marked to be evaluated again! */
958  /* mark_quote_tree(var_tree); 24.8 XXX */
959 
960 
961  return s;
962 }
void put_back_char(long c)
Definition: token.c:633
void read_token(ptr_psi_term tok)
Definition: token.c:1063
#define FACT
Definition: def_const.h:151
void mark_nonstrict(ptr_psi_term t)
Definition: copy.c:462
#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)
Definition: parser.c:700
#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()
Definition: token.c:587
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 
)

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

308 {
309  ptr_psi_term car=NULL;
310  ptr_psi_term cdr=NULL;
311  psi_term result;
312  psi_term t;
313  char a;
314 
315 
316 
317  result=list_nil(typ); /* RM: Feb 1 1993 */
318 
319  if (parse_ok) {
320 
321  /* Character used for building cons pairs */
322  a='|'; /* RM: Jan 11 1993 */
323 
324 
325  read_token(&t);
326 
327  if(!equ_tokc(t,e)) {
328 
329  /* Read the CAR of the list */
330  put_back_token(t);
332 
333  /* Read the CDR of the list */
334  read_token(&t);
335  if(equ_tokch(t,s))
336  cdr=stack_copy_psi_term(parse_list(typ,e,s));
337  else if(equ_tokch(t,e))
338  cdr=stack_copy_psi_term(list_nil(typ));
339  else if(equ_tokch(t,'|')) {
341  read_token(&t);
342  if(!equ_tokch(t,e)) {
344  else {
345  perr("*** Syntax error ");psi_term_error();
346  perr(": bad symbol for end of list '");
347  display_psi_stderr(&t);
348  perr("'.\n");
349  put_back_token(t);
350  }
351  }
352  }
353  else
355  else {
356  perr("*** Syntax error ");psi_term_error();
357  perr(": bad symbol in list '");
358  display_psi_stderr(&t);
359  perr("'.\n");
360  put_back_token(t);
361  }
362 
363  result.type=typ;
364  if(car)
365  (void)stack_insert(FEATCMP,one,&(result.attr_list),(GENERIC)car);
366  if(cdr)
367  (void)stack_insert(FEATCMP,two,&(result.attr_list),(GENERIC)cdr);
368  }
369  }
370 
371  return result;
372 }
void psi_term_error()
Definition: token.c:661
#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)
Definition: token.c:1063
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)
Definition: parser.c:304
void display_psi_stderr(ptr_psi_term t)
Definition: print.c:1438
void put_back_token(psi_term t)
Definition: token.c:647
psi_term read_life_form(char ch1, char ch2)
Definition: parser.c:700
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
#define FALSE
Definition: def_const.h:128
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
char * one
Definition: def_glob.h:250
psi_term list_nil(ptr_definition type)
Definition: parser.c:255
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 ( )

Definition at line 81 of file memory.c.

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

82 {
84  printf("stack pointer is: %lx\n",(unsigned long)stack_pointer);
85  for(c=choice_stack;c;c=c->next)
86  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);
87 }
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)

Definition at line 876 of file types.c.

References perr_s().

878 {
879  perr_s("%s",d->keyword->symbol);
880 }
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)

Definition at line 892 of file types.c.

References perr(), perr_sort(), and perr_sort_list().

894 {
896  perr(" <| ");
897  perr_sort_list(anc);
898 }
void perr(char *str)
Definition: error.c:659
void perr_sort_list(ptr_int_list anc)
Definition: types.c:882
void perr_sort(ptr_definition d)
Definition: types.c:876
GENERIC value_1
Definition: def_struct.h:54
void perr_sort_list ( ptr_int_list  anc)

Definition at line 882 of file types.c.

References perr(), and perr_sort().

884 {
885  if (anc) {
886  perr_sort_list(anc->next);
887  if (anc->next) perr(" <| ");
889  }
890 }
void perr(char *str)
Definition: error.c:659
void perr_sort_list(ptr_int_list anc)
Definition: types.c:882
void perr_sort(ptr_definition d)
Definition: types.c:876
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 
)

Definition at line 2538 of file built_ins.c.

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

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

Definition at line 2577 of file built_ins.c.

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

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

Definition at line 2561 of file built_ins.c.

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

2563 {
2564  if (n) {
2565  ptr_psi_term t;
2566  persistent_tree(n->left);
2567 
2568  t=(ptr_psi_term)n->data;
2569  deref_ptr(t);
2570  persistent_one(t);
2571 
2572  persistent_tree(n->right);
2573  }
2574 }
void persistent_tree(ptr_node n)
Definition: built_ins.c:2561
void persistent_one(ptr_psi_term t)
Definition: built_ins.c:2577
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define deref_ptr(P)
Definition: def_macro.h:95
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
ptr_node right
Definition: def_struct.h:184
long pop ( ptr_psi_term  tok,
long *  op 
)

Definition at line 115 of file parser.c.

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

118 {
119  long r=0;
120 
121  if (parser_stack_index==0) {
122  /*
123  perr("*** Parser error ");
124  psi_term_error();
125  perr(": stack empty.\n");
126  */
127 
128  (*tok)= *error_psi_term;
129  parse_ok=FALSE;
130  }
131  else {
133  (*op)=op_stack[parser_stack_index];
136  }
137 
138  return r;
139 }
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 
)

Definition at line 159 of file parser.c.

References wl_operator_data::next, NOP, and wl_operator_data::precedence.

162 {
163  long r=NOP;
165 
166  o=tok.type->op_data;
167  while(o && r==NOP) {
168  if(typ==o->type)
169  r=o->precedence;
170  else
171  o=o->next;
172  }
173 
174  return r;
175 }
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 
)

Definition at line 2300 of file built_ins.c.

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

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

Definition at line 1365 of file print.c.

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

1367 {
1369  /* write_stderr=FALSE; */
1371  main_pred_write(n);
1372  (void)fflush(outfile);
1373 }
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 
)

Definition at line 1180 of file print.c.

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

1183 {
1184  ptr_tab_brk new;
1185  long cnt=1;
1186 
1187  prettyf("(");
1188  new_tab(&new);
1189 
1190  do_pretty_attr(t,new,&cnt,two_or_more(t),depth);
1191 
1192  prettyf(")");
1193 }
void pretty_list ( ptr_psi_term  t,
long  depth 
)

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

664 {
665  ptr_tab_brk new;
666  // ptr_list l;
667  ptr_definition t_type;
668  ptr_psi_term car,cdr;
669  ptr_node n; // ,n2;
670  // char *tag=NULL;
671  // char colon[2],sep[4],end[3];
672  char sep[4],end[3];
673  long list_depth; /* 20.8 */
674  long done=FALSE; /* RM: Dec 11 1992 */
675 
676 
677  strcpy(sep,"ab");
678  strcpy(end,"cd");
679  t_type=t->type;
680 
681  if (overlap_type(t_type,alist)) {
682  if (!equal_types(t_type,alist)) {
683  pretty_symbol(t_type->keyword); /* RM: Jan 13 1993 */
684  prettyf(DOTDOT);
685  }
686  prettyf("[");
687  strcpy(sep,",");
688  strcpy(end,"]");
689  }
690 
691  /*
692  else if (equal_types(t_type,conjunction)) {
693  prettyf("(");
694  strcpy(sep,DOTDOT);
695  strcpy(end,")");
696  }
697  */
698 
699  else if (equal_types(t_type,disjunction)) {
700  prettyf("{");
701  strcpy(sep,";");
702  strcpy(end,"}");
703  }
704 
705 
706  /* RM: Dec 11 1992 New code for printing lists */
707 
708  new_tab(&new);
709  list_depth=0; /* 20.8 */
710  while(!done) {
711  mark_tab(new);
712  if(list_depth==print_depth)
713  prettyf("...");
714 
715  get_two_args(t->attr_list,&car,&cdr);
716  deref_ptr(car);
717  deref_ptr(cdr);
718 
719 
720  if(list_depth<print_depth)
722 
723  /* Determine how to print the CDR */
724  n=find(INTCMP,(char *)cdr,pointer_names);
725 
726  if(n && n->data) {
727  prettyf("|");
729  done=TRUE;
730  }
731  else
732  if(( /* RM: Feb 1 1993 */
733  (cdr->type==nil && overlap_type(t_type,alist)) ||
734  (cdr->type==disj_nil && t_type==disjunction)
735  )
736  && !cdr->attr_list)
737  done=TRUE;
738  else
739  if(!check_legal_cons(cdr,t_type)) {
740  prettyf("|");
742  done=TRUE;
743  }
744  else {
745  if(list_depth<print_depth)
746  prettyf(sep);
747  t=cdr;
748  }
749 
750  list_depth++;
751  }
752 
753  prettyf(end);
754 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define INTCMP
Definition: def_const.h:256
void pretty_symbol(ptr_keyword k)
Definition: modules.c:446
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)
Definition: types.c:1486
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)
Definition: trees.c:341
#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 ( )

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

1201 {
1202  ptr_item i;
1203  long j;
1204 
1205  for(i=pretty_things+1;(unsigned long)i<(unsigned long)indx;i++) {
1206  if(i->tab->broken && i->tab->printed) {
1207  fprintf(outfile,"\n");
1208  for(j=0;j<i->tab->column;j++)
1209  fprintf(outfile," ");
1210  }
1211  fprintf(outfile,"%s",i->str);
1212  i->tab->printed=TRUE;
1213  }
1214 }
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 
)

Definition at line 972 of file print.c.

References wl_goal::aaaa_1, alist, 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, seg_format, stream, STRLEN, sub_type(), sys_bytedata, WL_MAXINT, and write_canon.

976 {
977  char buf[STRLEN]; /* Big enough for a long number */
978  ptr_residuation r;
979  long argswritten;
980  // double fmod();
981 
982  if (t) {
983  deref_ptr(t); /* PVR */
984 
985  /* if (trace) printf("<%ld>",t->status); For brunobug.lf PVR 14.2.94 */
986 
987  /* RM: Feb 12 1993 */
988  if(display_persistent &&
990  prettyf(" $");
991 
992  if((t->type==alist || t->type==disjunction) && check_legal_cons(t,t->type))
993  pretty_list(t,depth+1); /* RM: Dec 11 1992 */
994  else
995  if(t->type==nil && !t->attr_list)
996  prettyf("[]");
997  else
998  if(t->type==disj_nil && !t->attr_list) /* RM: Feb 1 1993 */
999  prettyf("{}");
1000  else {
1001  argswritten=FALSE;
1002  if (t->value_3) {
1003 #ifdef CLIFE
1004  if(t->type->type==block) { /* RM 20 Jan 1993 */
1005  pretty_block(t); /* AA 21 Jan 1993 */
1006  }
1007  else
1008 #endif /* CLIFE */
1009  if (sub_type(t->type,integer)) {
1010  /* Print integers in chunks up to the full precision of the REAL */
1011  long seg,neg,i;
1012  REAL val;
1013  char segbuf[100][PRINT_POWER+3];
1014 
1015  val = *(REAL *)t->value_3;
1016  neg = (val<0.0);
1017  if (neg) val = -val;
1018  if (val>WL_MAXINT) goto PrintReal;
1019  seg=0;
1020  while (val>=(double)PRINT_SPLIT) {
1021  double tmp;
1022  tmp=(REAL)fmod((double)val,(double)PRINT_SPLIT);
1023  (void)snprintf(segbuf[seg],100,seg_format,(unsigned long)tmp);
1024  val=floor(val/(double)PRINT_SPLIT);
1025  seg++;
1026  }
1027  (void)snprintf(segbuf[seg],100,"%s%ld",(neg?"-":""),(unsigned long)val);
1028  for (i=seg; i>=0; i--) prettyf(segbuf[i]);
1029  if (!equal_types(t->type,integer)) {
1030  prettyf(DOTDOT);
1031  pretty_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1032  }
1033  }
1034  else if (sub_type(t->type,real)) {
1035  PrintReal:
1036  (void)snprintf(buf,STRLEN,"%lg",*(REAL *)t->value_3);
1037  prettyf(buf);
1038  if (!equal_types(t->type,real) &&
1039  !equal_types(t->type,integer)) {
1040  prettyf(DOTDOT);
1041  pretty_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1042  }
1043  }
1044  else if (sub_type(t->type,quoted_string)) {
1045  prettyf_quoted_string((char *)t->value_3);
1046  if(!equal_types(t->type,quoted_string)) {
1047  prettyf(DOTDOT);
1048  pretty_quote_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1049  }
1050  }
1051  /* DENYS: BYTEDATA */
1052  else if (sub_type(t->type,sys_bytedata)) {
1054  }
1055  else if (equal_types(t->type,stream)) {
1056  (void)snprintf(buf,STRLEN,"stream(%ld)",(long)t->value_3);
1057  prettyf(buf);
1058  }
1059  else if (equal_types(t->type,eof))
1060  pretty_quote_symbol(eof->keyword); /* RM: Jan 13 1993 */
1061  else if (equal_types(t->type,cut))
1062  pretty_quote_symbol(cut->keyword); /* RM: Jan 13 1993 */
1063  else {
1064  prettyf("*** bad object '");
1065  pretty_symbol(t->type->keyword); /* RM: Jan 13 1993 */
1066  prettyf("'***");
1067  }
1068  }
1069  else {
1070  if (depth<print_depth) /* 20.8 */
1071  argswritten=pretty_psi_with_ops(t,sprec,depth+1);
1072  /* RM: Jan 13 1993 */
1073  if (!argswritten) pretty_quote_symbol(t->type->keyword);
1074  }
1075 
1076  /* write_canon -- PVR 24.2.94 */
1077  if (!argswritten && t->attr_list &&
1078  (depth<print_depth || write_canon)) /* 20.8 */
1079  pretty_attr(t->attr_list,depth+1);
1080 
1081  if (depth>=print_depth && !write_canon && t->attr_list) /* 20.8 */
1082  prettyf("(...)");
1083  }
1084  if ((r=t->resid))
1085  while (r) {
1086  if (r->goal->pending) {
1087  if (FALSE /* write_resids 11.8 */) {
1088  prettyf("\\");
1089  pretty_psi_term(r->goal->aaaa_1,0,depth);
1090  }
1091  else
1092  prettyf("~");
1093  }
1094  r=r->next;
1095  }
1096  }
1097 }
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)
Definition: modules.c:446
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)
Definition: types.c:1544
void pretty_quote_symbol(ptr_keyword k)
Definition: modules.c:464
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 
)

Definition at line 866 of file print.c.

References deref_ptr, FALSE, func_flag, fx, fy, get_two_args(), INFIX, listing_flag, MAX_PRECEDENCE, opcheck(), POSTFIX, PREFIX, pretty_quote_symbol(), pretty_tag_or_psi_term(), prettyf(), TRUE, write_canon, xf, xfx, xfy, yf, and yfx.

870 {
871  // ptr_tab_brk new;
872  ptr_psi_term arg1, arg2;
873  long ttype, a1type, a2type;
874  long tprec, a1prec, a2prec;
875  long tkind, a1kind, a2kind;
876  long p1, p2, argswritten;
877  long sp; /* surrounding parentheses */
878 
879  if (write_canon) return FALSE; /* PVR 24.2.94 */
880 
881  argswritten=TRUE;
882  tkind=opcheck(t, &tprec, &ttype);
883  sp=(tkind==INFIX||tkind==PREFIX||tkind==POSTFIX) && tprec>=sprec;
884  if (sp) prettyf("(");
885  if (tkind==INFIX) {
886  get_two_args(t->attr_list, &arg1, &arg2);
887  deref_ptr(arg1); /* 16.9 */
888  deref_ptr(arg2); /* 16.9 */
889  a1kind = opcheck(arg1, &a1prec, &a1type);
890  a2kind = opcheck(arg2, &a2prec, &a2type);
891 
892  /* The p1 and p2 flags tell whether to put parens around t's args */
893  /* Calculate p1 flag: */
894  if (a1prec>tprec) p1=TRUE;
895  else if (a1prec<tprec) p1=FALSE;
896  else /* equal priority */
897  if (ttype==xfy || ttype==xfx) p1=TRUE;
898  else /* yfx */
899  if (a1type==yfx || a1type==fx || a1type==fy) p1=FALSE;
900  else p1=TRUE;
901 
902  /* Calculate p2 flag: */
903  if (a2prec>tprec) p2=TRUE;
904  else if (a2prec<tprec) p2=FALSE;
905  else /* equal priority */
906  if (ttype==yfx || ttype==xfx) p2=TRUE;
907  else /* xfy */
908  if (a2type==xfy || a2type==xf || a2type==yf) p2=FALSE;
909  else p2=TRUE;
910 
911  /* Write the expression */
912  if (p1) prettyf("(");
914  if (p1) prettyf(")");
915  if (!p1 && strcmp(t->type->keyword->symbol,",")) {
916  prettyf(" ");
917  }
918  pretty_quote_symbol(t->type->keyword); /* RM: Jan 13 1993 */
919  if (listing_flag && !func_flag &&
920  (!strcmp(t->type->keyword->symbol,",") ||
921  !strcmp(t->type->keyword->symbol,":-"))) {
922  prettyf("\n ");
923  }
924  else {
925  if (!p2 && strcmp(t->type->keyword->symbol,".")) prettyf(" ");
926  }
927  if (p2) prettyf("(");
929  if (p2) prettyf(")");
930  }
931  else if (tkind==PREFIX) {
932  get_two_args(t->attr_list, &arg1, &arg2); /* arg2 does not exist */
933  a1kind = opcheck(arg1, &a1prec, &a1type);
934 
935  /* Calculate p1 flag: */
936  if (a1type==fx || a1type==fy) p1=FALSE;
937  else p1=(tprec<=a1prec);
938 
939  pretty_quote_symbol(t->type->keyword); /* RM: Jan 13 1993 */
940  if (!p1) prettyf(" ");
941  if (p1) prettyf("(");
943  if (p1) prettyf(")");
944  }
945  else if (tkind==POSTFIX) {
946  get_two_args(t->attr_list, &arg1, &arg2); /* arg2 does not exist */
947  a1kind = opcheck(arg1, &a1prec, &a1type);
948 
949  /* Calculate p1 flag: */
950  if (a1type==xf || a1type==yf) p1=FALSE;
951  else p1=(tprec<=a1prec);
952 
953  if (p1) prettyf("(");
955  if (p1) prettyf(")");
956  if (!p1) prettyf(" ");
957  pretty_quote_symbol(t->type->keyword); /* RM: Jan 13 1993 */
958  }
959  else {
960  argswritten=FALSE;
961  }
962  if (sp) prettyf(")");
963  return argswritten;
964 }
void get_two_args(ptr_node t, ptr_psi_term *a, ptr_psi_term *b)
Definition: login.c:37
#define yfx
Definition: def_const.h:268
#define 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)
Definition: modules.c:464
#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)

Definition at line 464 of file modules.c.

References wl_keyword::definition, display_modules, wl_definition::keyword, prettyf(), and prettyf_quote().

467 {
468  k=k->definition->keyword;
469  if(display_modules) {
471  prettyf("#");
472  }
473  prettyf_quote(k->symbol);
474 }
long display_modules
Definition: modules.c:23
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)
Definition: print.c:447
void prettyf_quote(char *s)
Definition: print.c:474
void pretty_symbol ( ptr_keyword  k)

Definition at line 446 of file modules.c.

References wl_keyword::definition, display_modules, wl_definition::keyword, and prettyf().

449 {
450  k=k->definition->keyword;
451  if(display_modules) {
453  prettyf("#");
454  }
455  prettyf(k->symbol);
456 }
long display_modules
Definition: modules.c:23
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)
Definition: print.c:447
void pretty_tag_or_psi_term ( ptr_psi_term  p,
long  sprec,
long  depth 
)

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

765 {
766  ptr_node n,n2;
767 
768  if (p==NULL) {
769  prettyf("<VOID>");
770  return;
771  }
772  if (FALSE /*depth>=print_depth*/) { /* 20.8 */
773  prettyf("...");
774  return;
775  }
776  deref_ptr(p);
777 
778  n=find(INTCMP,(char *)p,pointer_names);
779 
780  if (n && n->data) {
781  if (n->data==(GENERIC)no_name) {
782  n->data=(GENERIC)unique_name();
783  /* sprintf(name,"_%ld%c",++gen_sym_counter,0); */
784  /* n->data=(GENERIC)heap_copy_string(name); */
785  }
786  n2=find(INTCMP,(char *)p,printed_pointers);
787  if(n2==NULL) {
788  prettyf((char *)n->data);
789  (void)heap_insert(INTCMP,(char *)p,&printed_pointers,(GENERIC)n->data);
790  if (!is_top(p)) {
791  prettyf(DOTDOT);
792  pretty_psi_term(p,COLON_PREC,depth);
793  }
794  }
795  else
796  prettyf((char *)n2->data);
797  }
798  else
799  pretty_psi_term(p,sprec,depth);
800 }
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)
Definition: trees.c:276
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)
Definition: trees.c:341
unsigned long * GENERIC
Definition: def_struct.h:17
void pretty_variables ( ptr_node  n,
ptr_tab_brk  tab 
)

Definition at line 1221 of file print.c.

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

1224 {
1225  ptr_psi_term tok;
1226  ptr_node n2;
1227 
1228  if(n->left) {
1229  pretty_variables(n->left,tab);
1230  prettyf(", ");
1231  }
1232 
1233  mark_tab(tab);
1234  prettyf(n->key);
1235  prettyf(" = ");
1236 
1237  tok=(ptr_psi_term )n->data;
1238  deref_ptr(tok);
1239  n2=find(INTCMP,(char *)tok,printed_pointers);
1240  if(strcmp((char *)n2->data,n->key)<0)
1241  /* Reference to previously printed variable */
1242  prettyf((char *)n2->data);
1243  else {
1244  if (eqsym->op_data) {
1245  long tkind, tprec, ttype, eqprec;
1246  eqprec=eqsym->op_data->precedence;
1247  tkind=opcheck(tok, &tprec, &ttype);
1248  if (tprec>=eqprec) prettyf("(");
1250  if (tprec>=eqprec) prettyf(")");
1251  }
1252  else
1254  }
1255 
1256  if(n->right) {
1257  prettyf(", ");
1258  pretty_variables(n->right,tab);
1259  }
1260 }
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)
Definition: trees.c:341
#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)

Definition at line 447 of file print.c.

References FALSE, and prettyf_inner().

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

Definition at line 349 of file print.c.

References buffer, indent, and outfile.

353 {
354  char *sb=buffer;
355 
356  if (indent) {
357  while (*sb) sb++;
358  if (q) { *sb = c; sb++; }
359  while (*s) {
360  if (q && *s==c) { *sb = *s; sb++; }
361  *sb = *s; sb++; s++;
362  }
363  if (q) { *sb = c; sb++; }
364  *sb=0;
365  }
366  else {
367  if (q) (void)putc(c,outfile);
368  while (*s) {
369  if (q && *s==c) { (void)putc(*s,outfile); }
370  (void)putc(*s,outfile);
371  s++;
372  }
373  if (q) (void)putc(c,outfile);
374  }
375 }
FILE * outfile
Definition: def_glob.h:333
void prettyf_quote ( char *  s)

Definition at line 474 of file print.c.

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

476 {
477  prettyf_inner(s, const_quote && !no_quote(s), '\'');
478 }
void prettyf_quoted_string ( char *  s)

Definition at line 454 of file print.c.

References const_quote, and prettyf_inner().

456 {
457  prettyf_inner((char *)s,const_quote,'"');
458 }
void print_bin ( long  b)

Definition at line 130 of file print.c.

References INT_SIZE, and outfile.

132 {
133  long p;
134 
135  for (p=INT_SIZE;p--;p>0)
136  {
137  fprintf(outfile,(b&1?"X":" "));
138  b = b>>1;
139  }
140 }
#define INT_SIZE
Definition: def_const.h:144
FILE * outfile
Definition: def_glob.h:333
void print_code ( FILE *  s,
ptr_int_list  c 
)

Definition at line 147 of file print.c.

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

150 {
151  outfile=s;
152 
153  if (c==NOT_CODED)
154  fprintf(outfile," (not coded) ");
155  else {
156  fprintf(outfile," [");
157  while (c) {
158  print_bin((long)c->value_1);
159  c=c->next;
160  }
161  fprintf(outfile,"]");
162  }
163 }
#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 ( )

Definition at line 1178 of file types.c.

References outputline(), and type_count.

1179 {
1180  long i;
1181 
1182  for (i=0; i<type_count; i++) {
1183  outputline("%C = %s\n",
1184  gamma_table[i]->code,
1185  gamma_table[i]->keyword->combined_name);
1186  }
1187 }
ptr_definition * gamma_table
Definition: types.c:16
long type_count
Definition: def_glob.h:46
void outputline(char *format,...)
Definition: error.c:79
void print_def_type ( def_type  t)

Definition at line 21 of file types.c.

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

23 {
24  switch ((long)t) {
25  case (long)predicate:
26  perr("predicate");
27  break;
28  case (long)function_it:
29  perr("function");
30  break;
31  case (long)type_it:
32  perr("sort");
33  break;
34  case (long)global: /* RM: Feb 8 1993 */
35  perr("global variable");
36  break;
37  default:
38  perr("undefined");
39  }
40 }
#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)

Definition at line 1396 of file memory.c.

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

1398 {
1399  fprintf(stderr," [%ld%% free (%ldK), %ld%% heap, %ld%% stack",
1400  (100*((unsigned long)heap_pointer-(unsigned long)stack_pointer)+mem_size/2)/mem_size,
1401  ((unsigned long)heap_pointer-(unsigned long)stack_pointer+512)/1024,
1402  (100*((unsigned long)mem_limit-(unsigned long)heap_pointer)+mem_size/2)/mem_size,
1403  (100*((unsigned long)stack_pointer-(unsigned long)mem_base)+mem_size/2)/mem_size);
1404  if (timeflag) {
1405  fprintf(stderr,", %1.3fs cpu (%ld%%)",
1406  gc_time,
1407  (unsigned long)(0.5+100*gc_time/(life_time+gc_time)));
1408  }
1409  fprintf(stderr,"]\n");
1410 }
GENERIC mem_limit
Definition: def_glob.h:13
static float gc_time
Definition: memory.c:23
int mem_size
Definition: def_glob.h:9
static float life_time
Definition: memory.c:23
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 
)

Definition at line 173 of file print.c.

References fx, fy, xf, xfx, xfy, yf, and yfx.

176 {
177  switch (kind) {
178  case xf:
179  fprintf(s,"xf");
180  break;
181  case fx:
182  fprintf(s,"fx");
183  break;
184  case yf:
185  fprintf(s,"yf");
186  break;
187  case fy:
188  fprintf(s,"fy");
189  break;
190  case xfx:
191  fprintf(s,"xfx");
192  break;
193  case xfy:
194  fprintf(s,"xfy");
195  break;
196  case yfx:
197  fprintf(s,"yfx");
198  break;
199  default:
200  fprintf(s,"illegal");
201  break;
202  }
203 }
#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 
)

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

1565 {
1566  GENERIC old_heap_pointer;
1567  ptr_tab_brk new;
1568  ptr_resid_list r2; /* 21.9 */
1569 
1570  outfile=stdout;
1572  old_heap_pointer=heap_pointer;
1573 
1576  gen_sym_counter=0;
1577 
1578  check_pointer(t);
1579 
1580  r2=r;
1581  while(r2) {
1582  check_pointer(r2->var);
1583  r2=r2->next;
1584  }
1585 
1587 
1588  indent=FALSE;
1589  const_quote=TRUE;
1592  *buffer=0;
1594  new_tab(&new);
1595  mark_tab(new);
1596 
1597  prettyf("residuating ");
1599  prettyf(" on variable(s) {");
1600 
1601  r2=r;
1602  while(r2) {
1604  r2=r2->next;
1605  if(r2)
1606  prettyf(",");
1607  }
1608 
1609  prettyf("}\n");
1610  end_tab();
1611 
1612  heap_pointer=old_heap_pointer;
1613 }
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)

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; }

Definition at line 429 of file modules.c.

References wl_keyword::combined_name, wl_keyword::definition, display_modules, and wl_definition::keyword.

433 {
434  k=k->definition->keyword;
435  if(display_modules)
436  return k->combined_name;
437  else
438  return k->symbol;
439 }
long display_modules
Definition: modules.c:23
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 ( )

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

108 {
110 
111  while (u) {
112  if ((GENERIC)u->aaaa_3<mem_base || (GENERIC)u->aaaa_3>mem_limit ||
113  (GENERIC)u->next<mem_base || (GENERIC)u->next>mem_limit) {
114  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);
115  (void)fflush(stdout);
116  }
117  u=u->next;
118  }
119 }
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)

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

1275 {
1276  ptr_tab_brk new;
1277  GENERIC old_heap_pointer;
1278  if (!printflag) return FALSE; /* 21.1 */
1279 
1282  old_heap_pointer=heap_pointer;
1283 
1286  gen_sym_counter=0;
1290 
1291  indent=TRUE;
1292  const_quote=TRUE;
1295  *buffer=0;
1297 
1298  if (var_tree) {
1299  new_tab(&new);
1301  prettyf(".");
1302  mark_tab(new);
1303  prettyf("\n");
1304  end_tab();
1305 
1306  if (indent) {
1307  work_out_length();
1308  pretty_output();
1309  }
1310  }
1311  heap_pointer=old_heap_pointer;
1312  return (var_tree!=NULL);
1313 }
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 
)

Definition at line 950 of file types.c.

References wl_definition::always_check, FALSE, wl_int_list::next, TRUE, and wl_int_list::value_1.

953 {
954  ptr_int_list child_list;
955  ptr_definition child;
956 
957  child_list = d->children;
958  while (child_list) {
959  child = (ptr_definition)child_list->value_1;
960  if (child->always_check) {
961  child->always_check = FALSE;
962  *ch = TRUE;
963  propagate_always_check(child,ch);
964  }
965  child_list = child_list->next;
966  }
967 }
char always_check
Definition: def_struct.h:134
#define TRUE
Definition: def_const.h:127
void propagate_always_check(ptr_definition d, long *ch)
Definition: types.c:950
#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 ( )

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

623 {
624  ptr_int_list kids;
625  ptr_definition d;
626 
627  adults=NULL;
628  find_adults();
629 
630  while (adults) {
631 
632  children=NULL;
633 
634  while (adults) {
636 
637  insert_own_prop(d);
639 
640  kids=d->children;
641 
642  while(kids) {
644  /* if (d->always_check && kids->value_1)
645  ((ptr_definition)kids->value_1)->always_check=TRUE; */
646  kids=kids->next;
647  }
648  adults=adults->next;
649  }
651  }
652 }
void find_adults()
Definition: types.c:516
#define NULL
Definition: def_const.h:203
void insert_prop(ptr_definition d, ptr_triple_list prop)
Definition: types.c:580
struct wl_definition * ptr_definition
Definition: def_struct.h:31
void insert_own_prop(ptr_definition d)
Definition: types.c:539
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 ( )

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

1546 {
1547  long success=TRUE;
1548  ptr_psi_term thegoal,head,body,arg1,arg2;
1549  ptr_pair_list rule;
1550 
1551  thegoal=(ptr_psi_term )aim->aaaa_1;
1552  rule=(ptr_pair_list )aim->bbbb_1;
1553 
1554  if (thegoal && rule) {
1555 
1556  deref_ptr(thegoal); /* Evaluation is explicitly handled later. */
1557 
1558  if (thegoal->type!=and) {
1559  if (thegoal->type!=cut)
1560  if(thegoal->type!=life_or) {
1561  /* User-defined predicates with unevaluated arguments */
1562  /* Built-ins do this themselves (see built_ins.c). */
1563  /* if (!thegoal->type->evaluate_args) mark_quote(thegoal); 24.8 25.8 */
1564 
1565  if(i_check_out(thegoal)) { /* RM: Apr 6 1993 */
1566 
1567  goal_stack=aim->next;
1568  goal_count++;
1569 
1570  if ((unsigned long)rule==DEFRULES) {
1571  rule=(ptr_pair_list)thegoal->type->rule;
1572  if (thegoal->type->type_def==(def_type)predicate) {
1573  if (!rule) /* This can happen when RETRACT is used */
1574  success=FALSE;
1575  }
1576  else if ( thegoal->type->type_def==(def_type)function_it
1577  || ( thegoal->type->type_def==(def_type)type_it
1578  && sub_type(boolean,thegoal->type)
1579  )
1580  ) {
1581  if (thegoal->type->type_def==(def_type)function_it && !rule)
1582  /* This can happen when RETRACT is used */
1583  success=FALSE;
1584  else {
1585  ptr_psi_term bool_pred;
1586  ptr_node a;
1587  /* A function F in pred. position is called as */
1588  /* '*bool_pred*'(F), which succeeds if F returns true */
1589  /* and fails if it returns false. It can residuate too. */
1590  bool_pred=stack_psi_term(0);
1591  bool_pred->type=boolpredsym;
1592  bool_pred->attr_list=(a=STACK_ALLOC(node));
1593  a->key=one;
1594  a->left=a->right=NULL;
1595  a->data=(GENERIC) thegoal;
1597  return success; /* We're done! */
1598  }
1599  }
1600  else if (!thegoal->type->protected && thegoal->type->type_def==(def_type)undef) {
1601  /* Don't give an error message for undefined dynamic objects */
1602  /* that do not yet have a definition */
1603  success=FALSE;
1604  }
1605  else if (thegoal->type==lf_true || thegoal->type==lf_false) {
1606  /* What if the 'lf_true' or 'lf_false' have arguments? */
1607  success=(thegoal->type==lf_true);
1608  return success; /* We're done! */
1609  }
1610  else {
1611  /* Error: undefined predicate. */
1612  /* Call the call_handler (which may do an auto-load). */
1613  ptr_psi_term call_handler;
1614  /* mark_quote(thegoal); */
1615 
1616  /* RM: Jan 27 1993 */
1617  /* warningline("call handler invoked for %P\n",thegoal); */
1618 
1619  call_handler=stack_psi_term(0);
1620  call_handler->type=call_handlersym;
1621  stack_add_psi_attr(call_handler,"1",thegoal);
1623  return success; /* We're done! */
1624  }
1625  }
1626 
1627  if (success) {
1628 
1629  if ((unsigned long)rule<=MAX_BUILT_INS) {
1630 
1631  /* For residuation (RESPRED) */
1632  curried=FALSE;
1633  can_curry=TRUE;
1634  resid_vars=NULL;
1635  /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
1636 
1637  if (thegoal->type!=tracesym) /* 26.1 */
1638  traceline("prove built-in %P\n", thegoal);
1639 
1640  /* RESPRED */ resid_aim=aim;
1641  /* Residuated predicate must return success=TRUE */
1642  success=c_rule[(unsigned long)rule]();
1643 
1644  /* RESPRED */ if (curried)
1645  /* RESPRED */ do_currying();
1646  /* RESPRED */ else if (resid_vars)
1647  /* RESPRED */ success=do_residuation_user(); /* 21.9 */ /* PVR 9.2.94 */
1648  }
1649  else {
1650 
1651  /* Evaluate arguments of a predicate call before the call. */
1652  deref_args(thegoal,set_empty);
1653 
1654  traceline("prove %P\n", thegoal);
1655 
1656  /* For residuation (RESPRED) */
1657  curried=FALSE;
1658  can_curry=TRUE;
1659  resid_vars=NULL;
1660  /* resid_limit=(ptr_goal )stack_pointer; 12.6 */
1661 
1662  while (rule && (rule->aaaa_2==NULL || rule->bbbb_2==NULL)) {
1663  rule=rule->next;
1664  traceline("alternative clause has been retracted\n");
1665  }
1666  if (rule) {
1667 
1668  clear_copy();
1669  if (TRUE) /* 8.9 */
1670  /* if (thegoal->type->evaluate_args) 8.9 */
1671  head=eval_copy(rule->aaaa_2,STACK);
1672  else
1673  head=quote_copy(rule->aaaa_2,STACK);
1674 
1675  body=eval_copy(rule->bbbb_2,STACK);
1676 
1677  /* What does this do?? */
1678  /* if (body->type==built_in) */
1679  /* body->coref=head; */
1680 
1681  if (rule->next)
1682  push_choice_point(prove,thegoal,(ptr_psi_term)rule->next,NULL);
1683 
1684  if (body->type!=succeed)
1686 
1687  /* push_ptr_value(psi_term_ptr,&(head->coref)); 9.6 */
1688  push_psi_ptr_value(head,(GENERIC *)&(head->coref));
1689  head->coref=thegoal;
1690  merge(&(thegoal->attr_list),head->attr_list);
1691  if (!head->status) {
1692  (void)i_eval_args(head->attr_list);
1693  }
1694  }
1695  else {
1696  success=FALSE;
1697  }
1698  }
1699  }
1700  }
1701  }
1702  else { /* ';' built-in */
1703  /* RM: Apr 6 1993 */
1704  goal_stack=aim->next;
1705  goal_count++;
1706  get_two_args(thegoal->attr_list,&arg1,&arg2);
1709  }
1710  else { /* 'Cut' built-in*/
1711  goal_stack=aim->next;
1712  goal_count++;
1713  /* assert((ptr_choice_point)(thegoal->value)<=choice_stack); 12.7 */
1714  cut_to(thegoal->value_3); /* 12.7 */
1715 #ifdef CLEAN_TRAIL
1717 #endif
1718  traceline("cut all choice points back to %x\n",choice_stack);
1719  }
1720  }
1721  else { /* 'And' built-in */
1722  goal_stack=aim->next;
1723  goal_count++;
1724  get_two_args(thegoal->attr_list,&arg1,&arg2);
1727  }
1728  }
1729  else
1730  success=FALSE;
1731 
1732  /* RESPRED */ resid_aim=NULL;
1733  return success;
1734 }
#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()
Definition: copy.c:52
struct wl_definition * def_type
Definition: def_struct.h:32
long do_residuation_user()
Definition: lefun.c:306
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)
Definition: login.c:555
#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)
Definition: login.c:1061
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)
Definition: token.c:192
ptr_node left
Definition: def_struct.h:183
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
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)
Definition: copy.c:200
long goal_count
Definition: def_glob.h:152
void push_psi_ptr_value(ptr_psi_term q, GENERIC *p)
Definition: login.c:443
#define deref_ptr(P)
Definition: def_macro.h:95
void do_currying()
Definition: lefun.c:359
char * key
Definition: def_struct.h:182
#define TRUE
Definition: def_const.h:127
static void clean_trail(ptr_choice_point cutpt)
Definition: login.c:757
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)
Definition: lefun.c:15
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)
Definition: login.c:37
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)
Definition: lefun.c:817
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)
Definition: copy.c:205
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
long i_check_out(ptr_psi_term t)
Definition: lefun.c:985
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)
Definition: login.c:591
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 ( )

Definition at line 661 of file token.c.

References FALSE, input_file_name, parse_ok, perr_i(), perr_s(), and psi_term_line_number.

662 {
663  perr_i("near line %ld",psi_term_line_number);
664  if (strcmp(input_file_name,"stdin")) {
665  perr_s(" in file \042%s\042",input_file_name);
666  }
667  /* prompt="error>"; 20.8 */
668  parse_ok=FALSE;
669 }
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 
)

Definition at line 133 of file built_ins.c.

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

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

Definition at line 91 of file parser.c.

References int_stack, parser_stack_index, PARSER_STACK_SIZE, perr(), psi_term_error(), and psi_term_stack.

95 {
97  perr("*** Parser error ");
99  perr(": stack full.\n");
100  }
101  else {
105  op_stack[parser_stack_index]=op;
106  }
107 }
void psi_term_error()
Definition: token.c:661
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 
)

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

535 {
536  ptr_stack n;
537 
538  if (p<(GENERIC *)choice_stack || p>(GENERIC *)stack_pointer) {
539  n=STACK_ALLOC(stack);
540  n->type=t;
541  n->aaaa_3= (GENERIC *)p;
542  n->bbbb_3= (GENERIC *)v;
543  n->next=undo_stack;
544  undo_stack=n;
545  }
546 }
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  a,
ptr_psi_term  b,
GENERIC  c 
)

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

596 {
597  ptr_goal alternative;
598  ptr_choice_point choice;
599  GENERIC top_loc;
600 
601  alternative=STACK_ALLOC(goal);
602 
603  alternative->type=t;
604  alternative->aaaa_1=aaaa_6;
605  alternative->bbbb_1=bbbb_6;
606  alternative->cccc_1=cccc_6;
607  alternative->next=goal_stack;
608  alternative->pending=FALSE;
609 
610  top_loc=stack_pointer;
611 
612  choice=STACK_ALLOC(choice_point);
613 
614  choice->undo_point=undo_stack;
615  choice->goal_stack=alternative;
616  choice->next=choice_stack;
617  choice->stack_top=top_loc;
618 
619 #ifdef TS
620  choice->time_stamp=global_time_stamp; /* 9.6 */
621  global_time_stamp++; /* 9.6 */
622 #endif
623 
624  choice_stack=choice;
625 }
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:19
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 
)

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

392 {
393  ptr_stack m,n;
394 
395  assert(VALID_ADDRESS(q));
396  assert(VALID_ADDRESS(p));
397 #ifdef TS
398  if (trail_condition(q) &&
399  /* (q->time_stamp != global_time_stamp) && */
400  (p < (GENERIC *)choice_stack || p > (GENERIC *)stack_pointer))
401  {
402 #define TRAIL_TS
403 #ifdef TRAIL_TS
404 
405  assert((GENERIC)q<heap_pointer); /* RM: Feb 15 1993 */
406 
407  m=STACK_ALLOC(stack); /* Trail time_stamp */
408  m->type=int_ptr;
409  m->aaaa_3= (GENERIC *) &(q->time_stamp);
410  m->bbbb_3= (GENERIC *) (q->time_stamp);
411  m->next=undo_stack;
412  n=STACK_ALLOC(stack); /* Trail definition field (top of undo_stack) */
413  n->type=def_ptr;
414  n->aaaa_3= p;
415  n->bbbb_3= (GENERIC *)*p;
416  n->next=m;
417  undo_stack=n;
418 #else
419  n=STACK_ALLOC(stack); /* Trail definition field (top of undo_stack) */
420  n->type=def_ptr;
421  n->aaaa_3= p;
422  n->bbbb_3= (GENERIC *) *p;
423  n->next=undo_stack;
424  undo_stack=n;
425 #endif
426  q->time_stamp=global_time_stamp;
427  }
428 #else
430 #endif
431 }
#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)
Definition: login.c:2490
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:19
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)
Definition: login.c:360
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define assert(N)
Definition: memory.c:104
#define int_ptr
Definition: def_const.h:172
void push_goal ( goals  t,
ptr_psi_term  a,
ptr_psi_term  b,
GENERIC  c 
)

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

560 {
561  ptr_goal thegoal;
562 
563  thegoal=STACK_ALLOC(goal);
564 
565  thegoal->type=t;
566  thegoal->aaaa_1=aaaa_5;
567  thegoal->bbbb_1=bbbb_5;
568  thegoal->cccc_1=cccc_5;
569  thegoal->next=goal_stack;
570  thegoal->pending=FALSE;
571 
572  goal_stack=thegoal;
573 }
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 
)

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

446 {
447  ptr_stack m,n;
448 
449  assert(VALID_ADDRESS(q));
450  assert(VALID_ADDRESS(p));
451 #ifdef TS
452  if (trail_condition(q) &&
453  /* (q->time_stamp != global_time_stamp) && */
454  (p < (GENERIC *)choice_stack || p > (GENERIC *)stack_pointer))
455  {
456 #define TRAIL_TS
457 #ifdef TRAIL_TS
458  m=STACK_ALLOC(stack); /* Trail time_stamp */
459  m->type=int_ptr;
460  m->aaaa_3= (GENERIC *) &(q->time_stamp);
461  m->bbbb_3= (GENERIC *) (q->time_stamp);
462  m->next=undo_stack;
463  n=STACK_ALLOC(stack); /* Trail coref field (top of undo_stack) */
464  n->type=psi_term_ptr;
465  n->aaaa_3= (GENERIC *) p;
466  n->bbbb_3= (GENERIC *) *p;
467  n->next=m;
468  undo_stack=n;
469 #else
470  n=STACK_ALLOC(stack); /* Trail coref field (top of undo_stack) */
471  n->type=psi_term_ptr;
472  n->aaaa_3= (ptr_psi_term)p;
473  n->bbbb_3= *p;
474  n->next=undo_stack;
475  undo_stack=n;
476 #endif
477  q->time_stamp=global_time_stamp;
478  }
479 #else
481 #endif
482 }
#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)
Definition: login.c:2490
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:19
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)
Definition: login.c:360
ptr_choice_point choice_stack
Definition: def_glob.h:51
#define assert(N)
Definition: memory.c:104
#define psi_term_ptr
Definition: def_const.h:170
#define int_ptr
Definition: def_const.h:172
void push_ptr_value ( type_ptr  t,
GENERIC p 
)

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

363 {
364  ptr_stack n;
365 
366  assert(p<(GENERIC *)heap_pointer); /* RM: Feb 15 1993 */
367 
368  assert(VALID_ADDRESS(p));
369  if (p < (GENERIC *)choice_stack || p > (GENERIC *)stack_pointer)
370  {
371  n=STACK_ALLOC(stack);
372  n->type=t;
373  n->aaaa_3= (GENERIC *) p;
374  n->bbbb_3= (GENERIC *) *p;
375  n->next=undo_stack;
376  undo_stack=n;
377  }
378 }
#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:104
void push_ptr_value_global ( type_ptr  t,
GENERIC p 
)

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

491 {
492  ptr_stack n;
493 
494  assert(VALID_ADDRESS(p)); /* 17.8 */
495  n=STACK_ALLOC(stack);
496  n->type=t;
497  n->aaaa_3= (GENERIC *) p;
498  n->bbbb_3= (GENERIC *) *p;
499  n->next=undo_stack;
500  undo_stack=n;
501 }
#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:104
void push_window ( long  type,
long  disp,
long  wind 
)

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

512 {
513  ptr_stack n;
514 
515  assert(type & undo_action);
516  n=STACK_ALLOC(stack);
517  n->type=type;
518  n->aaaa_3=(GENERIC *)disp;
519  n->bbbb_3=(GENERIC *)wind;
520  n->next=undo_stack;
521  undo_stack=n;
522 }
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:104
void put_back_char ( long  c)

Definition at line 633 of file token.c.

References Errorline(), old_saved_char, and saved_char.

635 {
636  if (old_saved_char)
637  Errorline("in tokenizer, put_back_char three times (last=%d).\n",c);
639  saved_char=c;
640 }
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)

Definition at line 647 of file token.c.

References Errorline(), NULL, old_saved_psi_term, saved_psi_term, and stack_copy_psi_term().

649 {
651  Errorline("in parser, put_back_token three times (last=%P).\n",t);
654 }
#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)
Definition: parser.c:183
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 
)

Definition at line 200 of file copy.c.

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

203 { to_heap=FALSE; return (copy(t, QUOTE_FLAG, heap_flag)); }
ptr_psi_term copy(ptr_psi_term t, long copy_flag, long heap_flag)
Definition: copy.c:219
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)

Definition at line 436 of file bi_sys.c.

References mark_quote(), and stack_copy_psi_term().

438 {
439  ptr_psi_term q;
440 
442  mark_quote(q);
443  return q;
444 }
void mark_quote(ptr_psi_term t)
Definition: copy.c:601
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void raw_setup_builtins ( )

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

329 {
330 #ifndef NORAW
337  new_built_in(bi_module,"reset_window_flag", predicate, c_reset_window_flag);
338 #endif
339 }
void new_built_in(ptr_module m, char *s, def_type t, long(*r)())
Definition: built_ins.c:5054
#define predicate
Definition: def_const.h:361
#define function_it
Definition: def_const.h:362
long c_get_raw()
Definition: raw.c:103
long c_begin_raw()
Definition: raw.c:32
long c_put_raw()
Definition: raw.c:205
long c_window_flag()
Definition: raw.c:284
long c_end_raw()
Definition: raw.c:232
long c_in_raw()
Definition: raw.c:263
long c_reset_window_flag()
Definition: raw.c:309
ptr_module bi_module
Definition: def_glob.h:155
long read_char ( )

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

588 {
589  int c=0;
590 
591  if ((c=saved_char)) {
593  old_saved_char=0;
594  }
595  else if (stringparse) {
596  if ((c=(*stringinput)))
597  stringinput++;
598  else
599  c=EOF;
600  }
601  else if (input_stream == NULL || feof(input_stream))
602  c=EOF;
603  else {
604  if (start_of_line) {
606  line_count++;
607  if (input_stream==stdin) infoline("%s",prompt); /* 21.1 */
608  }
609 
610  c=fgetc(input_stream);
611 
612  if(trace_input) /* RM: Jan 13 1993 */
613  if(c!=EOF)
614  printf("%c",c);
615  else
616  printf(" <EOF>\n");
617 
618  if (c==EOLN)
620  }
621 
622  /* printf("%c\n",c); RM: Jan 5 1993 Just to trace the parser */
623 
624  return c;
625 }
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:8
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)

Definition at line 676 of file token.c.

References comment, EOLN, and read_char().

678 {
679  long c;
680 
681  do {
682  c=read_char();
683  } while (c!=EOF && c!=EOLN);
684 
685  tok->type=comment;
686 }
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()
Definition: token.c:587
psi_term read_life_form ( char  ch1,
char  ch2 
)

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

702 {
703  psi_term t,t2;
704  long limit,pr_op,pr_1,pr_2,start=0;
705  long fin=FALSE;
706  long state=0;
707  long prec=0;
708 
709  long op;
710 
711  limit=parser_stack_index+1;
712 
713  if (parse_ok)
714  do {
715  if (state)
716  read_token(&t);
717  else
718  t=read_psi_term();
719 
720  if (!start)
721  start=line_count;
722 
723  if (!fin)
724  if (state) {
725  if (equ_tokc(t,ch1) || equ_tokc(t,ch2)) {
726  fin=TRUE;
727  put_back_token(t);
728  }
729  else {
730  pr_op=precedence(t,xf);
731  pr_1=pr_op-1;
732 
733  if(pr_op==NOP) {
734  pr_op=precedence(t,yf);
735  pr_1=pr_op;
736  }
737 
738  if(pr_op==NOP) {
739 
740  pr_op=precedence(t,xfx);
741  pr_1=pr_op-1;
742  pr_2=pr_op-1;
743 
744  if(pr_op==NOP) {
745  pr_op=precedence(t,xfy);
746  pr_1=pr_op-1;
747  pr_2=pr_op;
748  }
749 
750  if(pr_op==NOP) {
751  pr_op=precedence(t,yfx);
752  pr_1=pr_op;
753  pr_2=pr_op-1;
754  }
755 
756  /* if(pr_op==NOP) {
757  pr_op=precedence(t,yfy);
758  pr_1=pr_op;
759  pr_2=pr_op-1;
760  }
761  */
762 
763  if(pr_op==NOP) {
764  fin=TRUE;
765  put_back_token(t);
766  }
767  else
768  {
769  crunch(pr_1,limit);
770  push(t,pr_2,xfx);
771  prec=pr_2;
772  state=0;
773  }
774  }
775  else {
776  crunch(pr_1,limit);
777  push(t,pr_1,xf);
778  prec=pr_1;
779  }
780  }
781  }
782  else {
783 
784  if(t.attr_list)
785  pr_op=NOP;
786  else {
787  pr_op=precedence(t,fx);
788  pr_2=pr_op-1;
789 
790  if(pr_op==NOP) {
791  pr_op=precedence(t,fy);
792  pr_2=pr_op;
793  }
794  }
795 
796  if(pr_op==NOP) {
797  if(equ_tokch(t,'(')) {
798  t2=read_life_form(')',0);
799  if(parse_ok) {
800  push(t2,prec,nop);
801  read_token(&t2);
802  if(!equ_tokch(t2,')')) {
804  else {
805  /*
806  perr("*** Syntax error ");psi_term_error();
807  perr(": ')' missing.\n");
808  */
809 
810  /* RM: Feb 1 1993 */
811  Syntaxerrorline("')' missing (%E)\n");
812 
813  put_back_token(t2);
814  }
815  }
816  state=1;
817  }
818  }
819  else
820  if(bad_psi_term(&t)) {
821  put_back_token(t);
822  /* psi_term_error(); */
823  fin=TRUE;
824  }
825  else {
826  push(t,prec,nop);
827  state=1;
828  }
829  }
830  else {
831  push(t,pr_2,fx);
832  prec=pr_2;
833  }
834 
835  }
836 
837  } while (!fin && parse_ok);
838 
839  if (state)
840  crunch(MAX_PRECEDENCE,limit);
841 
842  if (parse_ok && parser_stack_index!=limit) {
844  else {
845  /*
846  perr("*** Syntax error ");psi_term_error();
847  perr(": bad expression.\n");
848  */
849 
850  /* RM: Feb 1 1993 */
851  Syntaxerrorline("bad expression (%E)\n");
852  }
853  }
854  else
855  (void)pop(&t,&op);
856 
857  if (!parse_ok)
858  t= *error_psi_term;
859 
860  parser_stack_index=limit-1;
861 
862  return t;
863 }
#define yfx
Definition: def_const.h:268
#define equ_tokc(A, B)
Definition: def_macro.h:71
void read_token(ptr_psi_term tok)
Definition: token.c:1063
#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)
Definition: parser.c:91
long precedence(psi_term tok, long typ)
Definition: parser.c:159
#define xfy
Definition: def_const.h:267
#define nop
Definition: def_const.h:260
void put_back_token(psi_term t)
Definition: token.c:647
long line_count
Definition: def_glob.h:39
psi_term read_life_form(char ch1, char ch2)
Definition: parser.c:700
void Syntaxerrorline(char *format,...)
Definition: error.c:498
#define TRUE
Definition: def_const.h:127
long pop(ptr_psi_term tok, long *op)
Definition: parser.c:115
void crunch(long prec, long limit)
Definition: parser.c:636
ptr_psi_term error_psi_term
Definition: def_glob.h:23
int bad_psi_term(ptr_psi_term t)
Definition: parser.c:20
#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()
Definition: parser.c:400
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 
)

Definition at line 986 of file token.c.

References DIGIT, heap_alloc(), integer, put_back_char(), read_char(), REAL, and real.

989 {
990  long c2;
991  REAL f,p;
992  long /* sgn, */ pwr,posflag;
993 
994  /* if (sgn=(c=='-')) c=read_char(); */
995 
996  /* tok->type=integer; RM: Mar 8 1993 */
997 
998  f=0.0;
999  do { f=f*10.0+(c-'0'); c=read_char(); } while (DIGIT(c));
1000 
1001  if (c=='.') {
1002  c2=read_char();
1003  if DIGIT(c2) {
1004  /* tok->type=real; RM: Mar 8 1993 */
1005  p=10.0;
1006  while (DIGIT(c2)) { f=f+(c2-'0')/p; p=p*10.0; c2=read_char(); }
1007  put_back_char(c2);
1008  }
1009  else {
1010  put_back_char(c2);
1011  put_back_char(c);
1012  }
1013  }
1014  else
1015  put_back_char(c);
1016 
1017  c=read_char();
1018  if (c=='e' || c=='E') {
1019  c2=read_char();
1020  if (c2=='+' || c2=='-' || DIGIT(c2)) {
1021  tok->type=real;
1022  posflag = (c2=='+' || DIGIT(c2));
1023  if (!DIGIT(c2)) c2=read_char();
1024  pwr=0;
1025  while (DIGIT(c2)) { pwr=pwr*10+(c2-'0'); c2=read_char(); }
1026  put_back_char(c2);
1027  p=1.0;
1028  while (pwr>=100) { pwr-=100; if (posflag) p*=1e100; else p/=1e100; }
1029  while (pwr>=10 ) { pwr-=10; if (posflag) p*=1e10; else p/=1e10; }
1030  while (pwr>0 ) { pwr-=1; if (posflag) p*=1e1; else p/=1e1; }
1031  f*=p;
1032  }
1033  else {
1034  put_back_char(c2);
1035  put_back_char(c);
1036  }
1037  }
1038  else
1039  put_back_char(c);
1040 
1041  /* if (sgn) f = -f; */
1042  tok->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
1043  *(REAL *)tok->value_3=f;
1044 
1045  /* RM: Mar 8 1993 */
1046  if(f==floor(f))
1047  tok->type=integer;
1048  else
1049  tok->type=real;
1050 }
#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()
Definition: token.c:587
GENERIC heap_alloc(long s)
Definition: memory.c:1518
void put_back_char(long c)
Definition: token.c:633
psi_term read_psi_term ( )

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

401 {
402  psi_term t,t2,t3;
403  char s[10];
404  long count=0,f=TRUE,f2,v;
405  ptr_psi_term module;
406 
407 
408  if(parse_ok) {
409 
410  read_token(&t);
411 
412  if(equ_tokch(t,'['))
413  t=parse_list(alist,']',','); /*** RICHARD Nov_4 ***/
414  else
415  if(equ_tokch(t,'{'))
416  t=parse_list(disjunction,'}',';'); /*** RICHARD Nov_4 ***/
417 
418  /* The syntax <a,b,c> for conjunctions has been abandoned.
419  else
420  if(equ_tokch(t,'<'))
421  t=parse_list(conjunction,'>',',');
422  */
423 
424  if(parse_ok
425  && t.type!=eof
426  && !bad_psi_term(&t)
427  /* && (precedence(t,fx)==NOP)
428  && (precedence(t,fy)==NOP) */
429  ) {
430  read_token(&t2);
431  if(equ_tokch(t2,'(')) {
432 
433  do {
434 
435  f2=TRUE;
436  read_token(&t2);
437 
438  if(wl_const_3(t2) && !bad_psi_term(&t2)) {
439  read_token(&t3);
440  if(equ_tok(t3,"=>")) {
441  t3=read_life_form(',',')');
442 
443  if(t2.type->keyword->private_feature) /* RM: Mar 11 1993 */
445  /* RM: Jan 13 1993 */
446  &(t.attr_list),
447  &t3);
448  else
450  /* RM: Jan 13 1993 */
451  &(t.attr_list),
452  &t3);
453 
454  f2=FALSE;
455  }
456  else
457  put_back_token(t3);
458  }
459 
460  if(parse_ok && equal_types(t2.type,integer)) {
461  read_token(&t3);
462  if(equ_tok(t3,"=>")) {
463  t3=read_life_form(',',')');
464  v= *(REAL *)t2.value_3;
465  (void)snprintf(s,10,"%ld",v);
466  feature_insert(s,&(t.attr_list),&t3);
467  f2=FALSE;
468  }
469  else
470  put_back_token(t3);
471  }
472 
473  if(f2) {
474  put_back_token(t2);
475  t2=read_life_form(',',')');
476  ++count;
477  (void)snprintf(s,10,"%ld",count);
478  feature_insert(s,&(t.attr_list),&t2);
479  }
480 
481  read_token(&t2);
482 
483  if(equ_tokch(t2,')'))
484  f=FALSE;
485  else
486  if(!equ_tokch(t2,',')) {
488  else {
489  /*
490  perr("*** Syntax error ");psi_term_error();
491  perr(": ',' expected in argument list.\n");
492  */
493 
494  /* RM: Feb 1 1993 */
495  Syntaxerrorline("',' expected in argument list (%E)\n");
496 
497  f=FALSE;
498  }
499  }
500 
501  } while(f && parse_ok);
502  }
503  else
504  put_back_token(t2);
505  }
506  }
507  else
508  t= *error_psi_term;
509 
510  if(t.type==variable && t.attr_list) {
511  t2=t;
512  t.type=apply;
513  t.value_3=NULL;
514  t.coref=NULL;
515  t.resid=NULL;
516  (void)stack_insert(FEATCMP,(char *)functor->keyword->symbol,
517  &(t.attr_list),
519  }
520 
521 
522  /* RM: Mar 12 1993 Nasty hack for Bruno's features in modules */
523  if((t.type==add_module1 || t.type==add_module2 || t.type==add_module3) &&
524  !find(FEATCMP,two,t.attr_list)) {
525 
526  module=stack_psi_term(4);
527  module->type=quoted_string;
529 
530  (void)stack_insert(FEATCMP,two,&(t.attr_list),(GENERIC)module);
531  }
532 
533  return t;
534 }
ptr_residuation resid
Definition: def_struct.h:173
#define FEATCMP
Definition: def_const.h:257
void read_token(ptr_psi_term tok)
Definition: token.c:1063
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)
Definition: parser.c:304
char * symbol
Definition: def_struct.h:91
ptr_definition apply
Definition: def_glob.h:72
void put_back_token(psi_term t)
Definition: token.c:647
#define REAL
Definition: def_const.h:72
ptr_definition add_module3
Definition: def_glob.h:69
char * heap_copy_string(char *s)
Definition: trees.c:147
psi_term read_life_form(char ch1, char ch2)
Definition: parser.c:700
void feature_insert(char *keystr, ptr_node *tree, ptr_psi_term psi)
Definition: parser.c:225
#define wl_const_3(S)
Definition: def_macro.h:104
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
ptr_definition alist
Definition: def_glob.h:94
ptr_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)
Definition: parser.c:20
#define FALSE
Definition: def_const.h:128
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
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)
Definition: trees.c:341
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 
)

Definition at line 743 of file token.c.

References base2int(), FALSE, heap_copy_string(), isoctal, NULL, put_back_char(), read_char(), read_string_error(), STRLEN, TOKEN_ERROR(), TRUE, update_symbol(), and warningline().

746 {
747  long c;
748  string str;
749  long len=0;
750  long store=TRUE;
751  long flag=TRUE;
752 
753  str[len]=0;
754 
755  do {
756  c=read_char();
757  if (c==EOF) {
758  store=FALSE;
759  flag=FALSE;
761  }
762  else if (e=='"' && c=='\\') {
763  c=read_char();
764  if (c==EOF) {
765  store=FALSE;
766  flag=FALSE;
767  put_back_char('\\');
769  }
770  else {
771  switch (c) {
772  case 'a': c='\a'; break;
773  case 'b': c='\b'; break;
774  case 'f': c='\f'; break;
775  case 'n': c='\n'; break;
776  case 'r': c='\r'; break;
777  case 't': c='\t'; break;
778  case 'v': c='\v'; break;
779  /* missing \ooo and \xhh */
780  case 'x':
781  {
782  int n;
783  c=read_char();
784  if (c==EOF) {
785  store=flag=FALSE;
787  break;
788  }
789  else if (!isxdigit(c)) {
790  store=flag=FALSE;
792  break;
793  }
794  else {
795  n = base2int(c);
796  }
797  c=read_char();
798  if (isxdigit(c)) n = 16*n+base2int(c);
799  else put_back_char(c);
800  c=n;
801  break;
802  }
803  default:
804  if (isoctal(c)) {
805  int n,i;
806  for(i=n=0;i<3&&isoctal(c);i++,c=read_char())
807  n = n*8 + base2int(c);
808  if (c!=EOF) put_back_char(c);
809  c=n;
810  break;
811  }
812  else break;
813  }
814  }
815  }
816  else
817  if (c==e) {
818  c=read_char();
819  if (c!=e) {
820  store=FALSE;
821  flag=FALSE;
822  put_back_char(c);
823  }
824  }
825  if (store)
826  if (len==STRLEN) {
827  warningline("string too long, extra ignored (%E).\n");
828  store=FALSE;
829  }
830  else {
831  str[len++]=c;
832  str[len]=0;
833  }
834  } while(flag);
835 
836  if (e=='"')
837  tok->value_3=(GENERIC)heap_copy_string(str);
838  else {
839  tok->type=update_symbol(NULL,str); /* Maybe no_module would be better */
840  tok->value_3=NULL;
841  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
842  }
843 }
int base2int(int n)
Definition: token.c:705
#define NULL
Definition: def_const.h:203
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
void read_string_error(int n)
Definition: token.c:689
char * heap_copy_string(char *s)
Definition: trees.c:147
#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:737
#define STRLEN
Definition: def_const.h:86
void TOKEN_ERROR(ptr_psi_term p)
Definition: token.c:30
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()
Definition: token.c:587
void put_back_char(long c)
Definition: token.c:633
void read_string_error ( int  n)

Definition at line 689 of file token.c.

References FALSE, parse_ok, stringparse, and Syntaxerrorline().

691 {
693  else
694  switch (n) {
695  case 0:
696  Syntaxerrorline("end of file reached before end of string (%E).\n");
697  break;
698  case 1:
699  Syntaxerrorline("Hexadecimal digit expected (%E).\n");
700  break;
701  }
702 }
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)

Definition at line 1063 of file token.c.

References read_token_main(), and TRUE.

1065 { read_token_main(tok, TRUE); }
void read_token_main(ptr_psi_term, long)
Definition: token.c:1073
#define TRUE
Definition: def_const.h:127
void read_token_b ( ptr_psi_term  tok)

Definition at line 1069 of file token.c.

References FALSE, and read_token_main().

1071 { read_token_main(tok, FALSE); }
void read_token_main(ptr_psi_term, long)
Definition: token.c:1073
#define FALSE
Definition: def_const.h:128
void read_token_main ( ptr_psi_term  tok,
long  for_parser 
)

Definition at line 1073 of file token.c.

References 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(), 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(), saved_psi_term, SINGLE, stack_psi_term(), STRCMP, SYMBOL, symbolic(), TOKEN_ERROR(), TRUE, update_symbol(), UPPER, var_occurred, var_tree, and variable.

1076 {
1077  long c, c2;
1078  ptr_node n;
1079  char p[2];
1080 
1081  if (for_parser && (saved_psi_term!=NULL)) {
1082  *tok= *saved_psi_term;
1085  }
1086  else {
1087  tok->type=nothing;
1088 
1089  do {
1090  c=read_char();
1091  } while(c!=EOF && (c<=32));
1092 
1093  if (for_parser) psi_term_line_number=line_count;
1094 
1095  switch(c) {
1096  case EOF:
1097  tok->type=eof;
1098  tok->value_3=NULL;
1099  break;
1100  case '%':
1101  read_comment(tok);
1102  break;
1103  case '"':
1104  read_string(tok,c);
1105  tok->type=quoted_string;
1106  break;
1107  case 39: /* The quote symbol "'" */
1108  read_string(tok,c);
1109  break;
1110 
1111  default:
1112 
1113  /* Adding this results in problems with terms like (N-1) */
1114  /* if (c=='-' && (c2=read_char()) && DIGIT(c2)) {
1115  put_back_char(c2);
1116  read_number(tok,c);
1117  }
1118  else */
1119 
1120  if(c=='.' || c=='?') { /* RM: Jul 7 1993 */
1121  c2=read_char();
1122  put_back_char(c2);
1123  /*printf("c2=%d\n",c2);*/
1124  if(c2<=' ' || c2==EOF) {
1125  if(c=='.')
1126  tok->type=final_dot;
1127  else
1128  tok->type=final_question;
1129 
1130  tok->value_3=NULL;
1131  }
1132  else
1133  read_name(tok,c,symbolic,constant);
1134  }
1135  else
1136  if DIGIT(c)
1137  read_number(tok,c);
1138  else
1139  if UPPER(c) {
1141  }
1142  else
1143  if LOWER(c) {
1145  }
1146  else
1147  if SYMBOL(c) {
1148  read_name(tok,c,symbolic,constant);
1149  }
1150  else /* RM: Jul 7 1993 Moved this */
1151  if SINGLE(c) {
1152  p[0]=c; p[1]=0;
1154  tok->value_3=NULL;
1155  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
1156  }
1157  else {
1158  Errorline("illegal character %d in input (%E).\n",c);
1159  }
1160  }
1161 
1162  if (tok->type==variable) {
1163  if (tok->value_3) {
1164  /* If the variable read in has name "_", then it becomes 'top' */
1165  /* and is no longer a variable whose name must be remembered. */
1166  /* As a result, '@' and '_' are synonyms in the program input. */
1167  if (!strcmp((char *)tok->value_3,"_")) {
1168  p[0]='@'; p[1]=0;
1170  tok->value_3=NULL;
1171  TOKEN_ERROR(tok); /* RM: Feb 1 1993 */
1172  }
1173  else {
1174  /* Insert into variable tree, create 'top' value if need be. */
1176  n=find(STRCMP,(char *)tok->value_3,var_tree);
1177  if (n==NULL) {
1179  /* The change is always trailed. */
1180  (void)bk2_stack_insert(STRCMP,(char *)tok->value_3,&var_tree,(GENERIC)t); /* 17.8 */
1181  tok->coref=t;
1182  }
1183  else
1184  tok->coref=(ptr_psi_term)n->data;
1185  }
1186  }
1187  /* else do nothing */
1188  }
1189  }
1190 
1191  if (tok->type==comment)
1192  read_token(tok);
1193 
1194  if (tok->type!=variable)
1195  tok->coref=NULL;
1196 
1197  tok->attr_list=NULL;
1198  tok->status=0;
1199  tok->flags=FALSE; /* 14.9 */
1200  tok->resid=NULL;
1201 
1202  if (tok->type==cut) /* 12.7 */
1204 
1205  do {
1206  c=read_char();
1207  if (c==EOLN) {
1208  if (for_parser) put_back_char(c);
1209  c=0;
1210  }
1211  else if (c<0 || c>32) {
1212  put_back_char(c);
1213  c=0;
1214  }
1215  } while(c && c!=EOF);
1216 
1217  if (for_parser) prompt="| ";
1218 }
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)
Definition: trees.c:327
void read_name(ptr_psi_term tok, long ch, long(*f)(long), ptr_definition typ)
Definition: token.c:878
void read_string(ptr_psi_term tok, long e)
Definition: token.c:743
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
#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)
Definition: token.c:986
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)
Definition: lefun.c:15
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)
Definition: trees.c:341
long legal_in_name(long c)
Definition: token.c:861
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)
Definition: token.c:676
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
char * prompt
Definition: def_glob.h:42
long symbolic(long c)
Definition: token.c:850
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)
Definition: token.c:30
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
long read_char()
Definition: token.c:587
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)
Definition: token.c:1063
void put_back_char(long c)
Definition: token.c:633
ptr_psi_term real_stack_psi_term ( long  stat,
REAL  thereal 
)

Definition at line 38 of file lefun.c.

References wl_psi_term::attr_list, wl_psi_term::coref, FALSE, wl_psi_term::flags, global_time_stamp, heap_alloc(), integer, NULL, QUOTED_TRUE, REAL, real, wl_psi_term::resid, STACK_ALLOC, wl_psi_term::status, wl_psi_term::type, and wl_psi_term::value_3.

41 {
42  ptr_psi_term result;
43 
44  result=STACK_ALLOC(psi_term);
45  result->type = (thereal==floor(thereal)) ? integer : real;
46  result->status=stat;
47  result->flags=stat?QUOTED_TRUE:FALSE; /* 14.9 */
48  result->attr_list=NULL;
49  result->coref=NULL;
50 #ifdef TS
51  result->time_stamp=global_time_stamp; /* 9.6 */
52 #endif
53  result->resid=NULL;
54  result->value_3=heap_alloc(sizeof(REAL));
55  (* (REAL *)(result->value_3)) = thereal;
56 
57  return result;
58 }
ptr_residuation resid
Definition: def_struct.h:173
#define NULL
Definition: def_const.h:203
#define REAL
Definition: def_const.h:72
ptr_definition real
Definition: def_glob.h:102
ptr_definition integer
Definition: def_glob.h:93
#define FALSE
Definition: def_const.h:128
GENERIC value_3
Definition: def_struct.h:170
ptr_psi_term coref
Definition: def_struct.h:172
#define STACK_ALLOC(A)
Definition: def_macro.h:16
unsigned long global_time_stamp
Definition: login.c:19
ptr_definition type
Definition: def_struct.h:165
#define QUOTED_TRUE
Definition: def_const.h:123
ptr_node attr_list
Definition: def_struct.h:171
GENERIC heap_alloc(long s)
Definition: memory.c:1518
void rec_replace ( ptr_definition  old,
ptr_definition  new,
ptr_psi_term  term 
)

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

851 {
852  ptr_psi_term done;
853  long *info; // some trouble w this - don't see
854  ptr_node old_attr;
855 
856  deref_ptr(term);
857  done=translate(term,&info);
858  if(!done) {
859  insert_translation(term,term,0);
860 
861  if(term->type==old && !term->value_3) {
862  push_ptr_value(def_ptr,(GENERIC *)&(term->type));
863  term->type=new;
864  }
865  old_attr=term->attr_list;
866  if(old_attr) {
868  term->attr_list=NULL;
869  replace_attr(old_attr,term,old,new);
870  }
871  }
872 }
ptr_psi_term translate(ptr_psi_term a, long **infoptr)
Definition: copy.c:101
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
#define def_ptr
Definition: def_const.h:173
void replace_attr(ptr_node, ptr_psi_term, ptr_definition, ptr_definition)
Definition: modules.c:875
void insert_translation(ptr_psi_term a, ptr_psi_term b, long info)
Definition: copy.c:63
#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)

Definition at line 91 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_definition::type_def, type_it, undef, warningflag, warningline(), and yes_or_no().

93 {
94  ptr_definition d; // ,d2;
95  // ptr_int_list l,*l2;
96  long success=TRUE;
97 
98  deref_ptr(t);
99  d=t->type;
100  if (d->date<file_date) {
101  if (d->type_def==(def_type)type_it) {
102  /* Except for top, sorts are always unprotected, with a warning. */
103  if (FALSE /*d==top*/) {
104  Errorline("the top sort '@' may not be extended.\n");
105  success=FALSE;
106  }
107  /* RM: Mar 25 1993
108  else if (d!=top)
109  warningline("extending definition of sort '%s'.\n",d->keyword->symbol);
110  */
111  }
112  else if (d->protected && d->type_def!=(def_type)undef) {
113  if (d->date>0) {
114  /* The term was entered in a previous file, and therefore */
115  /* cannot be altered. */
116  Errorline("the %T '%s' may not be changed.\n", /* RM: Jan 27 1993 */
117  d->type_def, d->keyword->combined_name);
118  success=FALSE;
119  }
120  else {
121  if (d->rule && (unsigned long)d->rule<=MAX_BUILT_INS /*&& input_stream==stdin*/) {
122  /* d is a built-in, and therefore cannot be altered. */
123  Errorline("the built-in %T '%s' may not be extended.\n",
124  d->type_def, d->keyword->symbol);
125  success=FALSE;
126  }
127  else {
128  /* d is not a built-in, and therefore can be altered. */
129  warningline("extending the %T '%s'.\n",d->type_def,d->keyword->symbol);
130  if (warningflag) if (!yes_or_no()) success=FALSE;
131  }
132  }
133  }
134 
135  if (success) {
136  if (d->type_def==(def_type)type_it) { /* d is an already existing type */
137  /* Remove cycles in the type hierarchy of d */
138  /* This is done by Richard's version, and I don't know why. */
139  /* It seems to be a no-op. */
140  remove_cycles(d, &(d->children));
141  remove_cycles(d, &(d->parents));
142  /* d->rule=NULL; */ /* Types must keep their rules! */
143  /* d->properties=NULL; */ /* Types get new properties from encode */
144  }
145  if (d->date==0) d->date=file_date;
146  /* d->type=undef; */ /* Objects keep their type! */
147  /* d->always_check=TRUE; */
148  /* d->protected=TRUE; */
149  /* d->children=NULL; */
150  /* d->parents=NULL; */
151  /* d->code=NOT_CODED; */
152  }
153  }
154 
155  return success;
156 }
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)
Definition: types.c:73
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()
Definition: types.c:44
ptr_int_list parents
Definition: def_struct.h:130
void release_resid ( ptr_psi_term  t)

Definition at line 414 of file lefun.c.

References release_resid_main(), and TRUE.

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

Definition at line 384 of file lefun.c.

References wl_goal::aaaa_1, FALSE, wl_residuation::goal, goal_ptr, goal_stack, int_ptr, wl_residuation::next, wl_goal::next, NULL, wl_goal::pending, push_ptr_value(), resid_ptr, and traceline().

387 {
388  ptr_goal g;
389  ptr_residuation r;
390 
391  if ((r=t->resid)) {
392  if (trailflag) push_ptr_value(resid_ptr,(GENERIC *)&(t->resid));
393  t->resid=NULL;
394 
395  while (r) {
396  g=r->goal;
397  if (g->pending) {
398 
400  g->pending=FALSE;
401 
403 
404  g->next=goal_stack;
405  goal_stack=g;
406 
407  traceline("releasing %P\n",g->aaaa_1);
408  }
409  r=r->next;
410  }
411  }
412 }
ptr_psi_term aaaa_1
Definition: def_struct.h:224
ptr_residuation resid
Definition: def_struct.h:173
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
ptr_goal goal_stack
Definition: def_glob.h:50
ptr_goal goal
Definition: def_struct.h:156
ptr_residuation next
Definition: def_struct.h:157
#define NULL
Definition: def_const.h:203
void traceline(char *format,...)
Definition: error.c:157
#define FALSE
Definition: def_const.h:128
unsigned long * GENERIC
Definition: def_struct.h:17
#define resid_ptr
Definition: def_const.h:171
#define goal_ptr
Definition: def_const.h:175
ptr_definition pending
Definition: def_struct.h:228
ptr_goal next
Definition: def_struct.h:227
#define int_ptr
Definition: def_const.h:172
void release_resid_notrail ( ptr_psi_term  t)

Definition at line 420 of file lefun.c.

References FALSE, and release_resid_main().

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

Definition at line 73 of file types.c.

References wl_int_list::next.

76 {
77  while (*dl) {
78  if (((ptr_definition)(*dl)->value_1)==d)
79  *dl = (*dl)->next;
80  else
81  dl= &((*dl)->next);
82  }
83 }
ptr_int_list next
Definition: def_struct.h:55
void replace ( ptr_definition  old,
ptr_definition  new,
ptr_psi_term  term 
)

Definition at line 834 of file modules.c.

References clear_copy(), and rec_replace().

839 {
840  clear_copy();
841  rec_replace(old,new,term);
842 }
void clear_copy()
Definition: copy.c:52
void rec_replace(ptr_definition, ptr_definition, ptr_psi_term)
Definition: modules.c:846
void replace_attr ( ptr_node  old_attr,
ptr_psi_term  term,
ptr_definition  old,
ptr_definition  new 
)

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

881 {
882  ptr_psi_term value;
883  char *oldlabel; /* RM: Mar 12 1993 */
884  char *newlabel;
885 
886  if(old_attr->left)
887  replace_attr(old_attr->left,term,old,new);
888 
889  value=(ptr_psi_term)old_attr->data;
890  rec_replace(old,new,value);
891 
892  if(old->keyword->private_feature) /* RM: Mar 12 1993 */
893  oldlabel=old->keyword->combined_name;
894  else
895  oldlabel=old->keyword->symbol;
896 
897  if(new->keyword->private_feature) /* RM: Mar 12 1993 */
898  newlabel=new->keyword->combined_name;
899  else
900  newlabel=new->keyword->symbol;
901 
902  if(!strcmp(old_attr->key,oldlabel))
903  (void)stack_insert(FEATCMP,newlabel,&(term->attr_list),(GENERIC)value);
904  else
905  (void)stack_insert(FEATCMP,old_attr->key,&(term->attr_list),(GENERIC)value);
906 
907  if(old_attr->right)
908  replace_attr(old_attr->right,term,old,new);
909 }
#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)
Definition: modules.c:875
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)
Definition: trees.c:291
char * key
Definition: def_struct.h:182
void rec_replace(ptr_definition, ptr_definition, ptr_psi_term)
Definition: modules.c:846
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)
Definition: print.c:1438
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)
Definition: print.c:1438
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)
Definition: built_ins.c:2124
#define TRUE
Definition: def_const.h:127
void reset_stacks ( )

Definition at line 1924 of file login.c.

References choice_stack, goal_stack, NULL, and undo().

1925 {
1926  undo(NULL); /* 8.10 */
1927  goal_stack=NULL;
1929 #ifdef TS
1930  /* global_time_stamp=INIT_TIME_STAMP; */ /* 9.6 */
1931 #endif
1932 }
ptr_goal goal_stack
Definition: def_glob.h:50
void undo(ptr_stack limit)
Definition: login.c:646
#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)

Definition at line 451 of file bi_sys.c.

References copyPsiTerm, stack_psi_term(), and wl_psi_term::status.

453 {
454  ptr_psi_term psi;
455 
456  psi = stack_psi_term(4);
457  copyPsiTerm(psi, p->goal->aaaa_1);
458  psi->status = 4;
459  return psi;
460 }
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:8
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC residListNext ( ptr_residuation  p)

Definition at line 462 of file bi_sys.c.

464 {
465  return (GENERIC )(p->next);
466 }
ptr_residuation next
Definition: def_struct.h:157
unsigned long * GENERIC
Definition: def_struct.h:17
void residuate ( ptr_psi_term  t)

Definition at line 113 of file lefun.c.

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

115 {
116  ptr_resid_list curr;
117 
118  curr=STACK_ALLOC(resid_list);
119  curr->var=t;
120  curr->othervar=NULL; /* 21.9 */
121  curr->next=resid_vars;
122  resid_vars=curr;
123 }
ptr_resid_list next
Definition: def_struct.h:62
#define NULL
Definition: def_const.h:203
ptr_resid_list resid_vars
Definition: def_glob.h:221
ptr_psi_term var
Definition: def_struct.h:60
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_psi_term othervar
Definition: def_struct.h:61
void residuate2 ( ptr_psi_term  u,
ptr_psi_term  v 
)

Definition at line 130 of file lefun.c.

References residuate().

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

Definition at line 142 of file lefun.c.

References residuate().

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

Definition at line 95 of file lefun.c.

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

97 {
98  ptr_resid_list curr;
99 
100  curr=STACK_ALLOC(resid_list);
101  curr->var=t;
102  curr->othervar=u;
103  curr->next=resid_vars;
104  resid_vars=curr;
105 }
ptr_resid_list next
Definition: def_struct.h:62
ptr_resid_list resid_vars
Definition: def_glob.h:221
ptr_psi_term var
Definition: def_struct.h:60
#define STACK_ALLOC(A)
Definition: def_macro.h:16
ptr_psi_term othervar
Definition: def_struct.h:61
long residuateGoalOnVar ( ptr_goal  g,
ptr_psi_term  var,
ptr_psi_term  othervar 
)

Definition at line 172 of file lefun.c.

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

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

Definition at line 365 of file token.c.

References eof_flag, line_count, old_saved_char, old_saved_psi_term, saved_char, saved_psi_term, and start_of_line.

367 {
368  if (pb) {
369  line_count = pb->lc;
370  start_of_line = pb->sol;
371  saved_char = pb->sc;
372  old_saved_char = pb->osc;
373  saved_psi_term = pb->spt;
374  old_saved_psi_term = pb->ospt;
375  eof_flag = pb->ef;
376  }
377 }
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 
)

Definition at line 1270 of file lefun.c.

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

1273 {
1274  if (rb) {
1275  can_curry = (rb->cc_cr&2)?TRUE:FALSE; /* 11.9 */
1276  curried = (rb->cc_cr&1)?TRUE:FALSE; /* 11.9 */
1277  resid_aim = rb->ra;
1278  resid_vars = rb->rv;
1279  /* curried = rb->cr; 11.9 */
1280  /* can_curry = rb->cc; 11.9 */
1281  *match_date = rb->md;
1282  }
1283 }
ptr_goal ra
Definition: def_struct.h:248
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_resid_list resid_vars
Definition: def_glob.h:221
#define TRUE
Definition: def_const.h:127
ptr_psi_term md
Definition: def_struct.h:252
#define FALSE
Definition: def_const.h:128
long can_curry
Definition: def_glob.h:224
long curried
Definition: def_glob.h:223
ptr_resid_list rv
Definition: def_struct.h:251
void restore_state ( ptr_psi_term  t)

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

269 {
270  // long i;
271  char *str;
272 
273 
274  input_stream = (FILE *) ((ptr_psi_term)get_attr(t,STREAM))->value_3;
275  str = (char*) ((ptr_psi_term)get_attr(t,INPUT_FILE_NAME))->value_3;
276  strcpy(input_file_name,str);
277  /* for (i=0;i++;i<=strlen(str)) input_file_name[i]=str[i]; */
278  line_count = *(REAL *) ((ptr_psi_term)get_attr(t,LINE_COUNT))->value_3;
279  saved_char = *(REAL *) ((ptr_psi_term)get_attr(t,SAVED_CHAR))->value_3;
281 
284 
287 
290 
291 
292  /* RM: Jan 27 1993
293  set_current_module(
294  find_module(((ptr_psi_term)get_attr(input_state,
295  CURRENT_MODULE))->value_3));
296  */
297 }
#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)
Definition: token.c:210
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)

Definition at line 350 of file token.c.

References eof_flag, wl_parse_block::lc, line_count, old_saved_char, old_saved_psi_term, saved_char, saved_psi_term, and start_of_line.

352 {
353  if (pb) {
354  pb->lc = line_count;
355  pb->sol = start_of_line;
356  pb->sc = saved_char;
357  pb->osc = old_saved_char;
358  pb->spt = saved_psi_term;
359  pb->ospt = old_saved_psi_term;
360  pb->ef = eof_flag;
361  }
362 }
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 
)

Definition at line 1256 of file lefun.c.

References can_curry, curried, resid_aim, and resid_vars.

1259 {
1260  if (rb) {
1261  rb->cc_cr = (can_curry<<1) + curried; /* 11.9 */
1262  rb->ra = resid_aim;
1263  rb->rv = resid_vars;
1264  /* rb->cr = curried; 11.9 */
1265  /* rb->cc = can_curry; 11.9 */
1266  rb->md = match_date;
1267  }
1268 }
ptr_goal ra
Definition: def_struct.h:248
ptr_goal resid_aim
Definition: def_glob.h:220
ptr_resid_list resid_vars
Definition: def_glob.h:221
ptr_psi_term md
Definition: def_struct.h:252
long can_curry
Definition: def_glob.h:224
long curried
Definition: def_glob.h:223
ptr_resid_list rv
Definition: def_struct.h:251
void save_state ( ptr_psi_term  t)

Definition at line 230 of file token.c.

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

232 {
233  ptr_node n;
234  ptr_psi_term t1;
235 
237  t1=(ptr_psi_term)n->data;
239 
240  /* RM: Jan 27 1993
241  heap_mod_str_attr(t,CURRENT_MODULE,current_module->module_name);
242  */
243 
248 
251 
254 
255  t1=heap_psi_term(4);
258 
259  t1=heap_psi_term(4);
262 }
#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)
Definition: token.c:91
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)
Definition: lefun.c:63
#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)
Definition: token.c:184
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)
Definition: trees.c:341
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)
Definition: token.c:153
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)

Definition at line 95 of file modules.c.

References current_module.

98 {
99  current_module=module;
100  /* printf("*** Current module: '%s'\n",current_module->module_name); */
101  return current_module;
102 }
ptr_module current_module
Definition: modules.c:13
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)

Definition at line 407 of file bi_sys.c.

References unitListElement.

409 {
410  unitListElement = x;
411 }
static GENERIC unitListElement
Definition: bi_sys.c:405
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)

Definition at line 52 of file parser.c.

References display_psi_stdout(), fx, int_stack, nop, parser_stack_index, psi_term_stack, xf, and xfx.

54 {
55  long i;
56 
57  for (i=1;i<=parser_stack_index;i++) {
58  if (i==limit)
59  printf("-> ");
60  else
61  printf(" ");
62  printf("%3ld: ",i);
63  switch (op_stack[i]) {
64  case fx:
65  printf("FX ");
66  break;
67  case xfx:
68  printf("XFX ");
69  break;
70  case xf:
71  printf("XF ");
72  break;
73  case nop:
74  printf("NOP ");
75  break;
76  default:
77  printf("??? ");
78  }
79  printf(" prec=%4ld ",int_stack[i]);
81  printf("\n");
82  }
83  printf("\n");
84 }
#define xfx
Definition: def_const.h:265
#define fx
Definition: def_const.h:262
void display_psi_stdout(ptr_psi_term t)
Definition: print.c:1427
#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 ( )

Definition at line 1085 of file login.c.

References end_time, goal_count, heap_pointer, mem_base, mem_limit, NOTQUIET, stack_info(), stack_pointer, and verbose.

1086 {
1087  float t;
1088 
1089  if (verbose) {
1090  printf(" [");
1091 
1092  (void)times(&end_time);
1093  t = (end_time.tms_utime - start_time.tms_utime)/60.0;
1094 
1095  printf("%1.3fs cpu, %ld goal%s",t,goal_count,(goal_count!=1?"s":""));
1096 
1097  if (t!=0.0) printf(" (%0.0f/s)",goal_count/t);
1098 
1099  printf(", %ld stack",sizeof(mem_base)*(stack_pointer-mem_base));
1100  printf(", %ld heap",sizeof(mem_base)*(mem_limit-heap_pointer));
1101 
1102  printf("]");
1103  }
1104 
1105  if(NOTQUIET) {
1106  printf("\n");
1107  stack_info(stdout);
1108  }
1109 
1110  goal_count=0;
1111 }
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 
)

Definition at line 73 of file token.c.

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

77 {
78  ptr_psi_term t1;
79 
80  t1=stack_psi_term(4);
81  t1->type=integer;
82  t1->value_3=heap_alloc(sizeof(REAL)); /* 12.5 */
83  *(REAL *)t1->value_3 = (REAL) value;
84 
85  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
86 }
#define FEATCMP
Definition: def_const.h:257
#define REAL
Definition: def_const.h:72
char * heap_copy_string(char *s)
Definition: trees.c:147
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
ptr_definition integer
Definition: def_glob.h:93
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
GENERIC heap_alloc(long s)
Definition: memory.c:1518
void stack_add_psi_attr ( ptr_psi_term  t,
char *  attrname,
ptr_psi_term  g 
)

Definition at line 192 of file token.c.

References FEATCMP, heap_copy_string(), and stack_insert().

196 {
197  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) g);
198 }
#define FEATCMP
Definition: def_const.h:257
char * heap_copy_string(char *s)
Definition: trees.c:147
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
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 
)

Definition at line 136 of file token.c.

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

140 {
141  ptr_psi_term t1;
142 
143  t1=stack_psi_term(4);
144  t1->type=quoted_string;
146 
147  (void)stack_insert(FEATCMP,heap_copy_string(attrname),&(t->attr_list),(GENERIC) t1);
148 }
#define FEATCMP
Definition: def_const.h:257
char * stack_copy_string(char *s)
Definition: trees.c:155
char * heap_copy_string(char *s)
Definition: trees.c:147
ptr_node stack_insert(long comp, char *keystr, ptr_node *tree, GENERIC info)
Definition: trees.c:291
ptr_definition quoted_string
Definition: def_glob.h:101
ptr_psi_term stack_psi_term(long stat)
Definition: lefun.c:15
GENERIC value_3
Definition: def_struct.h:170
ptr_definition type
Definition: def_struct.h:165
unsigned long * GENERIC
Definition: def_struct.h:17
ptr_node attr_list
Definition: def_struct.h:171
GENERIC stack_alloc ( long  s)

Definition at line 1542 of file memory.c.

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

1544 {
1545  GENERIC r;
1546 
1547  r = stack_pointer;
1548 
1549  if (s & (ALIGN-1))
1550  s = s - (s & (ALIGN-1)) + ALIGN;
1551  /* assert(s % sizeof(*stack_pointer) == 0); */
1552  s /= sizeof (*stack_pointer);
1553 
1554  stack_pointer += s;
1555 
1557  Errorline("the stack overflowed into the heap.\n");
1558 
1559  return r;
1560 }
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 
)

Definition at line 117 of file built_ins.c.

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

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

Definition at line 47 of file built_ins.c.

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

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

Definition at line 183 of file parser.c.

References global_time_stamp, and STACK_ALLOC.

185 {
186  ptr_psi_term p;
187 
189  (*p)=t;
190 #ifdef TS
191  p->time_stamp=global_time_stamp; /* 9.6 */
192 #endif
193 
194  return p;
195 }
#define STACK_ALLOC(A)
Definition: def_macro.h:16
unsigned long global_time_stamp
Definition: login.c:19
char* stack_copy_string ( char *  s)

Definition at line 155 of file trees.c.

References one, stack_alloc(), and two.

157 {
158  char *p;
159 
160  if (s==one || s==two) return s;
161 
162  p=(char *)stack_alloc(strlen(s)+1);
163  strcpy(p,s);
164 
165  return p;
166 }
char * two
Definition: def_glob.h:251
char * one
Definition: def_glob.h:250
GENERIC stack_alloc(long s)
Definition: memory.c:1542
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 
)

Definition at line 291 of file trees.c.

References FALSE, general_insert(), and STACK.

296 {
297 
298  return general_insert(comp,keystr,tree,info,STACK,FALSE,0L);
299 }
#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)
Definition: trees.c:184
#define STACK
Definition: def_const.h:148
void stack_insert_copystr ( char *  keystr,
ptr_node tree,
GENERIC  info 
)

Definition at line 260 of file trees.c.

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

264 {
265 
266  (void)general_insert(FEATCMP,keystr,tree,info,STACK,TRUE,0L);
267 }
#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)
Definition: trees.c:184
#define STACK
Definition: def_const.h:148
ptr_psi_term stack_int ( long  n)

Definition at line 87 of file built_ins.c.

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

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

Definition at line 29 of file built_ins.c.

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

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

Definition at line 67 of file built_ins.c.

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

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

Definition at line 15 of file lefun.c.

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

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

Definition at line 102 of file built_ins.c.

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

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

Definition at line 330 of file login.c.

331 {
332  (void)times(&start_time);
333 }
long starts_nonlower ( char *  s)

Definition at line 379 of file print.c.

References LOWER.

381 {
382  return (*s && !LOWER(s[0]));
383 }
#define LOWER(C)
Definition: def_macro.h:41
void stdin_cleareof ( )

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

43 {
44  if (eof_flag && stdin_terminal) {
45  clearerr(stdin);
49  saved_char=0;
52  }
53 }
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 
)

Definition at line 5171 of file built_ins.c.

References heap_alloc().

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

Definition at line 103 of file print.c.

References DIGIT.

105 {
106  long v=0;
107  char c;
108 
109  c=(*s);
110  if (c==0)
111  v= -1;
112  else {
113  while (DIGIT(c)) {
114  v=v*10+(c-'0');
115  s++;
116  c=(*s);
117  }
118  if (c!=0) v= -1;
119  }
120 
121  return v;
122 }
#define DIGIT(C)
Definition: def_macro.h:37
long strict_matches ( ptr_psi_term  t1,
ptr_psi_term  t2,
long *  smaller 
)

Definition at line 1608 of file types.c.

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

1612 {
1613  long result,sm;
1614 
1615  result=matches(t1->type,t2->type,&sm);
1616 
1617  if (sm) {
1618  /* At this point, t1->type <| t2->type */
1619  if (t1->type==t2->type) {
1620  /* Same types: strict only if first has a value & second does not */
1621  if (t1->value_3!=NULL && t2->value_3==NULL)
1622  sm=TRUE;
1623  else
1624  sm=FALSE;
1625  }
1626  else {
1627  /* Different types: the first must be strictly smaller */
1628  sm=TRUE;
1629  }
1630  }
1631 
1632  *smaller=sm;
1633  return result;
1634 }
#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)
Definition: types.c:1565
char* string_val ( ptr_psi_term  term)

Definition at line 164 of file modules.c.

References deref_ptr, and quoted_string.

167 {
168  deref_ptr(term);
169  if(term->value_3 && term->type==quoted_string)
170  return (char *)term->value_3;
171  else
172  return term->type->keyword->symbol;
173 }
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)

Definition at line 139 of file modules.c.

References legal_in_name().

142 {
143  char *s=str;
144 
145  while(legal_in_name(*s))
146  s++;
147  if(s!=str && *s=='#' /* && *(s+1)!=0 */) {
148  s++;
149  /* printf("Stripped module from '%s' yielding '%s'\n",str,s); */
150  return s;
151  }
152  else
153  return str;
154 }
long legal_in_name(long c)
Definition: token.c:861
long strpos ( long  pos,
char *  str 
)

Definition at line 540 of file print.c.

543 {
544  while (*str) {
545  if (str[0]=='\n') pos=0; else pos++;
546  str++;
547  }
548  return pos;
549 }
long sub_CodeType ( ptr_int_list  c1,
ptr_int_list  c2 
)

Definition at line 1522 of file types.c.

References FALSE, wl_int_list::next, NOT_CODED, TRUE, and wl_int_list::value_1.

1525 {
1526  if (c1!=NOT_CODED && c2!=NOT_CODED) {
1527  while (c1 && c2) {
1528  if ((unsigned long)c1->value_1 & ~(unsigned long)c2->value_1) return FALSE;
1529  c1=c1->next;
1530  c2=c2->next;
1531  }
1532  }
1533  else
1534  return FALSE;
1535 
1536  return TRUE;
1537 }
#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 
)

Definition at line 5184 of file built_ins.c.

References heap_alloc().

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

Definition at line 1544 of file types.c.

References wl_definition::code, FALSE, sub_CodeType(), top, and TRUE.

1547 {
1548  if (t1!=t2)
1549  if (t2!=top)
1550  {
1551  if (t1==top)
1552  return FALSE;
1553  else
1554  return sub_CodeType(t1->code, t2->code);
1555  }
1556  return TRUE;
1557 }
long sub_CodeType()
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)

Definition at line 850 of file token.c.

References SYMBOL.

852 {
853  return SYMBOL(c);
854 }
#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)
Definition: print.c:1460
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
Definition: print.c:147
void print_def_type(def_type t)
Definition: types.c:21
#define FALSE
Definition: def_const.h:128
long parse_ok
Definition: def_glob.h:171
void print_operator_kind(FILE *s, long kind)
Definition: print.c:173
#define assert(N)
Definition: memory.c:104
char* text_buffer_cmp ( struct text_buffer buf,
int  idx,
char *  str 
)

Definition at line 748 of file sys.c.

References text_buffer::next, and top.

752 {
753  while (buf) {
754  while (idx<buf->top)
755  if (!*str || buf->data[idx] != *str)
756  return 0;
757  else { idx++; str++; }
758  if (!*str && !buf->next) return str;
759  else {
760  buf=buf->next;
761  idx=0;
762  }
763  }
764  return 0;
765 }
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)

Definition at line 795 of file sys.c.

References text_buffer::next.

797 {
798  struct text_buffer *next;
799  while (buf) {
800  next = buf->next;
801  free(buf);
802  buf=next;
803  }
804 }
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 
)

Definition at line 724 of file sys.c.

References text_buffer::next, and top.

728 {
729  while (buf) {
730  while (idx<buf->top)
731  if (buf->data[idx] == c) {
732  *rbuf=buf;
733  *ridx=idx;
734  return 1;
735  }
736  else idx++;
737  buf=buf->next;
738  idx=0;
739  }
740  return 0;
741 }
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 
)

Definition at line 773 of file sys.c.

References text_buffer::data, and TEXTBUFSIZE.

776 {
777  if ((*buf)->top < TEXTBUFSIZE)
778  (*buf)->data[(*buf)->top++] = c;
779  else {
780  (*buf)->next = (struct text_buffer *)
781  malloc(sizeof(struct text_buffer));
782  if (!(*buf)->next) {
783  fprintf(stderr,"Fatal error: malloc failed in text_buffer_push\n");
784  exit(EXIT_FAILURE);
785  }
786  bzero((char*)(*buf)->next,sizeof(struct text_buffer));
787  *buf = (*buf)->next;
788  (*buf)->top = 1;
789  (*buf)->data[0]=c;
790  }
791 }
#define TEXTBUFSIZE
Definition: def_struct.h:396
struct text_buffer * next
Definition: def_struct.h:399
void title ( )

Definition at line 31 of file info.c.

References PARSER_STACK_SIZE, pnf(), quietflag, REAL, and STRLEN.

32 {
33  if(quietflag)
34  return; /* RM: Feb 17 1993 */
35 
36  printf("Wild_Life Interpreter Version +VERSION+ +DATE+\n");
37  printf("Copyright (C) 1991-93 DEC Paris Research Laboratory\n");
38  printf("Extensions, Copyright (C) 1994-1995 Intelligent Software Group, SFU\n");
39  // should comment next 4 lines for test suite
40  // printf("OS/2 Port by Dennis J. Darland 06/17/96\n");
41  // printf("SUSE Linux Port by Dennis J. Darland May 2014\n");
42  // printf("Cygwin Port by Dennis J. Darland March 2015\n");
43  // printf("Further Debugging of Port by Dennis J. Darland June 2016\n");
44  // I don't understand why I cannot have above lines.
45  // has to to with title call in lib.c & life.c - related to memory.c
46  // may be important to understand even not just for above printf's
47 
48 #ifndef X11
49  printf("X interface not installed.\n");
50 #endif
51 
52 #if 0
53  printf("\n- Main data-structure sizes:\n");
54  pnf("rule",sizeof(struct pair_list));
55  pnf("psi_term",sizeof(struct psi_term));
56  pnf("binary tree node",sizeof(struct node));
57  pnf("stacked goal",sizeof(struct goal));
58  pnf("stacked choice-point",sizeof(struct choice_point));
59  pnf("backtracking action",sizeof(struct ptr_stack));
60  pnf("symbol definition",sizeof(struct definition));
61  pnf("code node",sizeof(struct int_list));
62  pnf("list node",sizeof(struct list));
63  pnf("real number",sizeof(REAL));
64 
65  printf("\n- Size of C built-in types:\n");
66  pnf("REAL",sizeof(REAL));
67  pnf("long",sizeof(long));
68  pnf("int",sizeof(unsigned long));
69  pnf("pointer",sizeof(char *));
70 
71  printf("\n- System constants:\n");
72  pnf("Maximum string or line length:",STRLEN);
73  pnf("Parser stack depth:",PARSER_STACK_SIZE);
74  pnf("Size of real numbers:",sizeof(REAL));
75  printf("\n\n");
76 #endif
77 }
static void pnf(char *s, int n)
Definition: info.c:12
#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)

Definition at line 30 of file token.c.

References error_psi_term, Syntaxerrorline(), and wl_psi_term::type.

33 {
34  if(p->type==error_psi_term->type) {
35  Syntaxerrorline("Module violation (%E).\n");
36  }
37 }
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 ( )

Definition at line 1907 of file login.c.

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

1908 {
1910 
1911  while (cp && cp->goal_stack && cp->goal_stack->type!=what_next)
1912  cp=cp->next;
1913 
1914  if (cp && cp->goal_stack && cp->goal_stack->type==what_next)
1915  return cp;
1916  else
1917  return (ptr_choice_point) NULL;
1918 }
#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)
Definition: print.c:1460
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)
Definition: print.c:147
void print_def_type(def_type t)
Definition: types.c:21
#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)
Definition: print.c:173
#define assert(N)
Definition: memory.c:104
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)

Definition at line 2490 of file login.c.

References choice_stack, and wl_choice_point::time_stamp.

2491 {
2492  return (choice_stack && choice_stack->time_stamp>=Q->time_stamp);
2493 }
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 
)

Definition at line 101 of file copy.c.

References hashentry::bucketindex, HASH, HASHEND, hashtable, hashtime, hashbucket::info, hashbucket::new_value, hashbucket::next, NULL, and hashbucket::old_value.

104 {
105  long index;
106  /* long i; 20.8 */
107  long bucket;
108 
109  index = HASH(a);
110  if (hashtable[index].timestamp != hashtime) return NULL;
111  bucket = hashtable[index].bucketindex;
112  /* i=0; 20.8 */
113  while (bucket != HASHEND && hashbuckets[bucket].old_value != a) {
114  /* i++; 20.8 */
115  bucket = hashbuckets[bucket].next;
116  }
117  /* hashstats[i]++; 20.8 */
118  if (bucket != HASHEND) {
119  *infoptr = &hashbuckets[bucket].info;
120  return (hashbuckets[bucket].new_value);
121  }
122  else
123  return NULL;
124 }
static struct hashentry hashtable[HASHSIZE]
Definition: copy.c:20
#define HASHEND
Definition: def_const.h:322
#define NULL
Definition: def_const.h:203
static long hashtime
Definition: copy.c:22
static struct hashbucket * hashbuckets
Definition: copy.c:21
long bucketindex
Definition: def_struct.h:393
#define HASH(A)
Definition: def_macro.h:273
void traverse_tree ( ptr_node  n,
int  flag 
)

Definition at line 640 of file modules.c.

References deref_ptr, FALSE, MAKE_FEATURE_PRIVATE, make_feature_private(), MAKE_PRIVATE, make_public(), MAKE_PUBLIC, and TRUE.

643 {
644  if (n) {
645  ptr_psi_term t;
646  traverse_tree(n->left,flag);
647 
648  t=(ptr_psi_term)n->data;
649  deref_ptr(t);
650  switch (flag) {
651  case MAKE_PUBLIC:
652  (void)make_public(t,TRUE);
653  break;
654  case MAKE_PRIVATE:
655  (void)make_public(t,FALSE);
656  break;
658  (void)make_feature_private(t);
659  break;
660  }
661  traverse_tree(n->right,flag);
662  }
663 }
void traverse_tree(ptr_node n, int flag)
Definition: modules.c:640
GENERIC data
Definition: def_struct.h:185
ptr_node left
Definition: def_struct.h:183
#define MAKE_PRIVATE
Definition: modules.c:634
#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)
Definition: modules.c:1239
long make_public(ptr_psi_term term, long bool)
Definition: modules.c:600
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
#define MAKE_FEATURE_PRIVATE
Definition: modules.c:635
#define MAKE_PUBLIC
Definition: modules.c:633
ptr_node right
Definition: def_struct.h:184
long two_or_more ( ptr_node  t)

Definition at line 1165 of file print.c.

References FALSE, and TRUE.

1167 {
1168  if (t) {
1169  if (t->left || t->right) return TRUE; else return FALSE;
1170  }
1171  else
1172  return FALSE;
1173 }
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)

Definition at line 731 of file types.c.

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

733 {
734  ptr_int_list result,code;
735  long v=1;
736 
737  code=HEAP_ALLOC(int_list);
738  code->value_1=0;
739  code->next=NULL;
740  result=code;
741 
742  while (p>=INT_SIZE) {
743  code->next=HEAP_ALLOC(int_list);
744  code=code->next;
745  code->value_1=0;
746  code->next=NULL;
747  p=p-INT_SIZE;
748  }
749 
750  v= v<<p ;
751  code->value_1=(GENERIC)v;
752 
753  return result;
754 }
#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 
)

Definition at line 907 of file types.c.

References wl_definition::code, Errorline(), exit_life(), FALSE, wl_int_list::next, NOT_CODED, perr(), perr_sort_cycle(), TRUE, type_member(), and wl_int_list::value_1.

910 {
911  ptr_int_list p=d->parents;
912  ptr_definition pd;
913  long errflag;
914  int_list anc2;
915 
916  while (p) {
917  pd=(ptr_definition)p->value_1;
918  /* If unmarked, mark and recurse */
919  if (pd->code==NOT_CODED) {
920  pd->code = (ptr_int_list)TRUE;
921  anc2.value_1=(GENERIC)pd;
922  anc2.next=anc;
923  errflag=type_cyclicity(pd,&anc2);
924  if (errflag) return TRUE;
925  }
926  /* If marked, check if it's in the ancestor list */
927  else {
928  if (type_member(pd,anc)) {
929  Errorline("there is a cycle in the sort hierarchy\n");
930  perr("*** Cycle: [");
931  perr_sort_cycle(anc);
932  perr("]\n");
933  exit_life(TRUE);
934  return TRUE;
935  }
936  }
937  p=p->next;
938  }
939  return FALSE;
940 }
long type_cyclicity(ptr_definition d, ptr_int_list anc)
Definition: types.c:907
void perr(char *str)
Definition: error.c:659
void exit_life(long nl_flag)
Definition: built_ins.c:2090
#define NOT_CODED
Definition: def_const.h:134
void perr_sort_cycle(ptr_int_list anc)
Definition: types.c:892
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
long type_member()
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
ptr_int_list parents
Definition: def_struct.h:130
void type_disj_aim ( )

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

1745 {
1746  ptr_psi_term t;
1747  ptr_int_list d;
1748 
1749  t=(ptr_psi_term)aim->aaaa_1;
1750  d=(ptr_int_list)aim->bbbb_1;
1751 
1752  if (d->next) {
1753  traceline("pushing type disjunction choice point for %P\n", t);
1755  }
1756 
1757  push_ptr_value(def_ptr,(GENERIC *)&(t->type));
1758  /* Below makes cut.lf behave incorrectly: */
1759  /* push_def_ptr_value(t,&(t->type)); */ /* 14.8 */
1760  t->type=(ptr_definition)d->value_1;
1761 
1762  traceline("setting type disjunction to %s.\n", t->type->keyword->symbol);
1763 
1764  if ((t->attr_list || t->type->always_check) && t->status<4)
1765  fetch_def(t, FALSE);
1766 }
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)
Definition: login.c:1128
ptr_node attr_list
Definition: def_struct.h:171
void push_ptr_value(type_ptr t, GENERIC *p)
Definition: login.c:360
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
Definition: login.c:591
ptr_int_list next
Definition: def_struct.h:55
long type_member ( ptr_definition  t,
ptr_int_list  tlst 
)

Definition at line 864 of file types.c.

References FALSE, wl_int_list::next, TRUE, and wl_int_list::value_1.

867 {
868  while (tlst) {
869  if (t==(ptr_definition)tlst->value_1) return TRUE;
870  tlst=tlst->next;
871  }
872  return FALSE;
873 }
#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)

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

648 {
649  /*
650  while((unsigned long)undo_stack>(unsigned long)goal_stack)
651  */
652 
653  while ((unsigned long)undo_stack>(unsigned long)limit) {
654 #ifdef X11
655  if (undo_stack->type & undo_action) {
656  /* Window operation on backtracking */
657  switch(undo_stack->type) { /*** RM 8/12/92 ***/
658  case destroy_window:
659  x_destroy_window((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
660  break;
661  case show_window:
662  x_show_window((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
663  break;
664  case hide_window:
665  x_hide_window((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
666  break;
667  case show_subwindow:
668  x_show_subwindow((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
669  break;
670  case hide_subwindow:
671  x_hide_subwindow((Display *)undo_stack->aaaa_3,(Window)undo_stack->bbbb_3);
672  break;
673  }
674  }
675  else
676 #endif
677  /* Restoring variable value on backtracking */
680  }
681 }
#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 ( )

Definition at line 690 of file login.c.

References Errorline(), NULL, and undo().

691 {
692  // ptr_stack u=undo_stack;
693 
694  Errorline("undo_actions should not be called.\n");
695  undo(NULL); /* 8.10 */
696  return;
697  /*
698  #ifdef X11
699  while ((unsigned long)u) {
700  if (u->type & undo_action) {
701  if (u->type==destroy_window) {
702  x_destroy_window((unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3);
703  }
704  else if (u->type==show_window) {
705  x_show_window((unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3);
706  }
707  else if (u->type==hide_window) {
708  x_hide_window((unsigned long)u->aaaa_3,(unsigned long)u->bbbb_3);
709  }
710  }
711  u=u->next;
712  }
713  #endif
714  */
715 }
void undo(ptr_stack limit)
Definition: login.c:646
#define NULL
Definition: def_const.h:203
void Errorline(char *format,...)
Definition: error.c:414
long unify_aim ( )

Definition at line 1264 of file login.c.

References TRUE, and unify_body().

1265 {
1266  return unify_body(TRUE);
1267 }
long unify_body(long eval_flag)
Definition: login.c:1269
#define TRUE
Definition: def_const.h:127
long unify_aim_noeval ( )

Definition at line 1259 of file login.c.

References FALSE, and unify_body().

1260 {
1261  return unify_body(FALSE);
1262 }
long unify_body(long eval_flag)
Definition: login.c:1269
#define FALSE
Definition: def_const.h:128
long unify_body ( long  eval_flag)

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

1271 {
1272  long success=TRUE,compare;
1273  ptr_psi_term u,v,tmp;
1274  // ptr_list lu,lv;
1275  REAL r;
1276  ptr_definition new_type,old1,old2;
1277  ptr_node old1attr, old2attr;
1278  ptr_int_list new_code;
1279  ptr_int_list d=NULL;
1280  long old1stat,old2stat; /* 18.2.94 */
1281 
1282  u=(ptr_psi_term )aim->aaaa_1;
1283  v=(ptr_psi_term )aim->bbbb_1;
1284 
1285  deref_ptr(u);
1286  deref_ptr(v);
1287 
1288  traceline("unify %P with %P\n",u,v);
1289 
1290  if (eval_flag) {
1291  deref(u);
1292  deref(v);
1293  }
1294 
1295  if (u!=v) {
1296 
1297  /**** Swap the two psi-terms to get them into chronological order ****/
1298  if (u>v) { tmp=v; v=u; u=tmp; }
1299 
1300  /**** Check for curried functions ****/
1303  old1stat=u->status; /* 18.2.94 */
1304  old2stat=v->status; /* 18.2.94 */
1305 
1306  /* PVR 18.2.94 */
1307  /* if (u_func && !(u->flags&QUOTED_TRUE) && v->attr_list) { */
1308  if (u_func && u->status==4 && !(u->flags&QUOTED_TRUE) && v->attr_list) {
1309  Errorline("attempt to unify with curried function %P\n", u);
1310  return FALSE;
1311  }
1312  /* if (v_func && !(v->flags&QUOTED_TRUE) && u->attr_list) { */
1313  if (v_func && v->status==4 && !(v->flags&QUOTED_TRUE) && u->attr_list) {
1314  Errorline("attempt to unify with curried function %P\n", v);
1315  return FALSE;
1316  }
1317 
1318 
1319 #ifdef ARITY /* RM: Mar 29 1993 */
1320  arity_unify(u,v);
1321 #endif
1322 
1323  /***** Deal with global vars **** RM: Feb 8 1993 */
1324  if((GENERIC) v>=heap_pointer)
1325  return global_unify(u,v);
1326 
1327 
1328  /**** Calculate their Greatest Lower Bound and compare them ****/
1329  success=(compare=glb(u->type,v->type,&new_type,&new_code));
1330 
1331  if (success) {
1332 
1333  /**** Keep the old types for later use in incr. constraint checking ****/
1334  old1 = u->type;
1335  old2 = v->type;
1336  old1attr = u->attr_list;
1337  old2attr = v->attr_list;
1338 
1339  /**** DECODE THE RESULTING TYPE ****/
1340  if (!new_type) {
1341  d=decode(new_code);
1342  if (d) {
1343  new_type=(ptr_definition)d->value_1;
1344  d=d->next;
1345  }
1346  else
1347  Errorline("undecipherable sort code.\n");
1348  }
1349 
1350  /**** Make COMPARE a little more precise ****/
1351  if (compare==1)
1352  if (u->value_3 && !v->value_3)
1353  compare=2;
1354  else
1355  if (v->value_3 && !u->value_3)
1356  compare=3;
1357 
1358  /**** Determine the status of the resulting psi-term ****/
1359  new_stat=4;
1360  switch (compare) {
1361  case 1:
1362  if (u->status <4 && v->status <4)
1363  new_stat=2;
1364  break;
1365  case 2:
1366  if (u->status<4)
1367  new_stat=2;
1368  break;
1369  case 3:
1370  if (v->status<4)
1371  new_stat=2;
1372  break;
1373  case 4:
1374  new_stat=2;
1375  break;
1376  }
1377 
1378  /*
1379  printf("u=%s, v=%s, compare=%ld, u.s=%ld, v.s=%ld, ns=%ld\n",
1380  u->type->keyword->symbol,
1381  v->type->keyword->symbol,
1382  compare,
1383  u->status,
1384  v->status,
1385  new_stat);
1386  */
1387 
1388  /**** Check that integers have no decimals ****/
1389  if (u->value_3 && sub_type(new_type,integer)) {
1390  r= *(REAL *)u->value_3;
1391  success=(r==floor(r));
1392  }
1393  if (success && v->value_3 && sub_type(new_type,integer)) {
1394  r= *(REAL *)v->value_3;
1395  success=(r==floor(r));
1396  }
1397 
1398  /**** Unify the values of INTs REALs STRINGs LISTs etc... ****/
1399  if (success) {
1400  /* LAZY-EAGER */
1401  if (u->value_3!=v->value_3)
1402  if (!u->value_3) {
1403  compare=4;
1405  u->value_3=v->value_3;
1406  }
1407  else if (v->value_3) {
1408  if (overlap_type(new_type,real))
1409  success=(*((REAL *)u->value_3)==(*((REAL *)v->value_3)));
1410  else if (overlap_type(new_type,quoted_string))
1411  success=(strcmp((char *)u->value_3,(char *)v->value_3)==0);
1412  else if (overlap_type(new_type,sys_bytedata)) {
1413  unsigned long ulen = *((unsigned long *)u->value_3);
1414  unsigned long vlen = *((unsigned long *)v->value_3);
1415  success=(ulen==vlen &&
1416  (bcmp((char *)u->value_3,(char *)v->value_3,ulen)==0));
1417  }
1418  else if (u->type==cut && v->type==cut) { /* 22.9 */
1419  ptr_psi_term mincut;
1420  mincut = (ptr_psi_term) (u->value_3 < (GENERIC) v->value_3? u->value_3 : v->value_3);
1421  if (mincut!=(ptr_psi_term)u->value_3) {
1423  u->value_3=(GENERIC)mincut;
1424  }
1425  }
1426  else {
1427  warningline("'%s' may not be unified.\n",new_type->keyword->symbol);
1428  success=FALSE;
1429  }
1430  }
1431  else
1432  compare=4;
1433  }
1434 
1435  /**** Bind the two psi-terms ****/
1436  if (success) {
1437  /* push_ptr_value(psi_term_ptr,(ptr_psi_term *)&(v->coref)); 9.6 */
1438  push_psi_ptr_value(v,(GENERIC *)&(v->coref));
1439  v->coref=u;
1440 
1441  if (!equal_types(u->type,new_type)) {
1442  push_ptr_value(def_ptr,(GENERIC *)&(u->type));
1443  /* This does not seem to work right with cut.lf: */
1444  /* push_def_ptr_value(u,&(u->type_3)); */ /* 14.8 */
1445  u->type=new_type;
1446  }
1447 
1448  if (u->status!=new_stat) {
1450  u->status=new_stat;
1451  }
1452 
1453  /**** Unify the attributes ****/
1456 
1457 
1458 #ifdef ARITY /* RM: Mar 29 1993 */
1459  arity_merge(u->attr_list,v->attr_list);
1460 #endif
1461 
1462 
1463  if (u->attr_list || v->attr_list)
1464  merge(&(u->attr_list),v->attr_list);
1465 
1466  /**** Look after curried functions ****/
1467  /*
1468  if ((u_func && more_v_attr) || (v_func && more_u_attr)) {
1469  if (!(u->flags&QUOTED_TRUE | v->flags&QUOTED_TRUE)) {
1470  traceline("re-evaluating curried expression %P\n", u);
1471  if (u->status!=0) {
1472  push_ptr_value(int_ptr,(ptr_psi_term *)&(u->status));
1473  u->status=0;
1474  }
1475  check_func(u);
1476  }
1477  }
1478  */
1479 
1480  if (v->flags&QUOTED_TRUE && !(u->flags&QUOTED_TRUE)) { /* 16.9 */
1481  push_ptr_value(int_ptr,(GENERIC *)&(u->flags));
1482  u->flags|=QUOTED_TRUE;
1483  }
1484 
1485  /**** RELEASE RESIDUATIONS ****/
1486  /* This version implements the correct semantics. */
1487  if (u->resid)
1488  release_resid(u);
1489  if (v->resid)
1490  release_resid(v);
1491 
1492  /**** Alternatives in a type disjunction ****/
1493  if (d) {
1494  traceline("pushing type disjunction choice point for %P\n",u);
1496  }
1497 
1498  /**** VERIFY CONSTRAINTS ****/
1499  /* if ((old1stat<4 || old2stat<4) &&
1500  (u->type->type==type || v->type->type==type)) { 18.2.94 */
1501  if (new_stat<4 && u->type->type_def==(def_type)type_it) {
1502  /* This does not check the already-checked properties */
1503  /* (i.e. those in types t with t>=old1 or t>=old2), */
1504  /* and it does not check anything if u has no attributes. */
1505  /* It will, however, check the unchecked properties if a */
1506  /* type gains attributes. */
1507  fetch_def_lazy(u, old1, old2,
1508  old1attr, old2attr,
1509  old1stat, old2stat);
1510  }
1511  }
1512  }
1513  }
1514  return success;
1515 }
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)
Definition: modules.c:1035
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)
Definition: types.c:1388
#define def_ptr
Definition: def_const.h:173
long new_stat
Definition: def_glob.h:307
ptr_int_list decode(ptr_int_list c)
Definition: types.c:1678
void fetch_def_lazy(ptr_psi_term u, ptr_definition old1, ptr_definition old2, ptr_node old1attr, ptr_node old2attr, long old1stat, long old2stat)
Definition: login.c:1188
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)
Definition: login.c:1061
long overlap_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1486
#define REAL
Definition: def_const.h:72
void release_resid(ptr_psi_term t)
Definition: lefun.c:414
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
void 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)
Definition: login.c:443
#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)
Definition: login.c:360
void push_choice_point(goals t, ptr_psi_term aaaa_6, ptr_psi_term bbbb_6, GENERIC cccc_6)
Definition: login.c:591
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 
)

Definition at line 329 of file built_ins.c.

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

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

Definition at line 371 of file built_ins.c.

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

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

Definition at line 87 of file print.c.

References find(), heap_nice_name(), STRCMP, and var_tree.

88 {
89  GENERIC name_loc;
90 
91  do name_loc=(GENERIC)heap_nice_name();
92  while (find(STRCMP,(char *)name_loc,var_tree));
93 
94  return name_loc;
95 }
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)
Definition: trees.c:341
unsigned long * GENERIC
Definition: def_struct.h:17
GENERIC unitListNext ( )

Definition at line 418 of file bi_sys.c.

References NULL, and unitListElement.

419 {
421  return NULL;
422 }
#define NULL
Definition: def_const.h:203
static GENERIC unitListElement
Definition: bi_sys.c:405
ptr_psi_term unitListValue ( )

Definition at line 413 of file bi_sys.c.

References makePsiTerm(), and unitListElement.

414 {
415  return makePsiTerm((void *)unitListElement);
416 }
ptr_psi_term makePsiTerm(ptr_definition x)
Definition: bi_sys.c:468
static GENERIC unitListElement
Definition: bi_sys.c:405
ptr_definition update_feature ( ptr_module  module,
char *  feature 
)

Definition at line 1315 of file modules.c.

References current_module, wl_keyword::definition, extract_module_from_name(), hash_lookup(), NULL, wl_keyword::private_feature, and update_symbol().

1319 {
1320  ptr_keyword key;
1321  ptr_module explicit;
1322 
1323  /* Check if the feature already contains a module name */
1324 
1325  if(!module)
1326  module=current_module;
1327 
1328  explicit=extract_module_from_name(feature);
1329  if(explicit)
1330  if(explicit!=module)
1331  return NULL; /* Feature isn't visible */
1332  else
1333  return update_symbol(NULL,feature);
1334 
1335  /* Now we have a simple feature to look up */
1336  key=hash_lookup(module->symbol_table,feature);
1337  if(key && key->private_feature)
1338  return key->definition;
1339  else
1340  return update_symbol(module,feature);
1341 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
Definition: hash_table.c:133
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:13
ptr_definition update_symbol(ptr_module module, char *symbol)
Definition: modules.c:264
int private_feature
Definition: def_struct.h:95
ptr_module extract_module_from_name(char *str)
Definition: modules.c:111
ptr_definition update_symbol ( ptr_module  module,
char *  symbol 
)

Definition at line 264 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, new_definition(), wl_int_list::next, NULL, 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().

267 {
268  ptr_keyword key;
269  ptr_definition result=NULL;
270  ptr_int_list opens;
271  ptr_module opened;
272  ptr_keyword openkey;
273  ptr_keyword tempkey;
274 
275  /* First clean up the arguments and find out which module to use */
276 
277  if(!module) {
278  module=extract_module_from_name(symbol);
279  if(!module)
280  module=current_module;
281  symbol=strip_module_name(symbol);
282  }
283 
284  /* printf("looking up %s#%s\n",module->module_name,symbol); */
285 
286  /* Now look up 'module#symbol' in the symbol table */
287  key=hash_lookup(module->symbol_table,symbol);
288 
289  if(key)
290  if(key->public || module==current_module)
291  result=key->definition;
292  else {
293  Errorline("qualified call to private symbol '%s'\n",
294  key->combined_name);
295 
296  result=error_psi_term->type;
297  }
298  else
299  if(module!=current_module) {
300  Errorline("qualified call to undefined symbol '%s#%s'\n",
301  module->module_name,symbol);
302  result=error_psi_term->type;
303  }
304  else
305  {
306  /* Add 'module#symbol' to the symbol table */
307  key=HEAP_ALLOC(struct wl_keyword);
308  key->module=module;
309  key->symbol=(char *)heap_copy_string(symbol);
310  key->combined_name=heap_copy_string(make_module_token(module,symbol));
311  key->public=FALSE;
312  key->private_feature=FALSE; /* RM: Mar 11 1993 */
313  key->definition=NULL;
314 
315  hash_insert(module->symbol_table,key->symbol,key);
316 
317 
318  /* Search the open modules of 'module' for 'symbol' */
319  opens=module->open_modules;
320  openkey=NULL;
321  while(opens) {
322  opened=(ptr_module)(opens->value_1);
323  if(opened!=module) {
324 
325  tempkey=hash_lookup(opened->symbol_table,symbol);
326 
327  if(tempkey)
328  if(openkey && openkey->public && tempkey->public) {
329  if(openkey->definition==tempkey->definition) {
330  warningline("benign module name clash: %s and %s\n",
331  openkey->combined_name,
332  tempkey->combined_name);
333  }
334  else {
335  Errorline("serious module name clash: \"%s\" and \"%s\"\n",
336  openkey->combined_name,
337  tempkey->combined_name);
338 
339  result=error_psi_term->type;
340  }
341  }
342  else
343  if(!openkey || !openkey->public)
344  openkey=tempkey;
345  }
346 
347  opens=opens->next;
348  }
349 
350  if(!result) { /* RM: Feb 1 1993 */
351 
352  if(openkey && openkey->public) {
353  /* Found the symbol in an open module */
354 
355  if(!openkey->public)
356  warningline("implicit reference to non-public symbol: %s\n",
357  openkey->combined_name);
358 
359  result=openkey->definition;
360  key->definition=result;
361 
362  /*
363  printf("*** Aliasing %s#%s to %s#%s\n",
364  key->module->module_name,
365  key->symbol,
366  openkey->module->module_name,
367  openkey->symbol);
368  */
369 
370  }
371  else { /* Didn't find it */
372  result=new_definition(key);
373  }
374  }
375  }
376 
377  return result;
378 }
ptr_keyword hash_lookup(ptr_hash_table table, char *symbol)
Definition: hash_table.c:133
char * combined_name
Definition: def_struct.h:92
ptr_definition new_definition(ptr_keyword key)
Definition: modules.c:215
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:13
char * symbol
Definition: def_struct.h:91
char * strip_module_name(char *str)
Definition: modules.c:139
struct wl_module * ptr_module
Definition: def_struct.h:83
void Errorline(char *format,...)
Definition: error.c:414
char * heap_copy_string(char *s)
Definition: trees.c:147
void hash_insert(ptr_hash_table table, char *symbol, ptr_keyword keyword)
Definition: hash_table.c:155
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)
Definition: modules.c:111
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)
Definition: modules.c:185
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)
Definition: print.c:1460
void perr_s(char *s1, char *s2)
Definition: error.c:665
void print_code(FILE *s, ptr_int_list c)
Definition: print.c:147
void print_def_type(def_type t)
Definition: types.c:21
#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)
Definition: print.c:173
#define assert(N)
Definition: memory.c:104
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)

Definition at line 315 of file lib.c.

318 {
319  int result=0;
320 
321  if(n) {
322  if(n->left)
323  result+=WFfeature_count_loop(n->left);
324  result++;
325  if(n->right)
326  result+=WFfeature_count_loop(n->right);
327  }
328 
329  return result;
330 }
ptr_node left
Definition: def_struct.h:183
int WFfeature_count_loop(ptr_node n)
Definition: lib.c:315
ptr_node right
Definition: def_struct.h:184
int WFFeatureCount ( ptr_psi_term  psi)

Definition at line 334 of file lib.c.

References deref_ptr, and WFfeature_count_loop().

337 {
338  int result=0;
339 
340  if(psi) {
341  deref_ptr(psi);
342  result=WFfeature_count_loop(psi->attr_list);
343  }
344 
345  return result;
346 }
#define deref_ptr(P)
Definition: def_macro.h:95
int WFfeature_count_loop(ptr_node n)
Definition: lib.c:315
ptr_node attr_list
Definition: def_struct.h:171
char** WFFeatures ( ptr_psi_term  psi)

Definition at line 364 of file lib.c.

References deref_ptr, group_features(), NULL, and WFfeature_count_loop().

367 {
368  char **features_loc=NULL;
369  int n;
370 
371  if(psi) {
372  deref_ptr(psi);
373 
375  if(n) {
376  features_loc=(char **)malloc((n+1)*sizeof(char *));
377  (void)group_features(features_loc,psi->attr_list);
378  }
379  }
380 
381  return features_loc;
382 }
#define NULL
Definition: def_const.h:203
#define deref_ptr(P)
Definition: def_macro.h:95
char ** group_features(char **f, ptr_node n)
Definition: lib.c:22
int WFfeature_count_loop(ptr_node n)
Definition: lib.c:315
ptr_node attr_list
Definition: def_struct.h:171
double WFGetDouble ( ptr_psi_term  psi,
int *  ok 
)

Definition at line 387 of file lib.c.

References deref_ptr, FALSE, real, sub_type(), and TRUE.

390 {
391  double value=0.0;
392 
393  if(ok)
394  *ok=FALSE;
395 
396  if(psi) {
397  deref_ptr(psi);
398 
399  if(sub_type(psi->type,real) && psi->value_3) {
400  value= *((double *)psi->value_3);
401  if(ok)
402  *ok=TRUE;
403  }
404  }
405  return value;
406 }
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
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  ps,
char *  feature 
)

Definition at line 433 of file lib.c.

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

437 {
438  ptr_psi_term result=NULL;
439  ptr_node n;
440 
441  if(psi && feature) {
442  deref_ptr(psi);
443  n=find(FEATCMP,feature,psi->attr_list);
444  if(n)
445  result=(PsiTerm)n->data;
446  }
447 
448  return result;
449 }
#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)
Definition: trees.c:341
char* WFGetString ( ptr_psi_term  psi,
int *  ok 
)

Definition at line 410 of file lib.c.

References deref_ptr, FALSE, NULL, quoted_string, sub_type(), and TRUE.

413 {
414  char *value=NULL;
415 
416  if(ok)
417  *ok=FALSE;
418 
419  if(psi) {
420  deref_ptr(psi);
421 
422  if(sub_type(psi->type,quoted_string) && psi->value_3) {
423  value=(char *)psi->value_3;
424  if(ok)
425  *ok=TRUE;
426  }
427  }
428  return value;
429 }
#define NULL
Definition: def_const.h:203
long sub_type(ptr_definition t1, ptr_definition t2)
Definition: types.c:1544
#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)

Definition at line 297 of file lib.c.

References wl_node::data, deref_ptr, find(), NULL, STRCMP, and var_tree.

300 {
301  ptr_psi_term result=NULL;
302  ptr_node n;
303 
305  if(n) {
306  result=(ptr_psi_term)n->data;
307  if(result)
308  deref_ptr(result);
309  }
310 
311  return result;
312 }
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)
Definition: trees.c:341
struct wl_psi_term * ptr_psi_term
Definition: def_struct.h:34
void WFInit ( long  argc,
char **  argv 
)
int WFInput ( char *  query)

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

213 {
214  ptr_psi_term t;
215  long sort;
216  parse_block pb;
217  int result=WFno;
218  ptr_stack save_undo_stack;
219  ptr_choice_point old_choice;
220 
221 
222  save_undo_stack=undo_stack;
223  old_choice=choice_stack;
224 
225 
226  if(!strcmp(query,".")) {
227  reset_stacks();
228  result=WFyes;
229  c_query_level=0;
230  }
231  else {
232  if(!strcmp(query,";")) {
233  sort=QUERY;
235  }
236  else {
237  /* Parse the string in its own state */
238  save_parse_state(&pb);
241  stringinput=query;
242 
243  /* old_var_occurred=var_occurred; */
245  t=stack_copy_psi_term(parse(&sort));
246 
247  /* Main loop of interpreter */
248  if(sort==QUERY) {
250  goal_count=0;
251 
253  c_query_level++;
256  /* reset_step(); */
257  }
258  else if (sort==FACT) {
260  assert_clause(t);
261  if(assert_ok)
262  result=WFyes;
263  undo(save_undo_stack);
265  encode_types();
266  }
267  }
268 
269  if(sort==QUERY) {
270  start_chrono();
271  main_prove();
272 
274 
275  if((long)(goal_stack->aaaa_1)==c_query_level)
276  if(choice_stack==old_choice) {
277  result=WFyes;
278  c_query_level--;
279  }
280  else
281  result=WFmore;
282  else {
283  result=WFno;
284  c_query_level--;
285  }
286 
288  }
289  }
290  }
291 
292  return result;
293 }
#define prove
Definition: def_const.h:273
ptr_psi_term aaaa_1
Definition: def_struct.h:224
void undo(ptr_stack limit)
Definition: login.c:646
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)
Definition: login.c:591
void push_goal(goals t, ptr_psi_term a, ptr_psi_term b, GENERIC c)
Definition: login.c:555
psi_term parse(long *q)
Definition: parser.c:877
void save_parse_state(ptr_parse_block pb)
Definition: token.c:350
#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()
Definition: login.c:330
#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()
Definition: token.c:381
void reset_stacks()
Definition: login.c:1924
ptr_psi_term stack_copy_psi_term(psi_term t)
Definition: parser.c:183
void encode_types()
Definition: types.c:1015
void main_prove()
Definition: login.c:2205
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)
Definition: login.c:267
ptr_choice_point choice_stack
Definition: def_glob.h:51
ptr_goal next
Definition: def_struct.h:227
char* WFType ( ptr_psi_term  psi)

Definition at line 350 of file lib.c.

References deref_ptr, and NULL.

353 {
354  char *result=NULL;
355  if(psi) {
356  deref_ptr(psi);
357  result=psi->type->keyword->combined_name;
358  }
359  return result;
360 }
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 ( )

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

1943 {
1944  long result=FALSE;
1945  ptr_psi_term s;
1946  long c, c2; /* 21.12 (prev. char) */
1947  char *pr;
1948  long sort,cut_loc=FALSE;
1949  long level,i;
1950  long eventflag;
1951  ptr_stack save_undo_stack;
1952  long lev1,lev2;
1954 
1955  level=((unsigned long)aim->cccc_1);
1956 
1957  if (aim->aaaa_1) {
1958  /* Must remember var_occurred from the what_next goal and from */
1959  /* execution of previous query (it may have contained a parse) */
1960  var_occurred=var_occurred || ((unsigned long)aim->bbbb_1)&TRUEMASK; /* 18.8 */
1961  eventflag=(((unsigned long)aim->bbbb_1)&(TRUEMASK*2))!=0;
1962  if (
1963  !var_occurred && no_choices() && level>0
1964 #ifdef X11
1965  /* Keep level same if no window & no X event */
1966  && !x_window_creation && !eventflag
1967 #endif
1968  ) {
1969  /* Keep level the same if in a query, the number of choice points */
1970  /* has not increased and there are no variables. */
1971  /* This has to have the same behavior as if an EOLN was typed */
1972  /* and no 'No' message should be given on the lowest level, */
1973  level--;
1974  (void)what_next_cut();
1975  if (level==0) { result=TRUE; }
1976  }
1977  }
1978 
1979 #ifdef X11
1981 #endif
1982 
1983  infoline(aim->aaaa_1?"\n*** Yes":"\n*** No");
1984  show_count();
1985  if (aim->aaaa_1 || level>0 ) (void)print_variables(NOTQUIET); // had commente || ... DJD
1986 
1987  {
1988  if (level > 0 && aborthooksym->type_def != (def_type)function_it )
1989  {
1990  lev1=MAX_LEVEL<level?MAX_LEVEL:(level);
1991  lev2=level;
1992  }
1993  else
1994  {
1995  lev1 = 0;
1996  lev2 = 0;
1997  }
1998 
1999  pr=prompt_buffer;
2000  /* RM: Oct 13 1993 */
2002  *pr='\0';
2003  else
2004  strcpy(pr,current_module->module_name);
2005  pr += strlen(pr);
2006  for(i=1;i<=lev1;i++) { *pr='-'; pr++; *pr='-'; pr++; }
2007  if (lev2>0)
2008  sprintf(pr,"%ld",lev2);
2009  strcat(pr,PROMPT);
2010 
2012  }
2013 
2014  stdin_cleareof();
2015  /* The system waits for either an input command or an X event. */
2016  /* An X event is treated *exactly* like an input command that */
2017  /* has the same effect. */
2018 #ifdef X11
2019  c=x_read_stdin_or_event(&eventflag);
2020  if (eventflag) {
2021  /* Include eventflag info in var_occurred field. */
2022  push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)(FALSE+2*TRUE),(GENERIC)level /* +1 RM: Jun 22 1993 */);
2024  result=TRUE;
2025  }
2026  else
2027 #else
2028  c=read_char();
2029 #endif
2030  {
2031  while (c!=EOLN && c>0 && c<=32 && c!=EOF) {
2032  c=read_char();
2033  }
2034  if (c==EOF) {
2035  reset_stacks();
2036  }
2037  else if (c==EOLN) {
2038  cut_loc=TRUE;
2039  }
2040  else if (c==';' || c=='.') {
2041  do {
2042  c2=read_char();
2043  } while (c2!=EOLN && c2!=EOF && c2>0 && c2<=32);
2044  if (c=='.') { /* 6.10 */
2045  reset_stacks();
2046  result=TRUE;
2047  }
2048  }
2049  else {
2051 
2052  put_back_char(c);
2054  save_undo_stack=undo_stack;
2055  s=stack_copy_psi_term(parse(&sort));
2056 
2057  if (s->type==eof) {
2058  reset_stacks();
2059  put_back_char(EOF);
2060  } else if (sort==QUERY) {
2063  reset_step();
2064  result=TRUE;
2065  }
2066  else if (sort==FACT) { /* A declaration */
2067  push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)FALSE,(GENERIC)(level + 1)); /* 18.5 */ // HERE
2069  assert_clause(s);
2070  /* Variables in the query may be used in a declaration, */
2071  /* but the declaration may not add any variables. */
2072  undo(save_undo_stack); /* 17.8 */
2073  encode_types();
2074  result=TRUE;
2075  }
2076  else {
2077  /* Stay at same level on syntax error */
2078  push_goal(what_next,(ptr_psi_term)TRUE,(ptr_psi_term)FALSE,(GENERIC)(level+1)); /* 20.8 */
2079  result=TRUE; /* 20.8 */
2080  }
2081  }
2082  }
2083 
2084  if (cut_loc) result = what_next_cut() || result;
2085 
2086  end_terminal_io();
2087 
2088  var_occurred=FALSE;
2089  start_chrono();
2090 
2091  return result;
2092 }
void assert_clause(ptr_psi_term t)
Definition: login.c:267
#define prove
Definition: def_const.h:273
long what_next_cut()
Definition: login.c:1872
void reset_stacks()
Definition: login.c:1924
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)
Definition: token.c:633
void show_count()
Definition: login.c:1085
ptr_module current_module
Definition: def_glob.h:161
#define NOTQUIET
Definition: def_macro.h:10
psi_term parse(long *q)
Definition: parser.c:877
char prompt_buffer[PROMPT_BUFFER]
Definition: def_glob.h:237
#define TRUEMASK
Definition: def_const.h:129
void undo(ptr_stack limit)
Definition: login.c:646
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)
Definition: login.c:555
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)
Definition: lefun.c:414
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()
Definition: token.c:431
void infoline(char *format,...)
Definition: error.c:245
void begin_terminal_io()
Definition: token.c:410
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)
Definition: parser.c:183
void encode_types()
Definition: types.c:1015
void start_chrono()
Definition: login.c:330
char * prompt
Definition: def_glob.h:42
long print_variables(long printflag)
Definition: print.c:1272
long read_char()
Definition: token.c:587
long no_choices()
Definition: login.c:1838
ptr_definition type
Definition: def_struct.h:165
ptr_psi_term bbbb_1
Definition: def_struct.h:225
void stdin_cleareof()
Definition: token.c:42
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)
Definition: login.c:591
long what_next_cut ( )

Definition at line 1872 of file login.c.

References backtrack(), choice_stack, FALSE, goal_stack, NULL, TRUE, wl_goal::type, undo(), and what_next.

1873 {
1874  long flag=TRUE;
1875  long result=FALSE;
1876 
1877  do {
1878  if (choice_stack) {
1879  backtrack();
1880  if (goal_stack->type==what_next) {
1881  flag=FALSE;
1882  result=TRUE;
1883  }
1884  }
1885  else {
1886  /* This undo does the last undo actions before returning to top level. */
1887  /* It is not needed for variable undoing, but for actions (like */
1888  /* closing windows). */
1889  undo(NULL);
1890  /* undo(mem_base); 7.8 */
1891 #ifdef TS
1892  /* global_time_stamp=INIT_TIME_STAMP; */ /* 9.6 */
1893 #endif
1894  flag=FALSE;
1895  }
1896  } while (flag);
1897 
1898  return result;
1899 }
ptr_goal goal_stack
Definition: def_glob.h:50
void undo(ptr_stack limit)
Definition: login.c:646
#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()
Definition: login.c:724
ptr_choice_point choice_stack
Definition: def_glob.h:51
void work_out_length ( )

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

558 {
559  ptr_item i;
560  long done=FALSE;
561  long pos;
562  ptr_tab_brk worst,root;
563  long w;
564 
565  while(!done) {
566 
567  pos=0;
568  done=TRUE;
569 
570  w= -1;
571  worst=NULL;
572  root=NULL;
573 
574  for(i=pretty_things+1;(unsigned long)i<(unsigned long)indx;i++) {
575 
576  if(i->tab->broken && i->tab->printed) {
577  pos=i->tab->column;
578  root=NULL;
579  }
580 
581  if(!i->tab->printed) i->tab->column=pos;
582 
583  if(!(i->tab->broken))
584  if(!root || (root && (root->column)>=(i->tab->column)))
585  root=i->tab;
586 
587  /* pos=pos+strlen(i->str); */
588  pos=strpos(pos,i->str);
589  i->tab->printed=TRUE;
590 
591  if(pos>page_width)
592  done=FALSE;
593 
594  if(pos>w) {
595  w=pos;
596  worst=root;
597  }
598  }
599 
600  for(i=pretty_things+1;(unsigned long)i<(unsigned long)indx;i++)
601  i->tab->printed=FALSE;
602 
603  if(!done)
604  if(worst)
605  worst->broken=TRUE;
606  else
607  done=TRUE;
608  }
609 }
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 
)

Definition at line 1321 of file print.c.

References mark_tab(), MAX_PRECEDENCE, and pretty_tag_or_psi_term().

1324 {
1325  if(n) {
1326  write_attributes(n->left,tab);
1327  mark_tab(tab);
1329  write_attributes(n->right,tab);
1330  }
1331 }
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 ( )

Definition at line 44 of file types.c.

References EOLN, input_state, open_input_file(), perr(), prompt, read_char(), and restore_state().

45 {
46  char *old_prompt;
47  long c,d;
48  ptr_psi_term old_state_loc;
49 
50  perr("*** Are you really sure you want to do that ");
51  old_prompt=prompt;
52  prompt="(y/n)?";
53  old_state_loc=input_state;
54  (void)open_input_file("stdin");
55 
56  do {
57  do {
58  c=read_char();
59  } while (c!=EOLN && c>0 && c<=32);
60  } while (c!='y' && c!='n');
61 
62  d=c;
63  while (d!=EOLN && d!=EOF) d=read_char();
64 
65  prompt=old_prompt;
66  input_state=old_state_loc;
67  restore_state(old_state_loc);
68  return (c=='y');
69 }
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)
Definition: token.c:267
char * prompt
Definition: def_glob.h:42
long read_char()
Definition: token.c:587
long open_input_file(char *file)
Definition: token.c:504