diff options
Diffstat (limited to 'libguile/eval.c')
-rw-r--r-- | libguile/eval.c | 168 |
1 files changed, 60 insertions, 108 deletions
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"); } |