diff --git a/libguile/ChangeLog b/libguile/ChangeLog index cd72ef097..f28ecbbb0 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,98 @@ +2002-01-22 Neil Jerram + + Other changes unrelated to Elisp... + + * eval.c (scm_m_if): Use s_if rather than repeating string literal + "if". + (comments): Fix a few typos. + (scm_for_each): Add parentheses around oddly unparenthesized + if/while conditions. + + * read.c (scm_read_opts): Add full stop at end of doc for + `keywords' option. + + * script.c (scm_compile_shell_switches): Use scm_str2symbol + instead of gh_symbol2scm. + + * srcprop.h (SRCPROPBRK): Return C type rather than SCM. + (SRCBRKP): Use SRCPROPBRK rather than duplicating its logic. + + * srcprop.c (scm_srcprops_to_plist, scm_source_property): Change + SRCPROPBRK (x) to SCM_BOOL (SRCPROPBRK (x)). + + First batch of changes for Elisp support... + + * alist.c, async.c, boolean.c, dynl.c, eval.c, filesys.c, + fluids.c, list.c, load.c, options.c, posix.c, print.c, sort.c, + throw.c, vectors.c, weaks.c: Add #include for lang.h. + + * eval.c, eval.h, init.c, lang.c, lang.h: Use SCM_ENABLE_ELISP to + conditionalize compilation and initialization of Elisp support + function. + + * alist.c (scm_assq, scm_assv, scm_assoc), async.c + (scm_asyncs_pending, scm_run_asyncs, noop), backtrace.c + (scm_set_print_params_x), dynl.c (scm_make_argv_from_stringlist), + filesys.c (fill_select_type, retrieve_select_type), fluids.c + (scm_swap_fluids, scm_swap_fluids_reverse), list.c (scm_null_p, + scm_ilength, scm_append_x, scm_last_pair, scm_reverse, + scm_reverse_x, scm_list_ref, scm_list_set_x, scm_list_cdr_set_x, + scm_c_memq, scm_memv), load.c (scm_search_path), options.c + (change_option_setting, scm_options), posix.c (environ_list_to_c), + print.c (scm_iprlist), throw.c (scm_exit_status), vectors.c + (scm_vector), weaks.c (scm_weak_vector): Use SCM_NULL_OR_NIL_P + instead of SCM_NULLP. + + * boolean.c (scm_not): Use `SCM_FALSEP || SCM_NILP' instead of + just SCM_FALSEP. + + * boolean.c (scm_boolean_p): Use `SCM_BOOLP || SCM_NILP' instead + of just SCM_BOOLP. + + * eval.c (scm_lisp_nil, scm_lisp_t, s_nil_ify, scm_m_nil_ify, + s_t_ify, scm_m_t_ify, s_0_cond, scm_m_0_cond, s_0_ify, + scm_m_0_ify, s_1_ify, scm_m_1_ify): Removed. + (scm_m_atfop): Support function aliasing. Support both function + args, which need transformation, and macro args, which do not. + Add explanatory comments. + (SCM_CEVAL): In switch cases for SCM_IM_AND, SCM_IM_COND, + SCM_IM_DO, SCM_IM_IF and SCM_IM_OR, add `|| SCM_NILP' to existing + checks for SCM_FALSEP. In switch case for SCM_IM_NIL_COND, use + SCM_NULLP || SCM_NILP instead of checks against (removed) + scm_lisp_nil. Removed switch cases for SCM_IM_NIL_IFY, + SCM_IM_T_IFY, SCM_IM_0_COND, SCM_IM_0_IFY, SCM_IM_1_IFY. + + * lang.c (scm_nil_cons, scm_nil_car, scm_nil_cdr, scm_null, + scm_m_while, scm_nil_eq): Commented out; I don't think we need + these, but I don't want to remove them yet, just in case. + (scm_init_lang): Define `%nil' variable on Scheme level to hold + Elisp nil value. + + * lang.h (SCM_NILP): Test against Elisp nil value instead of + against (removed) scm_lisp_nil. + (SCM_NILNULLP, SCM_NIL2EOL, SCM_EOL2NIL): Commented out. + (SCM_NULL_OR_NIL_P): New. + + * list.c (scm_append): Use SCM_VALIDATE_NULL_OR_NIL instead of + SCM_VALIDATE_NULL. + + * print.c (scm_isymnames): Fix comment. Remove #@nil-ify, + #@t-ify, #@0-cond, #@0-ify, #@1-ify. Add #nil (for SCM_ELISP_NIL + value). + + * sort.c (scm_sorted_p, scm_merge, scm_merge_list_x, scm_merge_x, + scm_sort_x, scm_sort, scm_stable_sort_x, scm_stable_sort): Use + SCM_NULL_OR_NIL_P instead of SCM_NULLP. In constructions like `if + (SCM_NULLP (x)) return SCM_EOL;', return x rather than SCM_EOL. + + * tags.h (SCM_IM_NIL_IFY, SCM_IM_T_IFY, SCM_IM_0_COND, + SCM_IM_0_IFY, SCM_IM_1_IFY): Removed. + (SCM_IM_BIND, SCM_IM_DELAY, SCM_IM_CALL_WITH_VALUES, SCM_UNBOUND): + Numbering shifted down accordingly. + (SCM_ELISP_NIL): New IFLAG. + + * validate.h (SCM_VALIDATE_NULL_OR_NIL): New. + 2002-01-10 Dirk Herrmann * eval.c: Removed outdated references to "everr". Improved some diff --git a/libguile/alist.c b/libguile/alist.c index 2dd6057b4..a3cdde604 100644 --- a/libguile/alist.c +++ b/libguile/alist.c @@ -44,6 +44,7 @@ #include "libguile/_scm.h" #include "libguile/eq.h" #include "libguile/list.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/alist.h" @@ -144,7 +145,7 @@ SCM_DEFINE (scm_assq, "assq", 2, 0, 0, if (SCM_EQ_P (SCM_CAR (tmp), key)) return tmp; } - SCM_ASSERT_TYPE (SCM_NULLP (ls), alist, SCM_ARG2, FUNC_NAME, + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, "association list"); return SCM_BOOL_F; } @@ -165,7 +166,7 @@ SCM_DEFINE (scm_assv, "assv", 2, 0, 0, if (SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), key))) return tmp; } - SCM_ASSERT_TYPE (SCM_NULLP (ls), alist, SCM_ARG2, FUNC_NAME, + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, "association list"); return SCM_BOOL_F; } @@ -186,7 +187,7 @@ SCM_DEFINE (scm_assoc, "assoc", 2, 0, 0, if (SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), key))) return tmp; } - SCM_ASSERT_TYPE (SCM_NULLP (ls), alist, SCM_ARG2, FUNC_NAME, + SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (ls), alist, SCM_ARG2, FUNC_NAME, "association list"); return SCM_BOOL_F; } diff --git a/libguile/async.c b/libguile/async.c index 5d06c1f77..e3b7d33f3 100644 --- a/libguile/async.c +++ b/libguile/async.c @@ -48,6 +48,7 @@ #include "libguile/throw.h" #include "libguile/root.h" #include "libguile/smob.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/async.h" @@ -128,7 +129,7 @@ scm_asyncs_pending () { SCM pos; pos = scm_asyncs; - while (!SCM_NULLP (pos)) + while (!SCM_NULL_OR_NIL_P (pos)) { SCM a = SCM_CAR (pos); if (ASYNC_GOT_IT (a)) @@ -356,7 +357,7 @@ SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0, #else scm_asyncs_pending_p = 0; #endif - while (! SCM_NULLP (list_of_a)) + while (! SCM_NULL_OR_NIL_P (list_of_a)) { SCM a; SCM_VALIDATE_CONS (1, list_of_a); @@ -385,7 +386,7 @@ SCM_DEFINE (scm_noop, "noop", 0, 0, 1, #define FUNC_NAME s_scm_noop { SCM_VALIDATE_REST_ARGUMENT (args); - return (SCM_NULLP (args) ? SCM_BOOL_F : SCM_CAR (args)); + return (SCM_NULL_OR_NIL_P (args) ? SCM_BOOL_F : SCM_CAR (args)); } #undef FUNC_NAME diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 803f5aaaa..290627fbb 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -302,7 +302,7 @@ SCM_DEFINE (scm_set_print_params_x, "set-print-params!", 1, 0, 0, print_params_t *new_params; SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, params, n); - for (ls = params; !SCM_NULLP (ls); ls = SCM_CDR (ls)) + for (ls = params; !SCM_NULL_OR_NIL_P (ls); ls = SCM_CDR (ls)) SCM_ASSERT (scm_ilength (SCM_CAR (params)) == 2 && SCM_INUMP (SCM_CAAR (ls)) && SCM_INUM (SCM_CAAR (ls)) >= 0 diff --git a/libguile/boolean.c b/libguile/boolean.c index da56aab54..402fce55d 100644 --- a/libguile/boolean.c +++ b/libguile/boolean.c @@ -46,6 +46,7 @@ #include "libguile/validate.h" #include "libguile/boolean.h" +#include "libguile/lang.h" @@ -54,7 +55,7 @@ SCM_DEFINE (scm_not, "not", 1, 0, 0, "Return @code{#t} iff @var{x} is @code{#f}, else return @code{#f}.") #define FUNC_NAME s_scm_not { - return SCM_BOOL(SCM_FALSEP(x)); + return SCM_BOOL(SCM_FALSEP (x) || SCM_NILP (x)); } #undef FUNC_NAME @@ -64,7 +65,7 @@ SCM_DEFINE (scm_boolean_p, "boolean?", 1, 0, 0, "Return @code{#t} iff @var{obj} is either @code{#t} or @code{#f}.") #define FUNC_NAME s_scm_boolean_p { - return SCM_BOOL (SCM_BOOLP (obj)); + return SCM_BOOL (SCM_BOOLP (obj) || SCM_NILP (obj)); } #undef FUNC_NAME diff --git a/libguile/dynl.c b/libguile/dynl.c index 136595780..d920b2d7a 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -72,6 +72,7 @@ maybe_drag_in_eprintf () #include "libguile/ports.h" #include "libguile/strings.h" #include "libguile/deprecation.h" +#include "libguile/lang.h" #include "libguile/validate.h" /* Create a new C argv array from a scheme list of strings. */ @@ -97,7 +98,7 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn) argc = scm_ilength (args); SCM_ASSERT (argc >= 0, args, argn, subr); argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr); - for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i) { + for (i = 0; !SCM_NULL_OR_NIL_P (args); args = SCM_CDR (args), ++i) { SCM arg = SCM_CAR (args); size_t len; char *dst; diff --git a/libguile/eval.c b/libguile/eval.c index 4138456d7..2fff70468 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -100,6 +100,7 @@ char *alloca (); #include "libguile/validate.h" #include "libguile/eval.h" +#include "libguile/lang.h" @@ -537,7 +538,7 @@ SCM scm_m_if (SCM xorig, SCM env SCM_UNUSED) { long len = scm_ilength (SCM_CDR (xorig)); - SCM_ASSYNT (len >= 2 && len <= 3, scm_s_expression, "if"); + SCM_ASSYNT (len >= 2 && len <= 3, scm_s_expression, s_if); return scm_cons (SCM_IM_IF, SCM_CDR (xorig)); } @@ -1073,10 +1074,7 @@ scm_m_cont (SCM xorig, SCM env SCM_UNUSED) return scm_cons (SCM_IM_CONT, SCM_CDR (xorig)); } -/* Multi-language support */ - -SCM_GLOBAL_SYMBOL (scm_lisp_nil, "nil"); -SCM_GLOBAL_SYMBOL (scm_lisp_t, "t"); +#ifdef SCM_ENABLE_ELISP SCM_SYNTAX (s_nil_cond, "nil-cond", scm_makmmacro, scm_m_nil_cond); @@ -1088,52 +1086,6 @@ scm_m_nil_cond (SCM xorig, SCM env SCM_UNUSED) return scm_cons (SCM_IM_NIL_COND, SCM_CDR (xorig)); } -SCM_SYNTAX (s_nil_ify, "nil-ify", scm_makmmacro, scm_m_nil_ify); - -SCM -scm_m_nil_ify (SCM xorig, SCM env SCM_UNUSED) -{ - SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "nil-ify"); - return scm_cons (SCM_IM_NIL_IFY, SCM_CDR (xorig)); -} - -SCM_SYNTAX (s_t_ify, "t-ify", scm_makmmacro, scm_m_t_ify); - -SCM -scm_m_t_ify (SCM xorig, SCM env SCM_UNUSED) -{ - SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "t-ify"); - return scm_cons (SCM_IM_T_IFY, SCM_CDR (xorig)); -} - -SCM_SYNTAX (s_0_cond, "0-cond", scm_makmmacro, scm_m_0_cond); - -SCM -scm_m_0_cond (SCM xorig, SCM env SCM_UNUSED) -{ - long len = scm_ilength (SCM_CDR (xorig)); - SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "0-cond"); - return scm_cons (SCM_IM_0_COND, SCM_CDR (xorig)); -} - -SCM_SYNTAX (s_0_ify, "0-ify", scm_makmmacro, scm_m_0_ify); - -SCM -scm_m_0_ify (SCM xorig, SCM env SCM_UNUSED) -{ - SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "0-ify"); - return scm_cons (SCM_IM_0_IFY, SCM_CDR (xorig)); -} - -SCM_SYNTAX (s_1_ify, "1-ify", scm_makmmacro, scm_m_1_ify); - -SCM -scm_m_1_ify (SCM xorig, SCM env SCM_UNUSED) -{ - SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, "1-ify"); - return scm_cons (SCM_IM_1_IFY, SCM_CDR (xorig)); -} - SCM_SYNTAX (s_atfop, "@fop", scm_makmmacro, scm_m_atfop); SCM @@ -1142,12 +1094,45 @@ scm_m_atfop (SCM xorig, SCM env SCM_UNUSED) SCM x = SCM_CDR (xorig), var; SCM_ASSYNT (scm_ilength (x) >= 1, scm_s_expression, "@fop"); var = scm_symbol_fref (SCM_CAR (x)); + /* Passing the symbol name as the `subr' arg here isn't really + right, but without it it can be very difficult to work out from + the error message which function definition was missing. In any + case, we shouldn't really use SCM_ASSYNT here at all, but instead + something equivalent to (signal void-function (list SYM)) in + Elisp. */ SCM_ASSYNT (SCM_VARIABLEP (var), - "Symbol's function definition is void", NULL); + "Symbol's function definition is void", + SCM_SYMBOL_CHARS (SCM_CAR (x))); + /* Support `defalias'. */ + while (SCM_SYMBOLP (SCM_VARIABLE_REF (var))) + { + var = scm_symbol_fref (SCM_VARIABLE_REF (var)); + SCM_ASSYNT (SCM_VARIABLEP (var), + "Symbol's function definition is void", + SCM_SYMBOL_CHARS (SCM_CAR (x))); + } + /* Use `var' here rather than `SCM_VARIABLE_REF (var)' because the + former allows for automatically picking up redefinitions of the + corresponding symbol. */ SCM_SETCAR (x, var); + /* If the variable contains a procedure, leave the + `transformer-macro' in place so that the procedure's arguments + get properly transformed, and change the initial @fop to + SCM_IM_APPLY. */ + if (!SCM_MACROP (SCM_VARIABLE_REF (var))) + { + SCM_SETCAR (xorig, SCM_IM_APPLY); + return xorig; + } + /* Otherwise (the variable contains a macro), the arguments should + not be transformed, so cut the `transformer-macro' out and return + the resulting expression starting with the variable. */ + SCM_SETCDR (x, SCM_CDADR (x)); return x; } +#endif /* SCM_ENABLE_ELISP */ + /* (@bind ((var exp) ...) body ...) This will assign the values of the `exp's to the global variables @@ -1158,7 +1143,7 @@ scm_m_atfop (SCM xorig, SCM env SCM_UNUSED) error when a symbol appears more than once among the `var's. All `exp's are evaluated before any `var' is set. - This of this as `let' for dynamic scope. + Think of this as `let' for dynamic scope. It is memoized into (#@bind ((var ...) . (reversed-val ...)) body ...). @@ -1325,7 +1310,7 @@ scm_macroexp (SCM x, SCM env) * generating the source for a stackframe in a backtrace, and in * display_expression. * - * Unmemoizing is not a realiable process. You can not in general + * Unmemoizing is not a reliable process. You cannot in general * expect to get the original source back. * * However, GOOPS currently relies on this for method compilation. @@ -2018,7 +2003,7 @@ dispatch: x = SCM_CDR (x); while (!SCM_NULLP (SCM_CDR (x))) { - if (SCM_FALSEP (EVALCAR (x, env))) + if (SCM_FALSEP (t.arg1 = EVALCAR (x, env)) || SCM_NILP (t.arg1)) RETURN (SCM_BOOL_F); else x = SCM_CDR (x); @@ -2129,7 +2114,7 @@ dispatch: goto begin; } t.arg1 = EVALCAR (proc, env); - if (!SCM_FALSEP (t.arg1)) + if (!SCM_FALSEP (t.arg1) && !SCM_NILP (t.arg1)) { x = SCM_CDR (proc); if (SCM_NULLP (x)) @@ -2164,7 +2149,8 @@ dispatch: } env = EXTEND_ENV (SCM_CAR (x), t.arg1, env); x = SCM_CDDR (x); - while (proc = SCM_CAR (x), SCM_FALSEP (EVALCAR (proc, env))) + while (proc = SCM_CAR (x), + SCM_FALSEP (t.arg1 = EVALCAR (proc, env)) || SCM_NILP (t.arg1)) { for (proc = SCM_CADR (x); SCM_NIMP (proc); proc = SCM_CDR (proc)) { @@ -2186,7 +2172,7 @@ dispatch: case SCM_BIT8(SCM_IM_IF): x = SCM_CDR (x); - if (!SCM_FALSEP (EVALCAR (x, env))) + if (!SCM_FALSEP (t.arg1 = EVALCAR (x, env)) && !SCM_NILP (t.arg1)) x = SCM_CDR (x); else if (SCM_IMP (x = SCM_CDDR (x))) RETURN (SCM_UNSPECIFIED); @@ -2249,7 +2235,7 @@ dispatch: while (!SCM_NULLP (SCM_CDR (x))) { SCM val = EVALCAR (x, env); - if (!SCM_FALSEP (val)) + if (!SCM_FALSEP (val) && !SCM_NILP (val)) RETURN (val); else x = SCM_CDR (x); @@ -2477,13 +2463,16 @@ dispatch: SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CAR (x))] = SCM_UNPACK (EVALCAR (proc, env)); RETURN (SCM_UNSPECIFIED); + +#ifdef SCM_ENABLE_ELISP case (SCM_ISYMNUM (SCM_IM_NIL_COND)): proc = SCM_CDR (x); while (SCM_NIMP (x = SCM_CDR (proc))) { if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env)) - || SCM_EQ_P (t.arg1, scm_lisp_nil))) + || SCM_NILP (t.arg1) + || SCM_NULLP (t.arg1))) { if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED)) RETURN (t.arg1); @@ -2496,45 +2485,7 @@ dispatch: PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto carloop; - case (SCM_ISYMNUM (SCM_IM_NIL_IFY)): - x = SCM_CDR (x); - RETURN ((SCM_FALSEP (proc = EVALCAR (x, env)) || SCM_NULLP (proc)) - ? scm_lisp_nil - : proc); - - case (SCM_ISYMNUM (SCM_IM_T_IFY)): - x = SCM_CDR (x); - RETURN (!SCM_FALSEP (EVALCAR (x, env)) ? scm_lisp_t : scm_lisp_nil); - - case (SCM_ISYMNUM (SCM_IM_0_COND)): - proc = SCM_CDR (x); - while (SCM_NIMP (x = SCM_CDR (proc))) - { - if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env)) - || SCM_EQ_P (t.arg1, SCM_INUM0))) - { - if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED)) - RETURN (t.arg1); - PREP_APPLY (SCM_UNDEFINED, SCM_EOL); - goto carloop; - } - proc = SCM_CDR (x); - } - x = proc; - PREP_APPLY (SCM_UNDEFINED, SCM_EOL); - goto carloop; - - case (SCM_ISYMNUM (SCM_IM_0_IFY)): - x = SCM_CDR (x); - RETURN (SCM_FALSEP (proc = EVALCAR (x, env)) - ? SCM_INUM0 - : proc); - - case (SCM_ISYMNUM (SCM_IM_1_IFY)): - x = SCM_CDR (x); - RETURN (!SCM_FALSEP (EVALCAR (x, env)) - ? SCM_MAKINUM (1) - : SCM_INUM0); +#endif /* SCM_ENABLE_ELISP */ case (SCM_ISYMNUM (SCM_IM_BIND)): { @@ -2568,7 +2519,7 @@ dispatch: RETURN (proc); } - + case (SCM_ISYMNUM (SCM_IM_CALL_WITH_VALUES)): { proc = SCM_CDR (x); @@ -3388,7 +3339,11 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0, SCM *lloc; SCM_VALIDATE_NONEMPTYLIST (1,lst); lloc = &lst; - while (!SCM_NULLP (SCM_CDR (*lloc))) + while (!SCM_NULLP (SCM_CDR (*lloc))) /* Perhaps should be + SCM_NULL_OR_NIL_P, but not + needed in 99.99% of cases, + and it could seriously hurt + performance. - Neil */ lloc = SCM_CDRLOC (*lloc); SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, FUNC_NAME); *lloc = SCM_CAR (*lloc); @@ -3846,9 +3801,9 @@ scm_for_each (SCM proc, SCM arg1, SCM args) SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args), SCM_ARG2, s_for_each); SCM_VALIDATE_REST_ARGUMENT (args); - if SCM_NULLP (args) + if (SCM_NULLP (args)) { - while SCM_NIMP (arg1) + while (SCM_NIMP (arg1)) { scm_apply (proc, SCM_CAR (arg1), scm_listofnull); arg1 = SCM_CDR (arg1); @@ -3865,8 +3820,8 @@ scm_for_each (SCM proc, SCM arg1, SCM args) arg1 = SCM_EOL; for (i = SCM_VECTOR_LENGTH (args) - 1; i >= 0; i--) { - if SCM_IMP - (ve[i]) return SCM_UNSPECIFIED; + if (SCM_IMP (ve[i])) + return SCM_UNSPECIFIED; arg1 = scm_cons (SCM_CAR (ve[i]), arg1); ve[i] = SCM_CDR (ve[i]); } @@ -4182,9 +4137,6 @@ scm_init_eval () #ifndef SCM_MAGIC_SNARFER #include "libguile/eval.x" #endif - - scm_c_define ("nil", scm_lisp_nil); - scm_c_define ("t", scm_lisp_t); scm_add_feature ("delay"); } diff --git a/libguile/eval.h b/libguile/eval.h index 27f3860db..7d76a9098 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -204,13 +204,10 @@ SCM_API SCM scm_m_letrec (SCM xorig, SCM env); SCM_API SCM scm_m_let (SCM xorig, SCM env); SCM_API SCM scm_m_apply (SCM xorig, SCM env); SCM_API SCM scm_m_cont (SCM xorig, SCM env); +#ifdef SCM_ENABLE_ELISP SCM_API SCM scm_m_nil_cond (SCM xorig, SCM env); -SCM_API SCM scm_m_nil_ify (SCM xorig, SCM env); -SCM_API SCM scm_m_t_ify (SCM xorig, SCM env); -SCM_API SCM scm_m_0_cond (SCM xorig, SCM env); -SCM_API SCM scm_m_0_ify (SCM xorig, SCM env); -SCM_API SCM scm_m_1_ify (SCM xorig, SCM env); SCM_API SCM scm_m_atfop (SCM xorig, SCM env); +#endif /* SCM_ENABLE_ELISP */ SCM_API SCM scm_m_atbind (SCM xorig, SCM env); SCM_API SCM scm_m_at_call_with_values (SCM xorig, SCM env); SCM_API int scm_badargsp (SCM formals, SCM args); diff --git a/libguile/filesys.c b/libguile/filesys.c index b8a9aadc9..862579c10 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -51,6 +51,7 @@ #include "libguile/iselect.h" #include "libguile/strings.h" #include "libguile/vectors.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/filesys.h" @@ -1032,7 +1033,7 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos) } else { - while (!SCM_NULLP (list_or_vec)) + while (!SCM_NULL_OR_NIL_P (list_or_vec)) { int fd = set_element (set, ports_ready, SCM_CAR (list_or_vec), pos); @@ -1092,7 +1093,7 @@ retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec) else { /* list_or_vec must be a list. */ - while (!SCM_NULLP (list_or_vec)) + while (!SCM_NULL_OR_NIL_P (list_or_vec)) { answer_list = get_element (set, SCM_CAR (list_or_vec), answer_list); list_or_vec = SCM_CDR (list_or_vec); diff --git a/libguile/fluids.c b/libguile/fluids.c index 2a8ff9a1f..7901e2231 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -50,6 +50,7 @@ #include "libguile/eval.h" #include "libguile/ports.h" #include "libguile/deprecation.h" +#include "libguile/lang.h" #define INITIAL_FLUIDS 10 #include "libguile/validate.h" @@ -178,7 +179,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0, void scm_swap_fluids (SCM fluids, SCM vals) { - while (!SCM_NULLP (fluids)) + while (!SCM_NULL_OR_NIL_P (fluids)) { SCM fl = SCM_CAR (fluids); SCM old_val = scm_fluid_ref (fl); @@ -195,7 +196,7 @@ same fluid appears multiple times in the fluids list. */ void scm_swap_fluids_reverse (SCM fluids, SCM vals) { - if (!SCM_NULLP (fluids)) + if (!SCM_NULL_OR_NIL_P (fluids)) { SCM fl, old_val; diff --git a/libguile/init.c b/libguile/init.c index 5c96be4dc..b732165b4 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -560,7 +560,9 @@ scm_init_guile_1 (SCM_STACKITEM *base) scm_init_load_path (); scm_init_standard_ports (); /* Requires fports */ scm_init_dynamic_linking (); +#ifdef SCM_ENABLE_ELISP scm_init_lang (); +#endif /* SCM_ENABLE_ELISP */ scm_init_script (); scm_init_goops (); diff --git a/libguile/lang.c b/libguile/lang.c index f022bee77..463cbeb5c 100644 --- a/libguile/lang.c +++ b/libguile/lang.c @@ -62,6 +62,9 @@ * in all data structures. */ +#ifdef SCM_ENABLE_ELISP +#if 0 + SCM_DEFINE (scm_nil_cons, "nil-cons", 2, 0, 0, (SCM x, SCM y), "Create a new cons cell with @var{x} as the car and @var{y} as\n" @@ -145,17 +148,24 @@ SCM_DEFINE1 (scm_nil_eq, "nil-eq", scm_tc7_rpsubr, } #undef FUNC_NAME +#endif /* 0 */ void scm_init_lang () { +#if 0 #ifndef SCM_MAGIC_SNARFER #include "libguile/lang.x" #endif scm_make_synt ("nil-while", scm_makacro, scm_m_while); +#endif + + scm_c_define ("%nil", SCM_ELISP_NIL); } +#endif /* SCM_ENABLE_ELISP */ + /* Local Variables: c-file-style: "gnu" diff --git a/libguile/lang.h b/libguile/lang.h index ae10869b5..dba8a8f28 100644 --- a/libguile/lang.h +++ b/libguile/lang.h @@ -50,10 +50,14 @@ +#ifdef SCM_ENABLE_ELISP + +#define SCM_NILP(x) (SCM_EQ_P ((x), SCM_ELISP_NIL)) + +#if 0 SCM_API SCM scm_lisp_nil; SCM_API SCM scm_lisp_t; -#define SCM_NILP(x) (SCM_EQ_P ((x), scm_lisp_nil)) #define SCM_NILNULLP(x) (SCM_NILP (x) || SCM_NULLP (x)) #define SCM_NIL2EOL(x, tmp) (SCM_EQ_P ((tmp = (x)), scm_lisp_nil) ? SCM_EOL : tmp) #define SCM_EOL2NIL(x, tmp) (SCM_NULLP (tmp = (x)) ? scm_lisp_nil : tmp) @@ -68,7 +72,13 @@ SCM_API SCM scm_nil_cdr (SCM x); SCM_API SCM scm_null (SCM x); SCM_API SCM scm_m_while (SCM exp, SCM env); SCM_API SCM scm_nil_eq (SCM x, SCM y); +#endif /* 0 */ SCM_API void scm_init_lang (void); +#else /* ! SCM_ENABLE_ELISP */ +#define SCM_NILP(x) 0 +#endif /* ! SCM_ENABLE_ELISP */ + +#define SCM_NULL_OR_NIL_P(x) (SCM_NULLP (x) || SCM_NILP (x)) #endif /* SCM_LANG_H */ diff --git a/libguile/list.c b/libguile/list.c index 8d6237d20..2197a61f5 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -43,6 +43,7 @@ #include "libguile/_scm.h" #include "libguile/eq.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/list.h" @@ -165,7 +166,7 @@ SCM_DEFINE (scm_null_p, "null?", 1, 0, 0, "Return @code{#t} iff @var{x} is the empty list, else @code{#f}.") #define FUNC_NAME s_scm_null_p { - return SCM_BOOL (SCM_NULLP (x)); + return SCM_BOOL (SCM_NULL_OR_NIL_P (x)); } #undef FUNC_NAME @@ -192,11 +193,11 @@ scm_ilength(SCM sx) SCM hare = sx; do { - if (SCM_NULLP(hare)) return i; + if (SCM_NULL_OR_NIL_P(hare)) return i; if (SCM_NCONSP(hare)) return -1; hare = SCM_CDR(hare); i++; - if (SCM_NULLP(hare)) return i; + if (SCM_NULL_OR_NIL_P(hare)) return i; if (SCM_NCONSP(hare)) return -1; hare = SCM_CDR(hare); i++; @@ -259,7 +260,7 @@ SCM_DEFINE (scm_append, "append", 0, 0, 1, lloc = SCM_CDRLOC (*lloc); arg = SCM_CDR (arg); } - SCM_VALIDATE_NULL (SCM_ARGn, arg); + SCM_VALIDATE_NULL_OR_NIL (SCM_ARGn, arg); arg = SCM_CAR (args); args = SCM_CDR (args); }; @@ -288,7 +289,7 @@ SCM_DEFINE (scm_append_x, "append!", 0, 0, 1, lists = SCM_CDR (lists); if (SCM_NULLP (lists)) { return arg; - } else if (!SCM_NULLP (arg)) { + } else if (!SCM_NULL_OR_NIL_P (arg)) { SCM_VALIDATE_CONS (SCM_ARG1, arg); SCM_SETCDR (scm_last_pair (arg), scm_append_x (lists)); return arg; @@ -308,8 +309,8 @@ SCM_DEFINE (scm_last_pair, "last-pair", 1, 0, 0, SCM tortoise = lst; SCM hare = lst; - if (SCM_NULLP (lst)) - return SCM_EOL; + if (SCM_NULL_OR_NIL_P (lst)) + return lst; SCM_VALIDATE_CONS (SCM_ARG1, lst); do { @@ -340,11 +341,11 @@ SCM_DEFINE (scm_reverse, "reverse", 1, 0, 0, SCM hare = lst; do { - if (SCM_NULLP(hare)) return result; + if (SCM_NULL_OR_NIL_P(hare)) return result; SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME); result = scm_cons (SCM_CAR (hare), result); hare = SCM_CDR (hare); - if (SCM_NULLP(hare)) return result; + if (SCM_NULL_OR_NIL_P(hare)) return result; SCM_ASSERT(SCM_CONSP(hare), lst, 1, FUNC_NAME); result = scm_cons (SCM_CAR (hare), result); hare = SCM_CDR (hare); @@ -375,7 +376,7 @@ SCM_DEFINE (scm_reverse_x, "reverse!", 1, 1, 0, else SCM_VALIDATE_LIST (2, new_tail); - while (SCM_NNULLP (lst)) + while (!SCM_NULL_OR_NIL_P (lst)) { SCM old_tail = SCM_CDR (lst); SCM_SETCDR (lst, new_tail); @@ -406,7 +407,7 @@ SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0, lst = SCM_CDR (lst); } }; - if (SCM_NULLP (lst)) + if (SCM_NULL_OR_NIL_P (lst)) SCM_OUT_OF_RANGE (2, k); else SCM_WRONG_TYPE_ARG (1, list); @@ -431,7 +432,7 @@ SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0, lst = SCM_CDR (lst); } }; - if (SCM_NULLP (lst)) + if (SCM_NULL_OR_NIL_P (lst)) SCM_OUT_OF_RANGE (2, k); else SCM_WRONG_TYPE_ARG (1, list); @@ -479,7 +480,7 @@ SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, lst = SCM_CDR (lst); } }; - if (SCM_NULLP (lst)) + if (SCM_NULL_OR_NIL_P (lst)) SCM_OUT_OF_RANGE (2, k); else SCM_WRONG_TYPE_ARG (1, list); @@ -555,7 +556,7 @@ SCM_DEFINE (scm_list_copy, "list-copy", 1, 0, 0, SCM scm_c_memq (SCM obj, SCM list) { - for (; !SCM_NULLP (list); list = SCM_CDR (list)) + for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR (list)) { if (SCM_EQ_P (SCM_CAR (list), obj)) return list; @@ -591,7 +592,7 @@ SCM_DEFINE (scm_memv, "memv", 2, 0, 0, #define FUNC_NAME s_scm_memv { SCM_VALIDATE_LIST (2, lst); - for (; !SCM_NULLP (lst); lst = SCM_CDR (lst)) + for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) { if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x))) return lst; @@ -612,7 +613,7 @@ SCM_DEFINE (scm_member, "member", 2, 0, 0, #define FUNC_NAME s_scm_member { SCM_VALIDATE_LIST (2, lst); - for (; !SCM_NULLP (lst); lst = SCM_CDR (lst)) + for (; !SCM_NULL_OR_NIL_P (lst); lst = SCM_CDR (lst)) { if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x))) return lst; diff --git a/libguile/load.c b/libguile/load.c index d26f5aca8..0c8011534 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -55,6 +55,7 @@ #include "libguile/root.h" #include "libguile/strings.h" #include "libguile/modules.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/load.h" @@ -300,7 +301,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, SCM walk; max_path_len = 0; - for (walk = path; !SCM_NULLP (walk); walk = SCM_CDR (walk)) + for (walk = path; !SCM_NULL_OR_NIL_P (walk); walk = SCM_CDR (walk)) { SCM elt = SCM_CAR (walk); SCM_ASSERT_TYPE (SCM_STRINGP (elt), path, 1, FUNC_NAME, @@ -338,7 +339,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, SCM walk; max_ext_len = 0; - for (walk = extensions; !SCM_NULLP (walk); walk = SCM_CDR (walk)) + for (walk = extensions; !SCM_NULL_OR_NIL_P (walk); walk = SCM_CDR (walk)) { SCM elt = SCM_CAR (walk); SCM_ASSERT_TYPE (SCM_STRINGP (elt), elt, 3, FUNC_NAME, @@ -356,12 +357,12 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, char *buf = SCM_MUST_MALLOC (buf_size); /* This simplifies the loop below a bit. */ - if (SCM_NULLP (extensions)) + if (SCM_NULL_OR_NIL_P (extensions)) extensions = scm_listofnullstr; /* Try every path element. At this point, we know the path is a proper list of strings. */ - for (; !SCM_NULLP (path); path = SCM_CDR (path)) + for (; !SCM_NULL_OR_NIL_P (path); path = SCM_CDR (path)) { size_t len; SCM dir = SCM_CAR (path); @@ -377,7 +378,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0, /* Try every extension. At this point, we know the extension list is a proper, nonempty list of strings. */ - for (exts = extensions; !SCM_NULLP (exts); exts = SCM_CDR (exts)) + for (exts = extensions; !SCM_NULL_OR_NIL_P (exts); exts = SCM_CDR (exts)) { SCM ext = SCM_CAR (exts); size_t ext_len = SCM_STRING_LENGTH (ext); diff --git a/libguile/options.c b/libguile/options.c index e95c12a85..731e62f79 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -47,6 +47,7 @@ #include "libguile/_scm.h" #include "libguile/mallocs.h" #include "libguile/strings.h" +#include "libguile/lang.h" #include "libguile/options.h" @@ -198,7 +199,7 @@ change_option_setting (SCM args, scm_t_option options[], unsigned int n, const c flags[i] = options[i].val; } - while (!SCM_NULLP (args)) + while (!SCM_NULL_OR_NIL_P (args)) { SCM name = SCM_CAR (args); int found = 0; @@ -257,7 +258,7 @@ scm_options (SCM args, scm_t_option options[], unsigned int n, const char *s) { if (SCM_UNBNDP (args)) return get_option_setting (options, n); - else if (!SCM_NULLP (args) && !SCM_CONSP (args)) + else if (!SCM_NULL_OR_NIL_P (args) && !SCM_CONSP (args)) /* Dirk:FIXME:: This criterion should be improved. IMO it is better to * demand that args is #t if documentation should be shown than to say * that every argument except a list will print out documentation. */ diff --git a/libguile/posix.c b/libguile/posix.c index 6e2393570..1ef46d1db 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -54,6 +54,7 @@ #include "libguile/feature.h" #include "libguile/strings.h" #include "libguile/vectors.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/posix.h" @@ -916,7 +917,7 @@ environ_list_to_c (SCM envlist, int arg, const char *proc) result = (char **) malloc ((num_strings + 1) * sizeof (char *)); if (result == NULL) scm_memory_error (proc); - for (i = 0; !SCM_NULLP (envlist); ++i, envlist = SCM_CDR (envlist)) + for (i = 0; !SCM_NULL_OR_NIL_P (envlist); ++i, envlist = SCM_CDR (envlist)) { SCM str = SCM_CAR (envlist); int len; diff --git a/libguile/print.c b/libguile/print.c index 64bd23e89..e28284637 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -62,6 +62,7 @@ #include "libguile/strings.h" #include "libguile/strports.h" #include "libguile/vectors.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/print.h" @@ -74,7 +75,7 @@ char *scm_isymnames[] = { - /* This table must agree with the declarations */ + /* This table must agree with the list of SCM_IM_ constants in tags.h */ "#@and", "#@begin", "#@case", @@ -113,17 +114,17 @@ char *scm_isymnames[] = /* Multi-language support */ "#@nil-cond", - "#@nil-ify", - "#@t-ify", - "#@0-cond", - "#@0-ify", - "#@1-ify", "#@bind", "#@delay", "#@call-with-values", - "#" + "#", + + /* Elisp nil value. This is its Scheme name; whenever it's printed + in Elisp, it should appear as the symbol `nil'. */ + + "#nil" }; scm_t_option scm_print_opts[] = { @@ -781,7 +782,7 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate) /* CHECK_INTS; */ scm_iprin1 (SCM_CAR (exp), port, pstate); } - if (!SCM_NULLP (exp)) + if (!SCM_NULL_OR_NIL_P (exp)) { scm_puts (" . ", port); scm_iprin1 (exp, port, pstate); @@ -822,7 +823,7 @@ fancy_printing: scm_iprin1 (SCM_CAR (exp), port, pstate); } } - if (!SCM_NULLP (exp)) + if (!SCM_NULL_OR_NIL_P (exp)) { scm_puts (" . ", port); scm_iprin1 (exp, port, pstate); diff --git a/libguile/read.c b/libguile/read.c index 1b8979ce1..33a7e37f0 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -72,7 +72,7 @@ scm_t_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "case-insensitive", 0, "Convert symbols to lower case."}, { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), - "Style of keyword recognition: #f or 'prefix"} + "Style of keyword recognition: #f or 'prefix."} }; SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, diff --git a/libguile/script.c b/libguile/script.c index 72fc04180..b782dbce7 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -515,7 +515,7 @@ scm_compile_shell_switches (int argc, char **argv) else if (! strcmp (argv[i], "-e")) /* entry point */ { if (++i < argc) - entry_point = gh_symbol2scm (argv[i]); + entry_point = scm_str2symbol (argv[i]); else scm_shell_usage (1, "missing argument to `-e' switch"); } diff --git a/libguile/sort.c b/libguile/sort.c index 05991b7b3..7a3b61ab8 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -86,6 +86,7 @@ char *alloca (); #include "libguile/feature.h" #include "libguile/root.h" #include "libguile/vectors.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/sort.h" @@ -457,7 +458,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, SCM *vp; cmp_fun_t cmp = scm_cmp_function (less); - if (SCM_NULLP (items)) + if (SCM_NULL_OR_NIL_P (items)) return SCM_BOOL_T; SCM_VALIDATE_NIM (2,less); @@ -530,9 +531,9 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, cmp_fun_t cmp = scm_cmp_function (less); SCM_VALIDATE_NIM (3,less); - if (SCM_NULLP (alist)) + if (SCM_NULL_OR_NIL_P (alist)) return blist; - else if (SCM_NULLP (blist)) + else if (SCM_NULL_OR_NIL_P (blist)) return alist; else { @@ -584,9 +585,9 @@ scm_merge_list_x (SCM alist, SCM blist, { SCM build, last; - if (SCM_NULLP (alist)) + if (SCM_NULL_OR_NIL_P (alist)) return blist; - else if (SCM_NULLP (blist)) + else if (SCM_NULL_OR_NIL_P (blist)) return alist; else { @@ -641,9 +642,9 @@ SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0, long alen, blen; /* list lengths */ SCM_VALIDATE_NIM (3,less); - if (SCM_NULLP (alist)) + if (SCM_NULL_OR_NIL_P (alist)) return blist; - else if (SCM_NULLP (blist)) + else if (SCM_NULL_OR_NIL_P (blist)) return alist; else { @@ -715,8 +716,8 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, #define FUNC_NAME s_scm_sort_x { long len; /* list/vector length */ - if (SCM_NULLP(items)) - return SCM_EOL; + if (SCM_NULL_OR_NIL_P (items)) + return items; SCM_VALIDATE_NIM (2,less); @@ -748,8 +749,8 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0, "elements. This is not a stable sort.") #define FUNC_NAME s_scm_sort { - if (SCM_NULLP(items)) - return SCM_EOL; + if (SCM_NULL_OR_NIL_P (items)) + return items; SCM_VALIDATE_NIM (2,less); if (SCM_CONSP (items)) @@ -846,8 +847,8 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, { long len; /* list/vector length */ - if (SCM_NULLP (items)) - return SCM_EOL; + if (SCM_NULL_OR_NIL_P (items)) + return items; SCM_VALIDATE_NIM (2,less); if (SCM_CONSP (items)) @@ -885,8 +886,8 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, #define FUNC_NAME s_scm_stable_sort { long len; /* list/vector length */ - if (SCM_NULLP (items)) - return SCM_EOL; + if (SCM_NULL_OR_NIL_P (items)) + return items; SCM_VALIDATE_NIM (2,less); if (SCM_CONSP (items)) diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 48df4e6a6..f00828b79 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -161,7 +161,7 @@ scm_srcprops_to_plist (SCM obj) plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist); plist = scm_acons (scm_sym_column, SCM_MAKINUM (SRCPROPCOL (obj)), plist); plist = scm_acons (scm_sym_line, SCM_MAKINUM (SRCPROPLINE (obj)), plist); - plist = scm_acons (scm_sym_breakpoint, SRCPROPBRK (obj), plist); + plist = scm_acons (scm_sym_breakpoint, SCM_BOOL (SRCPROPBRK (obj)), plist); return plist; } @@ -224,7 +224,7 @@ 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 = SRCPROPBRK (p); + if (SCM_EQ_P (scm_sym_breakpoint, key)) p = SCM_BOOL (SRCPROPBRK (p)); else if (SCM_EQ_P (scm_sym_line, key)) p = SCM_MAKINUM (SRCPROPLINE (p)); else if (SCM_EQ_P (scm_sym_column, key)) p = SCM_MAKINUM (SRCPROPCOL (p)); else if (SCM_EQ_P (scm_sym_filename, key)) p = SRCPROPFNAME (p); diff --git a/libguile/srcprop.h b/libguile/srcprop.h index 795aaf435..89f72e5ab 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -97,8 +97,7 @@ typedef struct scm_t_srcprops_chunk #define SCM_SOURCE_PROPERTY_FLAG_BREAK (1L << 16) #define SRCPROPSP(p) (SCM_TYP16_PREDICATE (scm_tc16_srcprops, p)) -#define SRCPROPBRK(p) \ - (SCM_BOOL (SCM_CELL_WORD_0 (p) & SCM_SOURCE_PROPERTY_FLAG_BREAK)) +#define SRCPROPBRK(p) (SCM_CELL_WORD_0 (p) & SCM_SOURCE_PROPERTY_FLAG_BREAK) #define SRCPROPPOS(p) ((scm_t_srcprops *) SCM_CELL_WORD_1 (p))->pos #define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12) #define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL) @@ -118,7 +117,7 @@ typedef struct scm_t_srcprops_chunk #define SRCBRKP(x) (!SCM_IMP (t.arg1 = scm_whash_lookup (scm_source_whash, (x)))\ && SRCPROPSP (t.arg1)\ - && (SCM_CELL_WORD_0 (t.arg1) & (1L << 16))) + && SRCPROPBRK (t.arg1)) #define PROCTRACEP(x) (!SCM_FALSEP (scm_procedure_property (x, scm_sym_trace))) diff --git a/libguile/tags.h b/libguile/tags.h index 3f937afa1..1e9090ede 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -458,15 +458,10 @@ SCM_API char *scm_isymnames[]; /* defined in print.c */ /* Multi-language support */ #define SCM_IM_NIL_COND SCM_MAKISYM (25) -#define SCM_IM_NIL_IFY SCM_MAKISYM (26) -#define SCM_IM_T_IFY SCM_MAKISYM (27) -#define SCM_IM_0_COND SCM_MAKISYM (28) -#define SCM_IM_0_IFY SCM_MAKISYM (29) -#define SCM_IM_1_IFY SCM_MAKISYM (30) -#define SCM_IM_BIND SCM_MAKISYM (31) +#define SCM_IM_BIND SCM_MAKISYM (26) -#define SCM_IM_DELAY SCM_MAKISYM (32) -#define SCM_IM_CALL_WITH_VALUES SCM_MAKISYM (33) +#define SCM_IM_DELAY SCM_MAKISYM (27) +#define SCM_IM_CALL_WITH_VALUES SCM_MAKISYM (28) /* When a variable is unbound this is marked by the SCM_UNDEFINED * value. The following is an unbound value which can be handled on @@ -477,10 +472,13 @@ SCM_API char *scm_isymnames[]; /* defined in print.c */ * used instead. It is not ideal to let this kind of unique and * strange values loose on the Scheme level. */ -#define SCM_UNBOUND SCM_MAKIFLAG (34) +#define SCM_UNBOUND SCM_MAKIFLAG (29) #define SCM_UNBNDP(x) (SCM_EQ_P ((x), SCM_UNDEFINED)) +/* The Elisp nil value. */ +#define SCM_ELISP_NIL SCM_MAKIFLAG (30) + /* Dispatching aids: diff --git a/libguile/throw.c b/libguile/throw.c index 04c5263e1..91f07f61a 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -58,6 +58,7 @@ #include "libguile/stacks.h" #include "libguile/fluids.h" #include "libguile/ports.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/throw.h" @@ -401,7 +402,7 @@ scm_handle_by_proc_catching_all (void *handler_data, SCM tag, SCM throw_args) int scm_exit_status (SCM args) { - if (SCM_NNULLP (args)) + if (!SCM_NULL_OR_NIL_P (args)) { SCM cqa = SCM_CAR (args); diff --git a/libguile/validate.h b/libguile/validate.h index 21aadbe57..9068b8278 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -323,6 +323,8 @@ #define SCM_VALIDATE_NULL(pos, scm) SCM_MAKE_VALIDATE (pos, scm, NULLP) +#define SCM_VALIDATE_NULL_OR_NIL(pos, scm) SCM_MAKE_VALIDATE (pos, scm, NULL_OR_NIL_P) + #define SCM_VALIDATE_CONS(pos, scm) SCM_MAKE_VALIDATE (pos, scm, CONSP) #define SCM_VALIDATE_LIST(pos, lst) \ diff --git a/libguile/vectors.c b/libguile/vectors.c index db9c18669..5868ba4f0 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -46,6 +46,7 @@ #include "libguile/eq.h" #include "libguile/root.h" #include "libguile/strings.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/vectors.h" @@ -101,7 +102,7 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1, SCM_VALIDATE_LIST_COPYLEN (1, l, i); res = scm_c_make_vector (i, SCM_UNSPECIFIED); data = SCM_VELTS (res); - while (!SCM_NULLP (l)) + while (!SCM_NULL_OR_NIL_P (l)) { *data++ = SCM_CAR (l); l = SCM_CDR (l); diff --git a/libguile/weaks.c b/libguile/weaks.c index 277b102b3..d5fc5a060 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -44,6 +44,7 @@ #include "libguile/_scm.h" #include "libguile/vectors.h" +#include "libguile/lang.h" #include "libguile/validate.h" #include "libguile/weaks.h" @@ -144,7 +145,7 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1, res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED); data = SCM_VELTS (res); - while (!SCM_NULLP (l)) + while (!SCM_NULL_OR_NIL_P (l)) { *data++ = SCM_CAR (l); l = SCM_CDR (l);