diff options
author | Marius Vollmer <mvo@zagadka.de> | 2004-07-27 15:41:49 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2004-07-27 15:41:49 +0000 |
commit | bc36d0502b9b2ac7e43ded2e1fbeed2f1499bb1d (patch) | |
tree | dafd9e49525c8b5e1ccee4f39b5b720522a93dc3 | |
parent | c82f8ed66ca55da796cb6289f380aaed2e5e34bb (diff) |
* tags.h, deprecated.h (SCM_EQ_P): Deprecated by moving it into
deprecated.h. Replaced all uses with scm_is_eq.
39 files changed, 201 insertions, 200 deletions
diff --git a/libguile/alist.c b/libguile/alist.c index b876ae59d..9a1f4d090 100644 --- a/libguile/alist.c +++ b/libguile/alist.c @@ -52,7 +52,7 @@ SCM_DEFINE (scm_sloppy_assq, "sloppy-assq", 2, 0, 0, for (; SCM_CONSP (alist); alist = SCM_CDR (alist)) { SCM tmp = SCM_CAR (alist); - if (SCM_CONSP (tmp) && SCM_EQ_P (SCM_CAR (tmp), key)) + if (SCM_CONSP (tmp) && scm_is_eq (SCM_CAR (tmp), key)) return tmp; } return SCM_BOOL_F; @@ -118,7 +118,7 @@ SCM_DEFINE (scm_assq, "assq", 2, 0, 0, SCM tmp = SCM_CAR (ls); SCM_ASSERT_TYPE (SCM_CONSP (tmp), alist, SCM_ARG2, FUNC_NAME, "association list"); - if (SCM_EQ_P (SCM_CAR (tmp), key)) + if (scm_is_eq (SCM_CAR (tmp), key)) return tmp; } SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 591108d14..3f6efac2f 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -228,7 +228,7 @@ display_error_body (struct display_error_args *a) if (!SCM_MEMOIZEDP (source) && scm_is_true (prev_frame)) source = SCM_FRAME_SOURCE (prev_frame); if (!SCM_SYMBOLP (pname) && !SCM_STRINGP (pname) && SCM_FRAME_PROC_P (current_frame) - && SCM_EQ_P (scm_procedure_p (SCM_FRAME_PROC (current_frame)), SCM_BOOL_T)) + && scm_is_true (scm_procedure_p (SCM_FRAME_PROC (current_frame)))) pname = scm_procedure_name (SCM_FRAME_PROC (current_frame)); } if (SCM_SYMBOLP (pname) || SCM_STRINGP (pname) || SCM_MEMOIZEDP (source)) @@ -490,7 +490,7 @@ display_backtrace_file (frame, last_file, port, pstate) display_backtrace_get_file_line (frame, &file, &line); - if (SCM_EQ_P (file, *last_file)) + if (scm_is_eq (file, *last_file)) return; *last_file = file; @@ -517,7 +517,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate) display_backtrace_get_file_line (frame, &file, &line); - if (SCM_EQ_P (SCM_PACK (SCM_SHOW_FILE_NAME), sym_base)) + if (scm_is_eq (SCM_PACK (SCM_SHOW_FILE_NAME), sym_base)) { if (scm_is_false (file)) { @@ -718,7 +718,7 @@ display_backtrace_body (struct display_backtrace_args *a) last_file = SCM_UNDEFINED; for (i = 0; i < n; ++i) { - if (!SCM_EQ_P (SCM_PACK (SCM_SHOW_FILE_NAME), sym_base)) + if (!scm_is_eq (SCM_PACK (SCM_SHOW_FILE_NAME), sym_base)) display_backtrace_file (frame, &last_file, a->port, pstate); display_frame (frame, nfield, indentation, sport, a->port, pstate); diff --git a/libguile/chars.c b/libguile/chars.c index ea44ccfdc..d205cf6e4 100644 --- a/libguile/chars.c +++ b/libguile/chars.c @@ -42,7 +42,7 @@ SCM_DEFINE1 (scm_char_eq_p, "char=?", scm_tc7_rpsubr, { SCM_VALIDATE_CHAR (1, x); SCM_VALIDATE_CHAR (2, y); - return scm_from_bool (SCM_EQ_P (x, y)); + return scm_from_bool (scm_is_eq (x, y)); } #undef FUNC_NAME diff --git a/libguile/debug.c b/libguile/debug.c index 52e507ae6..0f4734e82 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -428,12 +428,12 @@ scm_reverse_lookup (SCM env, SCM data) SCM values = SCM_CDAR (env); while (SCM_CONSP (names)) { - if (SCM_EQ_P (SCM_CAR (values), data)) + if (scm_is_eq (SCM_CAR (values), data)) return SCM_CAR (names); names = SCM_CDR (names); values = SCM_CDR (values); } - if (!SCM_NULLP (names) && SCM_EQ_P (values, data)) + if (!SCM_NULLP (names) && scm_is_eq (values, data)) return names; env = SCM_CDR (env); } diff --git a/libguile/deprecated.c b/libguile/deprecated.c index eb1150456..32286146d 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -271,7 +271,7 @@ static SCM scm_module_full_name (SCM name) { init_module_stuff (); - if (SCM_EQ_P (SCM_CAR (name), scm_sym_app)) + if (scm_is_eq (SCM_CAR (name), scm_sym_app)) return name; else return scm_append (scm_list_2 (module_prefix, name)); @@ -320,7 +320,7 @@ maybe_close_port (void *data, SCM port) while (!SCM_NULLP (except)) { SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except)); - if (SCM_EQ_P (p, port)) + if (scm_is_eq (p, port)) return; except = SCM_CDR (except); } @@ -447,7 +447,7 @@ SCM_DEFINE (scm_sloppy_memq, "sloppy-memq", 2, 0, 0, for(; SCM_CONSP (lst); lst = SCM_CDR(lst)) { - if (SCM_EQ_P (SCM_CAR (lst), x)) + if (scm_is_eq (SCM_CAR (lst), x)) return lst; } return lst; @@ -691,7 +691,7 @@ scm_sym2ovcell_soft (SCM sym, SCM obarray) lsym = SCM_CDR (lsym)) { z = SCM_CAR (lsym); - if (SCM_EQ_P (SCM_CAR (z), sym)) + if (scm_is_eq (SCM_CAR (z), sym)) { SCM_REALLOW_INTS; return z; @@ -766,7 +766,7 @@ scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int so { SCM a = SCM_CAR (lsym); SCM z = SCM_CAR (a); - if (SCM_EQ_P (z, symbol)) + if (scm_is_eq (z, symbol)) return a; } @@ -838,7 +838,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0, /* nothing interesting to do here. */ return scm_string_to_symbol (s); } - else if (SCM_EQ_P (o, SCM_BOOL_T)) + else if (scm_is_eq (o, SCM_BOOL_T)) o = SCM_BOOL_F; vcell = scm_intern_obarray_soft (SCM_STRING_CHARS(s), @@ -879,7 +879,7 @@ SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0, lsym = SCM_CDR (lsym)) { sym = SCM_CAR (lsym); - if (SCM_EQ_P (SCM_CAR (sym), s)) + if (scm_is_eq (SCM_CAR (sym), s)) { SCM_REALLOW_INTS; return SCM_UNSPECIFIED; @@ -921,7 +921,7 @@ SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0, lsym_follow = lsym, lsym = SCM_CDR (lsym)) { sym = SCM_CAR (lsym); - if (SCM_EQ_P (SCM_CAR (sym), s)) + if (scm_is_eq (SCM_CAR (sym), s)) { /* Found the symbol to unintern. */ if (scm_is_false (lsym_follow)) diff --git a/libguile/dynwind.c b/libguile/dynwind.c index ff46c1720..e8059be27 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -271,7 +271,7 @@ void scm_i_dowinds (SCM to, long delta, void (*turn_func) (void *), void *data) { tail: - if (SCM_EQ_P (to, scm_dynwinds)) + if (scm_is_eq (to, scm_dynwinds)) { if (turn_func) turn_func (data); diff --git a/libguile/environments.c b/libguile/environments.c index 70e7dbc0a..6ad9d51d2 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -203,7 +203,7 @@ SCM_DEFINE (scm_environment_fold, "environment-fold", 3, 0, 0, #define FUNC_NAME s_scm_environment_fold { SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); - SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T), + SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, SCM_ARG2, FUNC_NAME); return SCM_ENVIRONMENT_FOLD (env, environment_default_folder, proc, init); @@ -244,9 +244,9 @@ SCM_DEFINE (scm_environment_define, "environment-define", 3, 0, 0, status = SCM_ENVIRONMENT_DEFINE (env, sym, val); - if (SCM_EQ_P (status, SCM_ENVIRONMENT_SUCCESS)) + if (scm_is_eq (status, SCM_ENVIRONMENT_SUCCESS)) return SCM_UNSPECIFIED; - else if (SCM_EQ_P (status, SCM_ENVIRONMENT_BINDING_IMMUTABLE)) + else if (scm_is_eq (status, SCM_ENVIRONMENT_BINDING_IMMUTABLE)) scm_error_environment_immutable_binding (FUNC_NAME, env, sym); else abort(); @@ -270,9 +270,9 @@ SCM_DEFINE (scm_environment_undefine, "environment-undefine", 2, 0, 0, status = SCM_ENVIRONMENT_UNDEFINE (env, sym); - if (SCM_EQ_P (status, SCM_ENVIRONMENT_SUCCESS)) + if (scm_is_eq (status, SCM_ENVIRONMENT_SUCCESS)) return SCM_UNSPECIFIED; - else if (SCM_EQ_P (status, SCM_ENVIRONMENT_BINDING_IMMUTABLE)) + else if (scm_is_eq (status, SCM_ENVIRONMENT_BINDING_IMMUTABLE)) scm_error_environment_immutable_binding (FUNC_NAME, env, sym); else abort(); @@ -298,11 +298,11 @@ SCM_DEFINE (scm_environment_set_x, "environment-set!", 3, 0, 0, status = SCM_ENVIRONMENT_SET (env, sym, val); - if (SCM_EQ_P (status, SCM_ENVIRONMENT_SUCCESS)) + if (scm_is_eq (status, SCM_ENVIRONMENT_SUCCESS)) return SCM_UNSPECIFIED; else if (SCM_UNBNDP (status)) scm_error_environment_unbound (FUNC_NAME, env, sym); - else if (SCM_EQ_P (status, SCM_ENVIRONMENT_LOCATION_IMMUTABLE)) + else if (scm_is_eq (status, SCM_ENVIRONMENT_LOCATION_IMMUTABLE)) scm_error_environment_immutable_binding (FUNC_NAME, env, sym); else abort(); @@ -337,7 +337,7 @@ SCM_DEFINE (scm_environment_cell, "environment-cell", 3, 0, 0, return location; else if (SCM_UNBNDP (location)) scm_error_environment_unbound (FUNC_NAME, env, sym); - else if (SCM_EQ_P (location, SCM_ENVIRONMENT_LOCATION_IMMUTABLE)) + else if (scm_is_eq (location, SCM_ENVIRONMENT_LOCATION_IMMUTABLE)) scm_error_environment_immutable_location (FUNC_NAME, env, sym); else /* no cell */ return location; @@ -535,7 +535,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data) lsym = SCM_CDR (lsym)) { SCM old_entry = SCM_CAR (lsym); - if (SCM_EQ_P (SCM_CAR (old_entry), symbol)) + if (scm_is_eq (SCM_CAR (old_entry), symbol)) { SCM_SETCAR (lsym, new_entry); return old_entry; @@ -565,7 +565,7 @@ obarray_retrieve (SCM obarray, SCM sym) lsym = SCM_CDR (lsym)) { SCM entry = SCM_CAR (lsym); - if (SCM_EQ_P (SCM_CAR (entry), sym)) + if (scm_is_eq (SCM_CAR (entry), sym)) return entry; } @@ -682,7 +682,7 @@ core_environments_unobserve (SCM env, SCM observer) ? SCM_CDAR (l) : SCM_CAR (l); - if (SCM_EQ_P (first, observer)) + if (scm_is_eq (first, observer)) { /* Remove the first observer */ handling_weaks @@ -700,7 +700,7 @@ core_environments_unobserve (SCM env, SCM observer) ? SCM_CDAR (l) : SCM_CAR (l); - if (SCM_EQ_P (next, observer)) + if (scm_is_eq (next, observer)) { SCM_SETCDR (l, SCM_CDR (rest)); return; @@ -1124,10 +1124,10 @@ eval_environment_lookup (SCM env, SCM sym, int for_write) return location; mutability = CACHED_MUTABILITY (entry); - if (SCM_EQ_P (mutability, MUTABLE)) + if (scm_is_eq (mutability, MUTABLE)) return location; - if (SCM_EQ_P (mutability, UNKNOWN)) + if (scm_is_eq (mutability, UNKNOWN)) { SCM source_env = CACHED_SOURCE_ENVIRONMENT (entry); SCM location = SCM_ENVIRONMENT_CELL (source_env, sym, 1); @@ -1179,7 +1179,7 @@ eval_environment_lookup (SCM env, SCM sym, int for_write) obarray_enter (obarray, sym, entry); return location; } - else if (SCM_EQ_P (location, SCM_ENVIRONMENT_LOCATION_NO_CELL)) + else if (scm_is_eq (location, SCM_ENVIRONMENT_LOCATION_NO_CELL)) { obarray_enter (obarray, sym, source_env); return source_env; @@ -1281,7 +1281,7 @@ eval_environment_set_x (SCM env, SCM sym, SCM val) { return SCM_ENVIRONMENT_SET (location, sym, val); } - else if (SCM_EQ_P (location, IMMUTABLE)) + else if (scm_is_eq (location, IMMUTABLE)) { return SCM_ENVIRONMENT_LOCATION_IMMUTABLE; } @@ -1303,7 +1303,7 @@ eval_environment_cell (SCM env, SCM sym, int for_write) return location; else if (SCM_ENVIRONMENT_P (location)) return SCM_ENVIRONMENT_LOCATION_NO_CELL; - else if (SCM_EQ_P (location, IMMUTABLE)) + else if (scm_is_eq (location, IMMUTABLE)) return SCM_ENVIRONMENT_LOCATION_IMMUTABLE; else return SCM_UNDEFINED; @@ -1629,7 +1629,7 @@ import_environment_folder (SCM extended_data, SCM symbol, SCM value, SCM tail) scm_environment_folder proc = (scm_environment_folder) proc_as_ul; SCM data = SCM_CDDDR (extended_data); - if (SCM_CONSP (owner) && SCM_EQ_P (SCM_CAR (owner), imported_env)) + if (SCM_CONSP (owner) && scm_is_eq (SCM_CAR (owner), imported_env)) owner = import_environment_conflict (import_env, symbol, owner); if (SCM_ENVIRONMENT_P (owner)) @@ -2005,7 +2005,7 @@ export_environment_set_x (SCM env, SCM sym, SCM val) } else { - if (SCM_EQ_P (SCM_CADR (entry), symbol_mutable_location)) + if (scm_is_eq (SCM_CADR (entry), symbol_mutable_location)) return SCM_ENVIRONMENT_SET (body->private, sym, val); else return SCM_ENVIRONMENT_LOCATION_IMMUTABLE; @@ -2027,7 +2027,7 @@ export_environment_cell (SCM env, SCM sym, int for_write) } else { - if (!for_write || SCM_EQ_P (SCM_CADR (entry), symbol_mutable_location)) + if (!for_write || scm_is_eq (SCM_CADR (entry), symbol_mutable_location)) return SCM_ENVIRONMENT_CELL (body->private, sym, for_write); else return SCM_ENVIRONMENT_LOCATION_IMMUTABLE; @@ -2260,9 +2260,9 @@ export_environment_parse_signature (SCM signature, const char* caller) for (l2 = SCM_CDR (entry); SCM_CONSP (l2); l2 = SCM_CDR (l2)) { SCM attribute = SCM_CAR (l2); - if (SCM_EQ_P (attribute, symbol_immutable_location)) + if (scm_is_eq (attribute, symbol_immutable_location)) immutable = 1; - else if (SCM_EQ_P (attribute, symbol_mutable_location)) + else if (scm_is_eq (attribute, symbol_mutable_location)) mutable = 1; else SCM_ASSERT (0, entry, SCM_ARGn, caller); diff --git a/libguile/eq.c b/libguile/eq.c index 7f368ed1a..fa9dcdebc 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -47,7 +47,7 @@ SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr, "@code{eqv?}.") #define FUNC_NAME s_scm_eq_p { - return scm_from_bool (SCM_EQ_P (x, y)); + return scm_from_bool (scm_is_eq (x, y)); } #undef FUNC_NAME @@ -71,7 +71,7 @@ SCM_PRIMITIVE_GENERIC_1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, "and inexact numbers.") #define FUNC_NAME s_scm_eqv_p { - if (SCM_EQ_P (x, y)) + if (scm_is_eq (x, y)) return SCM_BOOL_T; if (SCM_IMP (x)) return SCM_BOOL_F; @@ -141,7 +141,7 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr, SCM_CHECK_STACK; tailrecurse: SCM_TICK; - if (SCM_EQ_P (x, y)) + if (scm_is_eq (x, y)) return SCM_BOOL_T; if (SCM_IMP (x)) return SCM_BOOL_F; diff --git a/libguile/eval.c b/libguile/eval.c index 8f7d89540..e8c27e952 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -479,11 +479,11 @@ lookup_symbol (const SCM symbol, const SCM env) SCM_CONSP (symbol_idx); symbol_idx = SCM_CDR (symbol_idx), ++symbol_nr) { - if (SCM_EQ_P (SCM_CAR (symbol_idx), symbol)) + if (scm_is_eq (SCM_CAR (symbol_idx), symbol)) /* found the symbol, therefore return the iloc */ return SCM_MAKE_ILOC (frame_nr, symbol_nr, 0); } - if (SCM_EQ_P (symbol_idx, symbol)) + if (scm_is_eq (symbol_idx, symbol)) /* found the symbol as the last element of the current frame */ return SCM_MAKE_ILOC (frame_nr, symbol_nr, 1); } @@ -709,7 +709,7 @@ is_system_macro_p (const SCM syntactic_keyword, const SCM form, const SCM env) if (SCM_BUILTIN_MACRO_P (value)) { const SCM macro_name = scm_macro_name (value); - return SCM_EQ_P (macro_name, syntactic_keyword); + return scm_is_eq (macro_name, syntactic_keyword); } } @@ -980,14 +980,14 @@ scm_m_case (SCM expr, SCM env) } else { - ASSERT_SYNTAX_2 (SCM_EQ_P (labels, scm_sym_else) && else_literal_p, + ASSERT_SYNTAX_2 (scm_is_eq (labels, scm_sym_else) && else_literal_p, s_bad_case_labels, labels, expr); ASSERT_SYNTAX_2 (SCM_NULLP (SCM_CDR (clauses)), s_misplaced_else_clause, clause, expr); } /* build the new clause */ - if (SCM_EQ_P (labels, scm_sym_else)) + if (scm_is_eq (labels, scm_sym_else)) SCM_SETCAR (clause, SCM_IM_ELSE); clauses = SCM_CDR (clauses); @@ -1021,7 +1021,7 @@ unmemoize_case (const SCM expr, const SCM env) const SCM exprs = SCM_CDR (clause); const SCM um_exprs = unmemoize_exprs (exprs, env); - const SCM um_labels = (SCM_EQ_P (labels, SCM_IM_ELSE)) + const SCM um_labels = (scm_is_eq (labels, SCM_IM_ELSE)) ? scm_sym_else : scm_i_finite_list_copy (labels); const SCM um_clause = scm_cons (um_labels, um_exprs); @@ -1062,7 +1062,7 @@ scm_m_cond (SCM expr, SCM env) ASSERT_SYNTAX_2 (length >= 1, s_bad_cond_clause, clause, expr); test = SCM_CAR (clause); - if (SCM_EQ_P (test, scm_sym_else) && else_literal_p) + if (scm_is_eq (test, scm_sym_else) && else_literal_p) { const int last_clause_p = SCM_NULLP (SCM_CDR (clause_idx)); ASSERT_SYNTAX_2 (length >= 2, @@ -1072,7 +1072,7 @@ scm_m_cond (SCM expr, SCM env) SCM_SETCAR (clause, SCM_IM_ELSE); } else if (length >= 2 - && SCM_EQ_P (SCM_CADR (clause), scm_sym_arrow) + && scm_is_eq (SCM_CADR (clause), scm_sym_arrow) && arrow_literal_p) { ASSERT_SYNTAX_2 (length > 2, s_missing_recipient, clause, expr); @@ -1102,12 +1102,13 @@ unmemoize_cond (const SCM expr, const SCM env) SCM um_sequence; SCM um_clause; - if (SCM_EQ_P (test, SCM_IM_ELSE)) + if (scm_is_eq (test, SCM_IM_ELSE)) um_test = scm_sym_else; else um_test = unmemoize_expression (test, env); - if (!SCM_NULLP (sequence) && SCM_EQ_P (SCM_CAR (sequence), SCM_IM_ARROW)) + if (!SCM_NULLP (sequence) && scm_is_eq (SCM_CAR (sequence), + SCM_IM_ARROW)) { const SCM target = SCM_CADR (sequence); const SCM um_target = unmemoize_expression (target, env); @@ -1361,7 +1362,7 @@ unmemoize_do (const SCM expr, const SCM env) const SCM name = SCM_CAR (um_names); const SCM init = SCM_CAR (um_inits); SCM step = SCM_CAR (um_steps); - step = SCM_EQ_P (step, name) ? SCM_EOL : scm_list_1 (step); + step = scm_is_eq (step, name) ? SCM_EOL : scm_list_1 (step); um_bindings = scm_cons (scm_cons2 (name, init, step), um_bindings); @@ -1423,10 +1424,10 @@ c_improper_memq (SCM obj, SCM list) { for (; SCM_CONSP (list); list = SCM_CDR (list)) { - if (SCM_EQ_P (SCM_CAR (list), obj)) + if (scm_is_eq (SCM_CAR (list), obj)) return 1; } - return SCM_EQ_P (list, obj); + return scm_is_eq (list, obj); } SCM @@ -1839,13 +1840,13 @@ iqq (SCM form, SCM env, unsigned long int depth) if (SCM_CONSP (form)) { const SCM tmp = SCM_CAR (form); - if (SCM_EQ_P (tmp, scm_sym_quasiquote)) + if (scm_is_eq (tmp, scm_sym_quasiquote)) { const SCM args = SCM_CDR (form); ASSERT_SYNTAX (scm_ilength (args) == 1, s_expression, form); return scm_list_2 (tmp, iqq (SCM_CAR (args), env, depth + 1)); } - else if (SCM_EQ_P (tmp, scm_sym_unquote)) + else if (scm_is_eq (tmp, scm_sym_unquote)) { const SCM args = SCM_CDR (form); ASSERT_SYNTAX (scm_ilength (args) == 1, s_expression, form); @@ -1855,7 +1856,7 @@ iqq (SCM form, SCM env, unsigned long int depth) return scm_list_2 (tmp, iqq (SCM_CAR (args), env, depth - 1)); } else if (SCM_CONSP (tmp) - && SCM_EQ_P (SCM_CAR (tmp), scm_sym_uq_splicing)) + && scm_is_eq (SCM_CAR (tmp), scm_sym_uq_splicing)) { const SCM args = SCM_CDR (tmp); ASSERT_SYNTAX (scm_ilength (args) == 1, s_expression, form); @@ -2134,7 +2135,7 @@ scm_m_generalized_set_x (SCM expr, SCM env) variable and we memoize to (set! <atom> ...). */ exp_target = macroexp (target, env); - if (SCM_EQ_P (SCM_CAR (exp_target), SCM_IM_BEGIN) + if (scm_is_eq (SCM_CAR (exp_target), SCM_IM_BEGIN) && !SCM_NULLP (SCM_CDR (exp_target)) && SCM_NULLP (SCM_CDDR (exp_target))) { @@ -2592,7 +2593,7 @@ static SCM deval (SCM x, SCM env); #define SCM_EVALIM2(x) \ - ((SCM_EQ_P ((x), SCM_EOL) \ + ((scm_is_eq ((x), SCM_EOL) \ ? syntax_error (s_empty_combination, (x), SCM_UNDEFINED), 0 \ : 0), \ (x)) @@ -2776,9 +2777,9 @@ scm_lookupcar1 (SCM vloc, SCM genv, int check) { if (!SCM_CONSP (fl)) { - if (SCM_EQ_P (fl, var)) + if (scm_is_eq (fl, var)) { - if (! SCM_EQ_P (SCM_CAR (vloc), var)) + if (!scm_is_eq (SCM_CAR (vloc), var)) goto race; SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (iloc) + SCM_ICDR); return SCM_CDRLOC (*al); @@ -2787,14 +2788,14 @@ scm_lookupcar1 (SCM vloc, SCM genv, int check) break; } al = SCM_CDRLOC (*al); - if (SCM_EQ_P (SCM_CAR (fl), var)) + if (scm_is_eq (SCM_CAR (fl), var)) { if (SCM_UNBNDP (SCM_CAR (*al))) { env = SCM_EOL; goto errout; } - if (!SCM_EQ_P (SCM_CAR (vloc), var)) + if (!scm_is_eq (SCM_CAR (vloc), var)) goto race; SCM_SETCAR (vloc, iloc); return SCM_CARLOC (*al); @@ -2837,7 +2838,7 @@ scm_lookupcar1 (SCM vloc, SCM genv, int check) } } - if (!SCM_EQ_P (SCM_CAR (vloc), var)) + if (!scm_is_eq (SCM_CAR (vloc), var)) { /* Some other thread has changed the very cell we are working on. In effect, it must have done our job or messed it up @@ -3137,7 +3138,7 @@ deval_args (SCM l, SCM env, SCM proc, SCM *lloc) #define SCM_VALIDATE_NON_EMPTY_COMBINATION(x) \ - ASSERT_SYNTAX (!SCM_EQ_P ((x), SCM_EOL), s_empty_combination, x) + ASSERT_SYNTAX (!scm_is_eq ((x), SCM_EOL), s_empty_combination, x) /* This is the evaluator. Like any real monster, it has three heads: @@ -3360,7 +3361,7 @@ dispatch: { const SCM clause = SCM_CAR (x); SCM labels = SCM_CAR (clause); - if (SCM_EQ_P (labels, SCM_IM_ELSE)) + if (scm_is_eq (labels, SCM_IM_ELSE)) { x = SCM_CDR (clause); PREP_APPLY (SCM_UNDEFINED, SCM_EOL); @@ -3369,7 +3370,7 @@ dispatch: while (!SCM_NULLP (labels)) { const SCM label = SCM_CAR (labels); - if (SCM_EQ_P (label, key) + if (scm_is_eq (label, key) || scm_is_true (scm_eqv_p (label, key))) { x = SCM_CDR (clause); @@ -3389,7 +3390,7 @@ dispatch: while (!SCM_NULLP (x)) { const SCM clause = SCM_CAR (x); - if (SCM_EQ_P (SCM_CAR (clause), SCM_IM_ELSE)) + if (scm_is_eq (SCM_CAR (clause), SCM_IM_ELSE)) { x = SCM_CDR (clause); PREP_APPLY (SCM_UNDEFINED, SCM_EOL); @@ -3403,7 +3404,7 @@ dispatch: x = SCM_CDR (clause); if (SCM_NULLP (x)) RETURN (arg1); - else if (!SCM_EQ_P (SCM_CAR (x), SCM_IM_ARROW)) + else if (!scm_is_eq (SCM_CAR (x), SCM_IM_ARROW)) { PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto begin; @@ -3800,7 +3801,7 @@ dispatch: { /* More arguments than specifiers => CLASS != ENV */ SCM class_of_arg = scm_class_of (SCM_CAR (args)); - if (!SCM_EQ_P (class_of_arg, SCM_CAR (z))) + if (!scm_is_eq (class_of_arg, SCM_CAR (z))) goto next_method; args = SCM_CDR (args); z = SCM_CDR (z); @@ -3858,7 +3859,7 @@ dispatch: if (!(scm_is_false (test_result) || SCM_NULL_OR_NIL_P (test_result))) { - if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED)) + if (scm_is_eq (SCM_CAR (x), SCM_UNSPECIFIED)) RETURN (test_result); PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto carloop; @@ -3979,8 +3980,8 @@ dispatch: if (!SCM_CONSP (arg1)) arg1 = scm_list_2 (SCM_IM_BEGIN, arg1); - assert (!SCM_EQ_P (x, SCM_CAR (arg1)) - && !SCM_EQ_P (x, SCM_CDR (arg1))); + assert (!scm_is_eq (x, SCM_CAR (arg1)) + && !scm_is_eq (x, SCM_CDR (arg1))); #ifdef DEVAL if (!SCM_CLOSUREP (SCM_MACRO_CODE (proc))) @@ -5711,7 +5712,7 @@ copy_tree ( { tortoise_delay = 1; tortoise = tortoise->trace; - ASSERT_SYNTAX (!SCM_EQ_P (hare->obj, tortoise->obj), + ASSERT_SYNTAX (!scm_is_eq (hare->obj, tortoise->obj), s_bad_expression, hare->obj); } else @@ -5775,7 +5776,7 @@ copy_tree ( rabbit = SCM_CDR (rabbit); turtle = SCM_CDR (turtle); - ASSERT_SYNTAX (!SCM_EQ_P (rabbit, turtle), + ASSERT_SYNTAX (!scm_is_eq (rabbit, turtle), s_bad_expression, rabbit); } } diff --git a/libguile/evalext.c b/libguile/evalext.c index c6e6dea76..a18d965b6 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -56,12 +56,12 @@ SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0, { if (!SCM_CONSP (b)) { - if (SCM_EQ_P (b, sym)) + if (scm_is_eq (b, sym)) return SCM_BOOL_T; else break; } - if (SCM_EQ_P (SCM_CAR (b), sym)) + if (scm_is_eq (SCM_CAR (b), sym)) return SCM_BOOL_T; } } diff --git a/libguile/gc.c b/libguile/gc.c index 21657dc24..d87e88d2f 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -185,7 +185,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, { scm_debug_cell_accesses_p = 0; } - else if (SCM_EQ_P (flag, SCM_BOOL_T)) + else if (scm_is_eq (flag, SCM_BOOL_T)) { scm_debug_cells_gc_interval = 0; scm_debug_cell_accesses_p = 1; @@ -746,7 +746,7 @@ scm_gc_unprotect_object (SCM obj) else { SCM count = scm_difference (SCM_CDR (handle), scm_from_int (1)); - if (SCM_EQ_P (count, scm_from_int (0))) + if (scm_is_eq (count, scm_from_int (0))) scm_hashq_remove_x (scm_protects, obj); else SCM_SETCDR (handle, count); @@ -793,7 +793,7 @@ scm_gc_unregister_root (SCM *p) else { SCM count = scm_difference (SCM_CDR (handle), scm_from_int (1)); - if (SCM_EQ_P (count, scm_from_int (0))) + if (scm_is_eq (count, scm_from_int (0))) scm_hashv_remove_x (scm_gc_registered_roots, key); else SCM_SETCDR (handle, count); diff --git a/libguile/goops.c b/libguile/goops.c index bf6c03a51..cc4c98e04 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -335,7 +335,7 @@ scm_i_get_keyword (SCM key, SCM l, long len, SCM default_value, const char *subr if (!SCM_KEYWORDP (obj)) scm_misc_error (subr, "bad keyword: ~S", scm_list_1 (obj)); - else if (SCM_EQ_P (obj, key)) + else if (scm_is_eq (obj, key)) return SCM_CADR (l); else l = SCM_CDDR (l); @@ -1212,7 +1212,7 @@ test_slot_existence (SCM class SCM_UNUSED, SCM obj, SCM slot_name) register SCM l; for (l = SCM_ACCESSORS_OF (obj); !SCM_NULLP (l); l = SCM_CDR (l)) - if (SCM_EQ_P (SCM_CAAR (l), slot_name)) + if (scm_is_eq (SCM_CAAR (l), slot_name)) return SCM_BOOL_T; return SCM_BOOL_F; diff --git a/libguile/guardians.c b/libguile/guardians.c index 706fbcb47..a28657aab 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -57,7 +57,7 @@ typedef struct t_tconc SCM tail; } t_tconc; -#define TCONC_EMPTYP(tc) (SCM_EQ_P ((tc).head, (tc).tail)) +#define TCONC_EMPTYP(tc) (scm_is_eq ((tc).head, (tc).tail)) #define TCONC_IN(tc, obj, pair) \ do { \ @@ -417,7 +417,7 @@ mark_dependencies_in_tconc (t_tconc *tc) /* scan the list for unmarked objects, and mark their dependencies */ for (pair = tc->head, prev_ptr = &tc->head; - ! SCM_EQ_P (pair, tc->tail); + !scm_is_eq (pair, tc->tail); pair = next_pair) { SCM obj = SCM_CAR (pair); @@ -466,7 +466,7 @@ mark_and_zombify (t_guardian *g) SCM *prev_ptr = &g->live.head; SCM pair = g->live.head; - while (! SCM_EQ_P (pair, tconc_tail)) + while (!scm_is_eq (pair, tconc_tail)) { SCM next_pair = SCM_CDR (pair); diff --git a/libguile/lang.h b/libguile/lang.h index c22655699..bb2ce6235 100644 --- a/libguile/lang.h +++ b/libguile/lang.h @@ -28,7 +28,7 @@ #if SCM_ENABLE_ELISP -#define SCM_NILP(x) (SCM_EQ_P ((x), SCM_ELISP_NIL)) +#define SCM_NILP(x) (scm_is_eq ((x), SCM_ELISP_NIL)) SCM_API void scm_init_lang (void); diff --git a/libguile/list.c b/libguile/list.c index 18a0f70e7..26b774be1 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -181,7 +181,7 @@ scm_ilength(SCM sx) /* For every two steps the hare takes, the tortoise takes one. */ tortoise = SCM_CDR(tortoise); } - while (! SCM_EQ_P (hare, tortoise)); + while (!scm_is_eq (hare, tortoise)); /* If the tortoise ever catches the hare, then the list must contain a cycle. */ @@ -307,7 +307,7 @@ SCM_DEFINE (scm_last_pair, "last-pair", 1, 0, 0, hare = ahead; tortoise = SCM_CDR(tortoise); } - while (! SCM_EQ_P (hare, tortoise)); + while (!scm_is_eq (hare, tortoise)); SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst)); } #undef FUNC_NAME @@ -336,7 +336,7 @@ SCM_DEFINE (scm_reverse, "reverse", 1, 0, 0, hare = SCM_CDR (hare); tortoise = SCM_CDR (tortoise); } - while (! SCM_EQ_P (hare, tortoise)); + while (!scm_is_eq (hare, tortoise)); SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst)); } #undef FUNC_NAME @@ -567,7 +567,7 @@ scm_c_memq (SCM obj, SCM list) { for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR (list)) { - if (SCM_EQ_P (SCM_CAR (list), obj)) + if (scm_is_eq (SCM_CAR (list), obj)) return list; } return SCM_BOOL_F; @@ -653,7 +653,7 @@ SCM_DEFINE (scm_delq_x, "delq!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (SCM_EQ_P (SCM_CAR (walk), item)) + if (scm_is_eq (SCM_CAR (walk), item)) *prev = SCM_CDR (walk); else prev = SCM_CDRLOC (walk); @@ -770,7 +770,7 @@ SCM_DEFINE (scm_delq1_x, "delq1!", 2, 0, 0, SCM_CONSP (walk); walk = SCM_CDR (walk)) { - if (SCM_EQ_P (SCM_CAR (walk), item)) + if (scm_is_eq (SCM_CAR (walk), item)) { *prev = SCM_CDR (walk); break; diff --git a/libguile/load.c b/libguile/load.c index 74eaaca9b..00ec130a1 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -93,11 +93,11 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, { SCM hook = *scm_loc_load_hook; SCM_VALIDATE_STRING (1, filename); - if (scm_is_true (hook) && !SCM_EQ_P (scm_procedure_p (hook), SCM_BOOL_T)) + if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook))) SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f", SCM_EOL); - if (! scm_is_false (hook)) + if (!scm_is_false (hook)) scm_call_1 (hook, filename); { /* scope */ diff --git a/libguile/numbers.c b/libguile/numbers.c index a6e5c69e5..f57ed0805 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -331,9 +331,9 @@ scm_make_ratio (SCM numerator, SCM denominator) */ if (SCM_I_INUMP (denominator)) { - if (SCM_EQ_P (denominator, SCM_INUM0)) + if (scm_is_eq (denominator, SCM_INUM0)) scm_num_overflow ("make-ratio"); - if (SCM_EQ_P (denominator, SCM_I_MAKINUM(1))) + if (scm_is_eq (denominator, SCM_I_MAKINUM(1))) return numerator; } else @@ -358,7 +358,7 @@ scm_make_ratio (SCM numerator, SCM denominator) if (SCM_I_INUMP (numerator)) { long x = SCM_I_INUM (numerator); - if (SCM_EQ_P (numerator, SCM_INUM0)) + if (scm_is_eq (numerator, SCM_INUM0)) return SCM_INUM0; if (SCM_I_INUMP (denominator)) { @@ -391,7 +391,7 @@ scm_make_ratio (SCM numerator, SCM denominator) } else { - if (SCM_EQ_P (numerator, denominator)) + if (scm_is_eq (numerator, denominator)) return SCM_I_MAKINUM(1); if (mpz_divisible_p (SCM_I_BIG_MPZ (numerator), SCM_I_BIG_MPZ (denominator))) @@ -413,7 +413,7 @@ static void scm_i_fraction_reduce (SCM z) { SCM divisor; divisor = scm_gcd (SCM_FRACTION_NUMERATOR (z), SCM_FRACTION_DENOMINATOR (z)); - if (!(SCM_EQ_P (divisor, SCM_I_MAKINUM(1)))) + if (!(scm_is_eq (divisor, SCM_I_MAKINUM(1)))) { /* is this safe? */ SCM_FRACTION_SET_NUMERATOR (z, scm_divide (SCM_FRACTION_NUMERATOR (z), divisor)); @@ -1090,7 +1090,7 @@ scm_lcm (SCM n1, SCM n2) if (SCM_I_INUMP (n2)) { SCM d = scm_gcd (n1, n2); - if (SCM_EQ_P (d, SCM_INUM0)) + if (scm_is_eq (d, SCM_INUM0)) return d; else return scm_abs (scm_product (n1, scm_quotient (n2, d))); @@ -1580,7 +1580,7 @@ SCM_DEFINE (scm_modulo_expt, "modulo-expt", 3, 0, 0, mpz_init (k_tmp); mpz_init (m_tmp); - if (SCM_EQ_P (m, SCM_INUM0)) + if (scm_is_eq (m, SCM_INUM0)) { report_overflow = 1; goto cleanup; @@ -1667,9 +1667,9 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0, SCM acc = SCM_I_MAKINUM (1L); /* 0^0 == 1 according to R5RS */ - if (SCM_EQ_P (n, SCM_INUM0) || SCM_EQ_P (n, acc)) + if (scm_is_eq (n, SCM_INUM0) || scm_is_eq (n, acc)) return scm_is_false (scm_zero_p(k)) ? n : acc; - else if (SCM_EQ_P (n, SCM_I_MAKINUM (-1L))) + else if (scm_is_eq (n, SCM_I_MAKINUM (-1L))) return scm_is_false (scm_even_p (k)) ? n : acc; if (SCM_I_INUMP (k)) @@ -2690,7 +2690,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, /* When returning an inexact zero, make sure it is represented as a floating point value so that we can change its sign. */ - if (SCM_EQ_P (result, SCM_I_MAKINUM(0)) && *p_exactness == INEXACT) + if (scm_is_eq (result, SCM_I_MAKINUM(0)) && *p_exactness == INEXACT) result = scm_make_real (0.0); return result; @@ -3492,7 +3492,7 @@ SCM scm_zero_p (SCM z) { if (SCM_I_INUMP (z)) - return scm_from_bool (SCM_EQ_P (z, SCM_INUM0)); + return scm_from_bool (scm_is_eq (z, SCM_INUM0)); else if (SCM_BIGP (z)) return SCM_BOOL_F; else if (SCM_REALP (z)) diff --git a/libguile/objects.c b/libguile/objects.c index ca5c2c29f..519a7ecf5 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -278,7 +278,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args) do { /* More arguments than specifiers => CLASS != ENV */ - if (! SCM_EQ_P (scm_class_of (SCM_CAR (ls)), SCM_CAR (z))) + if (! scm_is_eq (scm_class_of (SCM_CAR (ls)), SCM_CAR (z))) goto next_method; ls = SCM_CDR (ls); z = SCM_CDR (z); @@ -452,7 +452,7 @@ SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0, unsigned long flags = 0; SCM_VALIDATE_STRUCT (1, metaclass); SCM_VALIDATE_STRING (2, layout); - if (SCM_EQ_P (metaclass, scm_metaclass_operator)) + if (scm_is_eq (metaclass, scm_metaclass_operator)) flags = SCM_CLASSF_OPERATOR; return scm_i_make_class_object (metaclass, layout, flags); } diff --git a/libguile/options.c b/libguile/options.c index 41cadc7b5..4c53611a3 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -178,7 +178,7 @@ change_option_setting (SCM args, scm_t_option options[], unsigned int n, const c for (i = 0; i != n && !found; ++i) { - if (SCM_EQ_P (name, SCM_PACK (options[i].name))) + if (scm_is_eq (name, SCM_PACK (options[i].name))) { switch (options[i].type) { diff --git a/libguile/pairs.h b/libguile/pairs.h index 1dd409cfc..c03495b3e 100644 --- a/libguile/pairs.h +++ b/libguile/pairs.h @@ -33,7 +33,7 @@ # define SCM_VALIDATE_PAIR(cell, expr) (expr) #endif -#define SCM_NULLP(x) (SCM_EQ_P ((x), SCM_EOL)) +#define SCM_NULLP(x) (scm_is_eq ((x), SCM_EOL)) #define SCM_NNULLP(x) (!SCM_NULLP (x)) #define SCM_CAR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_0 (x))) diff --git a/libguile/ports.h b/libguile/ports.h index 8dffade07..ee53d3773 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -117,7 +117,7 @@ SCM_API scm_t_mutex scm_i_port_table_mutex; -#define SCM_EOF_OBJECT_P(x) (SCM_EQ_P ((x), SCM_EOF_VAL)) +#define SCM_EOF_OBJECT_P(x) (scm_is_eq ((x), SCM_EOF_VAL)) /* PORT FLAGS * A set of flags characterizes a port. diff --git a/libguile/print.c b/libguile/print.c index e43462a51..a2fe9785f 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -112,7 +112,7 @@ do { \ do { \ register unsigned long i; \ for (i = 0; i < pstate->top; ++i) \ - if (SCM_EQ_P (pstate->ref_stack[i], (obj))) \ + if (scm_is_eq (pstate->ref_stack[i], (obj))) \ goto label; \ if (pstate->fancyp) \ { \ @@ -244,15 +244,15 @@ print_circref (SCM port, scm_print_state *pstate, SCM ref) while (i > 0) { if (!SCM_CONSP (pstate->ref_stack[i - 1]) - || !SCM_EQ_P (SCM_CDR (pstate->ref_stack[i - 1]), - pstate->ref_stack[i])) + || !scm_is_eq (SCM_CDR (pstate->ref_stack[i - 1]), + pstate->ref_stack[i])) break; --i; } self = i; } for (i = pstate->top - 1; 1; --i) - if (SCM_EQ_P (pstate->ref_stack[i], ref)) + if (scm_is_eq (pstate->ref_stack[i], ref)) break; scm_putc ('#', port); scm_intprint (i - self, 10, port); @@ -598,7 +598,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) case scm_tc7_cclo: { SCM proc = SCM_CCLO_SUBR (exp); - if (SCM_EQ_P (proc, scm_f_gsubr_apply)) + if (scm_is_eq (proc, scm_f_gsubr_apply)) { /* Print gsubrs as primitives */ SCM name = scm_procedure_name (exp); @@ -760,7 +760,7 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate) tortoise = exp; while (SCM_CONSP (hare)) { - if (SCM_EQ_P (hare, tortoise)) + if (scm_is_eq (hare, tortoise)) goto fancy_printing; hare = SCM_CDR (hare); if (!SCM_CONSP (hare)) @@ -776,7 +776,7 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate) register long i; for (i = floor; i >= 0; --i) - if (SCM_EQ_P (pstate->ref_stack[i], exp)) + if (scm_is_eq (pstate->ref_stack[i], exp)) goto circref; PUSH_REF (pstate, exp); scm_putc (' ', port); @@ -805,7 +805,7 @@ fancy_printing: register unsigned long i; for (i = 0; i < pstate->top; ++i) - if (SCM_EQ_P (pstate->ref_stack[i], exp)) + if (scm_is_eq (pstate->ref_stack[i], exp)) goto fancy_circref; if (pstate->fancyp) { @@ -916,7 +916,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, char *end; char *p; - if (SCM_EQ_P (destination, SCM_BOOL_T)) + if (scm_is_eq (destination, SCM_BOOL_T)) { destination = port = scm_cur_outp; } @@ -981,7 +981,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, } scm_lfwrite (start, p - start, port); - if (!SCM_EQ_P (args, SCM_EOL)) + if (!scm_is_eq (args, SCM_EOL)) SCM_MISC_ERROR ("FORMAT: ~A superfluous arguments", scm_list_1 (scm_length (args))); diff --git a/libguile/print.h b/libguile/print.h index b4e8292c4..6d9c47c31 100644 --- a/libguile/print.h +++ b/libguile/print.h @@ -35,8 +35,8 @@ SCM_API scm_t_option scm_print_opts[]; /* State information passed around during printing. */ #define SCM_PRINT_STATE_P(obj) (SCM_STRUCTP(obj) \ - && (SCM_EQ_P (SCM_STRUCT_VTABLE(obj), \ - scm_print_state_vtable))) + && (scm_is_eq (SCM_STRUCT_VTABLE(obj), \ + scm_print_state_vtable))) #define SCM_PRINT_STATE(obj) ((scm_print_state *) SCM_STRUCT_DATA (obj)) #define RESET_PRINT_STATE(pstate) \ diff --git a/libguile/procprop.c b/libguile/procprop.c index 1c6727e0f..d91c72904 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -85,7 +85,7 @@ scm_i_procedure_arity (SCM proc) return SCM_BOOL_F; } case scm_tc7_cclo: - if (SCM_EQ_P (SCM_CCLO_SUBR (proc), scm_f_gsubr_apply)) + if (scm_is_eq (SCM_CCLO_SUBR (proc), scm_f_gsubr_apply)) { int type = scm_to_int (SCM_GSUBR_TYPE (proc)); a += SCM_GSUBR_REQ (type); @@ -180,7 +180,7 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0, #define FUNC_NAME s_scm_procedure_property { SCM assoc; - if (SCM_EQ_P (k, scm_sym_arity)) + if (scm_is_eq (k, scm_sym_arity)) { SCM arity; SCM_ASSERT (scm_is_true (arity = scm_i_procedure_arity (p)), @@ -206,7 +206,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, if (!SCM_CLOSUREP (p)) p = scm_stand_in_scm_proc(p); SCM_VALIDATE_CLOSURE (1, p); - if (SCM_EQ_P (k, scm_sym_arity)) + if (scm_is_eq (k, scm_sym_arity)) SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL); assoc = scm_sloppy_assq (k, SCM_PROCPROPS (p)); if (SCM_NIMP (assoc)) diff --git a/libguile/procs.c b/libguile/procs.c index 42869182c..a03ef8bb3 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -249,7 +249,7 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0, #define FUNC_NAME s_scm_procedure_documentation { SCM code; - SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T), + SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, SCM_ARG1, FUNC_NAME); switch (SCM_TYP7 (proc)) { diff --git a/libguile/procs.h b/libguile/procs.h index ad9f6ae9c..d9621a8e4 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -77,7 +77,7 @@ typedef struct + scm_tc3_closure)) #define SCM_ENV(x) SCM_CELL_OBJECT_1 (x) #define SCM_SETENV(x, e) SCM_SET_CELL_OBJECT_1 ((x), (e)) -#define SCM_TOP_LEVEL(ENV) (SCM_NULLP (ENV) || (SCM_EQ_P (scm_procedure_p (SCM_CAR (ENV)), SCM_BOOL_T))) +#define SCM_TOP_LEVEL(ENV) (SCM_NULLP (ENV) || (scm_is_true (scm_procedure_p (SCM_CAR (ENV))))) /* Procedure-with-setter diff --git a/libguile/ramap.c b/libguile/ramap.c index 62b04d62c..b85a3ae67 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -495,7 +495,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) if ((base + n) % SCM_LONG_BIT) /* trailing partial word */ ve[i] &= (~0L << ((base + n) % SCM_LONG_BIT)); } - else if (SCM_EQ_P (fill, SCM_BOOL_T)) + else if (scm_is_eq (fill, SCM_BOOL_T)) { if (base % SCM_LONG_BIT) ve[i++] |= ~0L << (base % SCM_LONG_BIT); @@ -512,7 +512,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) if (scm_is_false (fill)) for (i = base; n--; i += inc) ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT)); - else if (SCM_EQ_P (fill, SCM_BOOL_T)) + else if (scm_is_eq (fill, SCM_BOOL_T)) for (i = base; n--; i += inc) ve[i / SCM_LONG_BIT] |= (1L << (i % SCM_LONG_BIT)); else @@ -1521,7 +1521,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, goto gencase; scm_array_fill_x (ra0, SCM_BOOL_T); for (p = ra_rpsubrs; p->name; p++) - if (SCM_EQ_P (proc, p->sproc)) + if (scm_is_eq (proc, p->sproc)) { while (!SCM_NULLP (lra) && !SCM_NULLP (SCM_CDR (lra))) { @@ -1558,22 +1558,22 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, /* Check to see if order might matter. This might be an argument for a separate SERIAL-ARRAY-MAP! */ - if (SCM_EQ_P (v0, ra1) - || (SCM_ARRAYP (ra1) && SCM_EQ_P (v0, SCM_ARRAY_V (ra1)))) - if (!SCM_EQ_P (ra0, ra1) + if (scm_is_eq (v0, ra1) + || (SCM_ARRAYP (ra1) && scm_is_eq (v0, SCM_ARRAY_V (ra1)))) + if (!scm_is_eq (ra0, ra1) || (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0))) goto gencase; for (tail = SCM_CDR (lra); !SCM_NULLP (tail); tail = SCM_CDR (tail)) { ra1 = SCM_CAR (tail); - if (SCM_EQ_P (v0, ra1) - || (SCM_ARRAYP (ra1) && SCM_EQ_P (v0, SCM_ARRAY_V (ra1)))) + if (scm_is_eq (v0, ra1) + || (SCM_ARRAYP (ra1) && scm_is_eq (v0, SCM_ARRAY_V (ra1)))) goto gencase; } for (p = ra_asubrs; p->name; p++) - if (SCM_EQ_P (proc, p->sproc)) + if (scm_is_eq (proc, p->sproc)) { - if (!SCM_EQ_P (ra0, SCM_CAR (lra))) + if (!scm_is_eq (ra0, SCM_CAR (lra))) scm_ramapc (scm_array_identity, SCM_UNDEFINED, ra0, scm_cons (SCM_CAR (lra), SCM_EOL), FUNC_NAME); lra = SCM_CDR (lra); while (1) @@ -1932,7 +1932,7 @@ raeql (SCM ra0, SCM as_equal, SCM ra1) vlen *= s0[k].ubnd - s1[k].lbnd + 1; } } - if (unroll && bas0 == bas1 && SCM_EQ_P (v0, v1)) + if (unroll && bas0 == bas1 && scm_is_eq (v0, v1)) return 1; return scm_ramapc (raeql_1, as_equal, ra0, scm_cons (ra1, SCM_EOL), ""); } diff --git a/libguile/read.c b/libguile/read.c index 7f301531b..b412cf6e4 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -388,7 +388,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) SCM got; got = scm_call_2 (sharp, SCM_MAKE_CHAR (c), port); - if (SCM_EQ_P (got, SCM_UNSPECIFIED)) + if (scm_is_eq (got, SCM_UNSPECIFIED)) goto handle_sharp; if (SCM_RECORD_POSITIONS_P) return *copy = recsexpr (got, line, column, @@ -489,7 +489,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) SCM got; got = scm_call_2 (sharp, SCM_MAKE_CHAR (c), port); - if (SCM_EQ_P (got, SCM_UNSPECIFIED)) + if (scm_is_eq (got, SCM_UNSPECIFIED)) goto unkshrp; if (SCM_RECORD_POSITIONS_P) return *copy = recsexpr (got, line, column, @@ -610,7 +610,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) goto tok; case ':': - if (SCM_EQ_P (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix)) + if (scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix)) { j = scm_read_token ('-', tok_buf, port, 0); p = scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j); @@ -742,7 +742,7 @@ scm_i_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy, char term_char) if (term_char == c) return SCM_EOL; scm_ungetc (c, port); - if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy)))) + if (scm_is_eq (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy)))) { ans = scm_lreadr (tok_buf, port, copy); closeit: @@ -754,7 +754,7 @@ scm_i_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy, char term_char) while (term_char != (c = scm_flush_ws (port, name))) { scm_ungetc (c, port); - if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy)))) + if (scm_is_eq (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy)))) { SCM_SETCDR (tl, scm_lreadr (tok_buf, port, copy)); goto closeit; @@ -783,7 +783,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) if (')' == c) return SCM_EOL; scm_ungetc (c, port); - if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy)))) + if (scm_is_eq (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy)))) { ans = scm_lreadr (tok_buf, port, copy); if (')' != (c = scm_flush_ws (port, name))) @@ -802,7 +802,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy) SCM new_tail; scm_ungetc (c, port); - if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy)))) + if (scm_is_eq (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy)))) { SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy)); if (SCM_COPY_SOURCE_P) @@ -859,7 +859,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, SCM_VALIDATE_CHAR (1, chr); SCM_ASSERT (scm_is_false (proc) - || SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T), + || scm_is_eq (scm_procedure_p (proc), SCM_BOOL_T), proc, SCM_ARG2, FUNC_NAME); /* Check if chr is already in the alist. */ @@ -877,7 +877,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, } break; } - if (SCM_EQ_P (chr, SCM_CAAR (this))) + if (scm_is_eq (chr, SCM_CAAR (this))) { /* already in the alist. */ if (scm_is_false (proc)) diff --git a/libguile/scmsigs.c b/libguile/scmsigs.c index fba285d24..3591f3a63 100644 --- a/libguile/scmsigs.c +++ b/libguile/scmsigs.c @@ -146,7 +146,7 @@ scm_delq_spine_x (SCM cell, SCM list) { SCM s = list, prev = SCM_BOOL_F; - while (!SCM_EQ_P (cell, s)) + while (!scm_is_eq (cell, s)) { if (SCM_NULLP (s)) return list; @@ -192,7 +192,7 @@ really_install_handler (void *data) /* Make sure it is queued for the right thread. */ old_thread = SCM_VECTOR_REF (signal_handler_threads, signum); - if (!SCM_EQ_P (thread, old_thread)) + if (!scm_is_eq (thread, old_thread)) { scm_root_state *r; if (scm_is_true (old_thread)) diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 72f2db490..f48df9f51 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -202,11 +202,11 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL); if (!SRCPROPSP (p)) goto plist; - if (SCM_EQ_P (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK (p)); - else if (SCM_EQ_P (scm_sym_line, key)) p = scm_from_int (SRCPROPLINE (p)); - else if (SCM_EQ_P (scm_sym_column, key)) p = scm_from_int (SRCPROPCOL (p)); - else if (SCM_EQ_P (scm_sym_filename, key)) p = SRCPROPFNAME (p); - else if (SCM_EQ_P (scm_sym_copy, key)) p = SRCPROPCOPY (p); + if (scm_is_eq (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK (p)); + else if (scm_is_eq (scm_sym_line, key)) p = scm_from_int (SRCPROPLINE (p)); + else if (scm_is_eq (scm_sym_column, key)) p = scm_from_int (SRCPROPCOL (p)); + else if (scm_is_eq (scm_sym_filename, key)) p = SRCPROPFNAME (p); + else if (scm_is_eq (scm_sym_copy, key)) p = SRCPROPCOPY (p); else { p = SRCPROPPLIST (p); @@ -239,7 +239,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, h = scm_whash_create_handle (scm_source_whash, obj); p = SCM_EOL; } - if (SCM_EQ_P (scm_sym_breakpoint, key)) + if (scm_is_eq (scm_sym_breakpoint, key)) { if (SRCPROPSP (p)) { @@ -258,7 +258,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, SETSRCPROPBRK (sp); } } - else if (SCM_EQ_P (scm_sym_line, key)) + else if (scm_is_eq (scm_sym_line, key)) { if (SRCPROPSP (p)) SETSRCPROPLINE (p, scm_to_int (datum)); @@ -267,7 +267,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, scm_make_srcprops (scm_to_int (datum), 0, SCM_UNDEFINED, SCM_UNDEFINED, p)); } - else if (SCM_EQ_P (scm_sym_column, key)) + else if (scm_is_eq (scm_sym_column, key)) { if (SRCPROPSP (p)) SETSRCPROPCOL (p, scm_to_int (datum)); @@ -276,14 +276,14 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, scm_make_srcprops (0, scm_to_int (datum), SCM_UNDEFINED, SCM_UNDEFINED, p)); } - else if (SCM_EQ_P (scm_sym_filename, key)) + else if (scm_is_eq (scm_sym_filename, key)) { if (SRCPROPSP (p)) SRCPROPFNAME (p) = datum; else SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, datum, SCM_UNDEFINED, p)); } - else if (SCM_EQ_P (scm_sym_copy, key)) + else if (scm_is_eq (scm_sym_copy, key)) { if (SRCPROPSP (p)) SRCPROPCOPY (p) = datum; diff --git a/libguile/stacks.c b/libguile/stacks.c index 8fd4dc8cc..387fc57fd 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -202,7 +202,7 @@ get_applybody () #define NEXT_FRAME(iframe, n, quit) \ do { \ if (SCM_MEMOIZEDP (iframe->source) \ - && SCM_EQ_P (SCM_MEMOIZED_EXP (iframe->source), applybody)) \ + && scm_is_eq (SCM_MEMOIZED_EXP (iframe->source), applybody)) \ { \ iframe->source = SCM_BOOL_F; \ if (scm_is_false (iframe->proc)) \ @@ -281,7 +281,7 @@ read_frames (scm_t_debug_frame *dframe, long offset, long n, scm_t_info_frame *i NEXT_FRAME (iframe, n, quit); } } - else if (SCM_EQ_P (iframe->proc, scm_f_gsubr_apply)) + else if (scm_is_eq (iframe->proc, scm_f_gsubr_apply)) /* Skip gsubr apply frames. */ continue; else @@ -324,7 +324,7 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key) long n = s->length; /* Cut inner part. */ - if (SCM_EQ_P (inner_key, SCM_BOOL_T)) + if (scm_is_eq (inner_key, SCM_BOOL_T)) { /* Cut all frames up to user module code */ for (i = 0; inner; ++i, --inner) @@ -358,7 +358,7 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key) /* Use standard cutting procedure. */ { for (i = 0; inner; --inner) - if (SCM_EQ_P (s->frames[i++].proc, inner_key)) + if (scm_is_eq (s->frames[i++].proc, inner_key)) break; } s->frames = &s->frames[i]; @@ -366,7 +366,7 @@ narrow_stack (SCM stack, long inner, SCM inner_key, long outer, SCM outer_key) /* Cut outer part. */ for (; n && outer; --outer) - if (SCM_EQ_P (s->frames[--n].proc, outer_key)) + if (scm_is_eq (s->frames[--n].proc, outer_key)) break; s->length = n; @@ -425,7 +425,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, /* Extract a pointer to the innermost frame of whatever object scm_make_stack was given. */ - if (SCM_EQ_P (obj, SCM_BOOL_T)) + if (scm_is_eq (obj, SCM_BOOL_T)) { dframe = scm_last_debug_frame; } @@ -509,7 +509,7 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0, { scm_t_debug_frame *dframe; long offset = 0; - if (SCM_EQ_P (stack, SCM_BOOL_T)) + if (scm_is_eq (stack, SCM_BOOL_T)) { dframe = scm_last_debug_frame; } diff --git a/libguile/stacks.h b/libguile/stacks.h index 4e68a67a5..568587c4c 100644 --- a/libguile/stacks.h +++ b/libguile/stacks.h @@ -48,7 +48,7 @@ typedef struct scm_t_stack { SCM_API SCM scm_stack_type; -#define SCM_STACKP(obj) (SCM_STRUCTP (obj) && SCM_EQ_P (SCM_STRUCT_VTABLE (obj), scm_stack_type)) +#define SCM_STACKP(obj) (SCM_STRUCTP (obj) && scm_is_eq (SCM_STRUCT_VTABLE (obj), scm_stack_type)) #define SCM_STACK_LENGTH(stack) (SCM_STACK (stack) -> length) #define SCM_FRAMEP(obj) \ diff --git a/libguile/threads.c b/libguile/threads.c index a94e0698d..25f06d6d4 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -68,9 +68,9 @@ remqueue (SCM q, SCM c) SCM p, prev = q; for (p = SCM_CDR (q); !SCM_NULLP (p); p = SCM_CDR (p)) { - if (SCM_EQ_P (p, c)) + if (scm_is_eq (p, c)) { - if (SCM_EQ_P (c, SCM_CAR (q))) + if (scm_is_eq (c, SCM_CAR (q))) SCM_SETCAR (q, SCM_CDR (c)); SCM_SETCDR (prev, SCM_CDR (c)); return; @@ -457,7 +457,7 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0, SCM res; SCM_VALIDATE_THREAD (1, thread); - if (SCM_EQ_P (cur_thread, thread)) + if (scm_is_eq (cur_thread, thread)) SCM_MISC_ERROR ("can not join the current thread", SCM_EOL); t = SCM_THREAD_DATA (thread); diff --git a/libguile/throw.c b/libguile/throw.c index 0f27e93a1..94affdeb4 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -502,7 +502,7 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0, { struct scm_body_thunk_data c; - SCM_ASSERT (SCM_SYMBOLP (key) || SCM_EQ_P (key, SCM_BOOL_T), + SCM_ASSERT (SCM_SYMBOLP (key) || scm_is_eq (key, SCM_BOOL_T), key, SCM_ARG1, FUNC_NAME); c.tag = key; @@ -530,7 +530,7 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0, { struct scm_body_thunk_data c; - SCM_ASSERT (SCM_SYMBOLP (key) || SCM_EQ_P (key, SCM_BOOL_T), + SCM_ASSERT (SCM_SYMBOLP (key) || scm_is_eq (key, SCM_BOOL_T), key, SCM_ARG1, FUNC_NAME); c.tag = key; @@ -584,7 +584,7 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) { SCM this_key = SCM_CAR (dynpair); - if (SCM_EQ_P (this_key, SCM_BOOL_T) || SCM_EQ_P (this_key, key)) + if (scm_is_eq (this_key, SCM_BOOL_T) || scm_is_eq (this_key, key)) break; } } @@ -605,7 +605,7 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) jmpbuf = SCM_CDR (dynpair); for (wind_goal = scm_dynwinds; - !SCM_EQ_P (SCM_CDAR (wind_goal), jmpbuf); + !scm_is_eq (SCM_CDAR (wind_goal), jmpbuf); wind_goal = SCM_CDR (wind_goal)) ; diff --git a/libguile/unif.c b/libguile/unif.c index 3d81b95c4..3abc8c7d9 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -152,7 +152,7 @@ SCM scm_make_uve (long k, SCM prot) #define FUNC_NAME "scm_make_uve" { - if (SCM_EQ_P (prot, SCM_BOOL_T)) + if (scm_is_eq (prot, SCM_BOOL_T)) { if (k > 0) { @@ -271,13 +271,13 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0, switch (SCM_TYP7 (v)) { case scm_tc7_bvect: - protp = (SCM_EQ_P (prot, SCM_BOOL_T)); + protp = (scm_is_eq (prot, SCM_BOOL_T)); break; case scm_tc7_string: protp = SCM_CHARP(prot) && (SCM_CHAR (prot) != '\0'); break; case scm_tc7_byvect: - protp = SCM_EQ_P (prot, SCM_MAKE_CHAR ('\0')); + protp = scm_is_eq (prot, SCM_MAKE_CHAR ('\0')); break; case scm_tc7_uvect: protp = SCM_I_INUMP(prot) && SCM_I_INUM(prot)>0; @@ -1169,14 +1169,14 @@ scm_cvref (SCM v, unsigned long pos, SCM last) return scm_from_long_long (((long long *) SCM_CELL_WORD_1 (v))[pos]); #endif case scm_tc7_fvect: - if (SCM_REALP (last) && !SCM_EQ_P (last, scm_flo0)) + if (SCM_REALP (last) && !scm_is_eq (last, scm_flo0)) { SCM_REAL_VALUE (last) = ((float *) SCM_CELL_WORD_1 (v))[pos]; return last; } return scm_make_real (((float *) SCM_CELL_WORD_1 (v))[pos]); case scm_tc7_dvect: - if (SCM_REALP (last) && !SCM_EQ_P (last, scm_flo0)) + if (SCM_REALP (last) && !scm_is_eq (last, scm_flo0)) { SCM_REAL_VALUE (last) = ((double *) SCM_CELL_WORD_1 (v))[pos]; return last; @@ -1262,7 +1262,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, case scm_tc7_bvect: if (scm_is_false (obj)) SCM_BITVEC_CLR(v, pos); - else if (SCM_EQ_P (obj, SCM_BOOL_T)) + else if (scm_is_eq (obj, SCM_BOOL_T)) SCM_BITVEC_SET(v, pos); else badobj:SCM_WRONG_TYPE_ARG (2, obj); @@ -1595,7 +1595,7 @@ loop: if (SCM_TYP7 (v) == scm_tc7_bvect) ans *= SCM_LONG_BIT; - if (!SCM_EQ_P (v, ra) && !SCM_EQ_P (cra, ra)) + if (!scm_is_eq (v, ra) && !scm_is_eq (cra, ra)) scm_array_copy_x (cra, ra); return scm_from_long (ans); @@ -1891,7 +1891,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, scm_out_of_range (FUNC_NAME, scm_from_long (k)); SCM_BITVEC_CLR(v, k); } - else if (SCM_EQ_P (obj, SCM_BOOL_T)) + else if (scm_is_eq (obj, SCM_BOOL_T)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); @@ -1907,7 +1907,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, if (scm_is_false (obj)) for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) SCM_BITVECTOR_BASE (v) [k] &= ~SCM_BITVECTOR_BASE (kv) [k]; - else if (SCM_EQ_P (obj, SCM_BOOL_T)) + else if (scm_is_eq (obj, SCM_BOOL_T)) for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) SCM_BITVECTOR_BASE (v) [k] |= SCM_BITVECTOR_BASE (kv) [k]; else @@ -1962,7 +1962,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, if (!SCM_BITVEC_REF(v, k)) count++; } - else if (SCM_EQ_P (obj, SCM_BOOL_T)) + else if (scm_is_eq (obj, SCM_BOOL_T)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { k = SCM_UNPACK (SCM_VELTS (kv)[--i]); @@ -1979,7 +1979,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, if (0 == SCM_BITVECTOR_LENGTH (v)) return SCM_INUM0; SCM_ASRTGO (scm_is_bool (obj), badarg3); - fObj = SCM_EQ_P (obj, SCM_BOOL_T); + fObj = scm_is_eq (obj, SCM_BOOL_T); i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK (SCM_VELTS (v)[i]) : ~ SCM_UNPACK (SCM_VELTS (v)[i])); k <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (v) - 1) % SCM_LONG_BIT); @@ -2465,7 +2465,7 @@ tail: } } case scm_tc7_bvect: - if (SCM_EQ_P (exp, v)) + if (scm_is_eq (exp, v)) { /* a uve, not an scm_array */ register long i, j, w; scm_putc ('*', port); diff --git a/libguile/validate.h b/libguile/validate.h index 3da0d0500..18a671e61 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -143,7 +143,7 @@ #define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \ do { \ SCM_ASSERT (scm_is_bool (flag), flag, pos, FUNC_NAME); \ - cvar = SCM_EQ_P (flag, SCM_BOOL_T) ? 1 : 0; \ + cvar = scm_to_bool (flag); \ } while (0) #define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, "character") @@ -306,7 +306,7 @@ #define SCM_VALIDATE_PROC(pos, proc) \ do { \ - SCM_ASSERT (SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T), proc, pos, FUNC_NAME); \ + SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \ } while (0) #define SCM_VALIDATE_NULLORCONS(pos, env) \ diff --git a/libguile/values.h b/libguile/values.h index 5ddcadf47..7653e3583 100644 --- a/libguile/values.h +++ b/libguile/values.h @@ -27,7 +27,7 @@ SCM_API SCM scm_values_vtable; #define SCM_VALUESP(x) (SCM_STRUCTP (x)\ - && SCM_EQ_P (scm_struct_vtable (x), scm_values_vtable)) + && scm_is_eq (scm_struct_vtable (x), scm_values_vtable)) SCM_API SCM scm_values (SCM args); SCM_API void scm_init_values (void); diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index eef97d7ef..c194f66b5 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -49,7 +49,7 @@ srfi1_ilength (SCM sx) /* For every two steps the hare takes, the tortoise takes one. */ tortoise = SCM_CDR(tortoise); } - while (! SCM_EQ_P (hare, tortoise)); + while (! scm_is_eq (hare, tortoise)); /* If the tortoise ever catches the hare, then the list must contain a cycle. */ @@ -222,7 +222,7 @@ SCM_DEFINE (scm_srfi1_delete, "delete", 2, 1, 0, { /* delete this element, so copy from keeplst (inclusive) to lst (exclusive) onto ret */ - while (! SCM_EQ_P (keeplst, lst)) + while (! scm_is_eq (keeplst, lst)) { SCM c = scm_cons (SCM_CAR (keeplst), SCM_EOL); *p = c; @@ -360,13 +360,13 @@ SCM_DEFINE (scm_srfi1_delete_duplicates, "delete-duplicates", 1, 1, 0, item = SCM_CAR (lst); /* loop searching ret upto lst */ - for (l = ret; ! SCM_EQ_P (l, lst); l = SCM_CDR (l)) + for (l = ret; ! scm_is_eq (l, lst); l = SCM_CDR (l)) { if (scm_is_true (equal_p (pred, SCM_CAR (l), item))) { /* duplicate, don't want this element, so copy keeplst (inclusive) to lst (exclusive) onto ret */ - while (! SCM_EQ_P (keeplst, lst)) + while (! scm_is_eq (keeplst, lst)) { SCM c = scm_cons (SCM_CAR (keeplst), SCM_EOL); *p = c; @@ -450,7 +450,7 @@ SCM_DEFINE (scm_srfi1_delete_duplicates_x, "delete-duplicates!", 1, 1, 0, if (scm_is_true (equal_p (pred, SCM_CAR (l), item))) break; /* equal, forget this element */ - if (SCM_EQ_P (l, endret)) + if (scm_is_eq (l, endret)) { /* not equal to any, so append this pair */ SCM_SETCDR (endret, lst); diff --git a/srfi/srfi-13.c b/srfi/srfi-13.c index 0efd24abb..bbb20faab 100644 --- a/srfi/srfi-13.c +++ b/srfi/srfi-13.c @@ -236,13 +236,13 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0, /* Validate the grammar symbol and remember the grammar. */ if (SCM_UNBNDP (grammar)) gram = GRAM_INFIX; - else if (SCM_EQ_P (grammar, scm_sym_infix)) + else if (scm_is_eq (grammar, scm_sym_infix)) gram = GRAM_INFIX; - else if (SCM_EQ_P (grammar, scm_sym_strict_infix)) + else if (scm_is_eq (grammar, scm_sym_strict_infix)) gram = GRAM_STRICT_INFIX; - else if (SCM_EQ_P (grammar, scm_sym_suffix)) + else if (scm_is_eq (grammar, scm_sym_suffix)) gram = GRAM_SUFFIX; - else if (SCM_EQ_P (grammar, scm_sym_prefix)) + else if (scm_is_eq (grammar, scm_sym_prefix)) gram = GRAM_PREFIX; else SCM_WRONG_TYPE_ARG (3, grammar); |