summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/ChangeLog75
-rw-r--r--libguile/backtrace.c2
-rw-r--r--libguile/debug.h18
-rw-r--r--libguile/deprecated.h14
-rw-r--r--libguile/eval.c383
-rw-r--r--libguile/eval.h10
-rw-r--r--libguile/gdbint.c10
7 files changed, 302 insertions, 210 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 87e3ac868..70611d05c 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,4 +1,77 @@
-2004-03-24 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
+2004-03-29 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
+
+ Introduce scm_debug_mode_p as a replacement for scm_debug_mode and
+ SCM_DEBUGGINGP:
+
+ * debug.h (scm_debug_mode_p, scm_debug_mode, SCM_DEBUGGINGP),
+ eval.c (scm_debug_mode_p): Deprecated scm_debug_mode and
+ SCM_DEBUGGINGP. Provided scm_debug_mode_p instead, to have one
+ single interface that also matches the naming conventions.
+ Probably scm_debug_mode_p should be part of the private interface
+ anyway.
+
+ * debug.h (scm_debug_mode_p), backtrace.c (display_error_body),
+ eval.c (SCM_APPLY, scm_trampoline_0, scm_trampoline_1,
+ scm_trampoline_2): Change uses of scm_debug_mode or SCM_DEBUGGINGP
+ to scm_debug_mode_p.
+
+
+ Deprecate direct access to scm_ceval, scm_deval and scm_ceval_ptr:
+
+ * eval.h (scm_ceval, scm_deval, scm_ceval_ptr), debug.h
+ (scm_ceval_ptr): Deprecated. Moved declaration of scm_ceval_ptr
+ from debug.h to eval.h.
+
+ * debug.h (SCM_RESET_DEBUG_MODE): Don't access scm_ceval_ptr any
+ more, just leave it with setting scm_debug_mode_p, which is
+ equivalent for practical purposes.
+
+ * deprecated.h (SCM_XEVAL, SCM_XEVALCAR): Call scm_i_eval_x
+ instead of *scm_ceval_ptr. Leave all evaluating to scm_i_eval_x.
+
+ * gdbint.c (gdb_eval): Call scm_i_eval_x instead of scm_ceval.
+
+ * eval.c (ceval, deval, scm_ceval, scm_deval): Made scm_ceval
+ static and renamed it to ceval throughout. Provide a new exported
+ but deprecated function scm_ceval as a wrapper for backwards
+ compatibility. The same is done for the deval/scm_deval pair of
+ functions.
+
+ * eval.c (CEVAL, SCM_CEVAL): Renamed SCM_CEVAL to CEVAL
+ throughout. Defined CEVAL to ceval or deval, based on compilation
+ phase.
+
+ * eval.c (SCM_XEVAL, SCM_XEVALCAR): Dispatch on scm_debug_mode_p
+ to ceval and deval instead of calling *scm_ceval_ptr.
+
+ * eval.c (dispatching_eval): New deprecated static function.
+
+ * eval.c (scm_ceval_ptr): Initialized to dispatching_eval in order
+ to emulate its old behaviour as closely as possible.
+
+
+ Change the evaluator such that only expressions for which pair? is
+ true are passed to CEVAL, and such that all other expressions are
+ evaluated outside of CEVAL:
+
+ * eval.c (EVAL): New, provided in analogy to EVALCAR. Evaluate an
+ expression that is assumed to be memoized already. All but
+ expressions of the form '(<form> <form> ...)' are evaluated inline
+ without calling an evaluator.
+
+ * eval.c (SCM_XEVAL, SCM_XEVALCAR, EVALCAR): Evaluate all but
+ expressions of the form '(<form> <form> ...)' inline without
+ calling an evaluator.
+
+ * eval.c (scm_i_eval_x, scm_i_eval, scm_ceval, scm_deval): Handle
+ the special case of unmemoized symbols passed on the top level.
+
+ * eval.c (CEVAL): Change calls to CEVAL to EVAL, except where it
+ is known that the expression passed to CEVAL is of the form
+ '(<form> <form> ...)'. Remove handling of the tc7-objects, since
+ now it is known that the input expression of CEVAL is a pair.
+
+2004-03-29 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
* eval.c (is_self_quoting_p): New static function.
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 860197805..ab96ba5d6 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -218,7 +218,7 @@ display_error_body (struct display_error_args *a)
SCM prev_frame = SCM_BOOL_F;
SCM pname = a->subr;
- if (SCM_DEBUGGINGP
+ if (scm_debug_mode_p
&& SCM_STACKP (a->stack)
&& SCM_STACK_LENGTH (a->stack) > 0)
{
diff --git a/libguile/debug.h b/libguile/debug.h
index ee272629d..de4a0054b 100644
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -3,7 +3,8 @@
#ifndef SCM_DEBUG_H
#define SCM_DEBUG_H
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004
+ * Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -59,9 +60,7 @@ SCM_API scm_t_option scm_debug_opts[];
#define SCM_SHOW_FILE_NAME scm_debug_opts[13].val
#define SCM_N_DEBUG_OPTIONS 14
-SCM_API SCM (*scm_ceval_ptr) (SCM exp, SCM env);
-
-SCM_API int scm_debug_mode;
+SCM_API int scm_debug_mode_p;
SCM_API int scm_check_entry_p;
SCM_API int scm_check_apply_p;
SCM_API int scm_check_exit_p;
@@ -74,9 +73,8 @@ do {\
&& !SCM_FALSEP (SCM_APPLY_FRAME_HDLR);\
scm_check_exit_p = (SCM_EXIT_FRAME_P || SCM_TRACE_P)\
&& !SCM_FALSEP (SCM_EXIT_FRAME_HDLR);\
- scm_debug_mode = SCM_DEVAL_P\
+ scm_debug_mode_p = SCM_DEVAL_P\
|| scm_check_entry_p || scm_check_apply_p || scm_check_exit_p;\
- scm_ceval_ptr = scm_debug_mode ? scm_deval : scm_ceval;\
} while (0)
/* {Evaluator}
@@ -128,8 +126,6 @@ typedef struct scm_t_debug_frame
#define SCM_SET_MACROEXP(x) ((x).status |= SCM_MACROEXPF)
#define SCM_CLEAR_MACROEXP(x) ((x).status &= ~SCM_MACROEXPF)
-#define SCM_DEBUGGINGP scm_debug_mode
-
/* {Debug Objects}
*/
@@ -177,9 +173,15 @@ SCM_API SCM scm_debug_hang (SCM obj);
#endif /*GUILE_DEBUG*/
#if SCM_ENABLE_DEPRECATED == 1
+
#define CHECK_ENTRY scm_check_entry_p
#define CHECK_APPLY scm_check_apply_p
#define CHECK_EXIT scm_check_exit_p
+
+/* Deprecated in guile 1.7.0 on 2004-03-29. */
+#define SCM_DEBUGGINGP scm_debug_mode_p
+#define scm_debug_mode scm_debug_mode_p
+
#endif
#endif /* SCM_DEBUG_H */
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index dd9c68bd9..d14790740 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -5,7 +5,7 @@
#ifndef SCM_DEPRECATED_H
#define SCM_DEPRECATED_H
-/* Copyright (C) 2003 Free Software Foundation, Inc.
+/* Copyright (C) 2003,2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -67,14 +67,10 @@ SCM_API const char scm_s_formals[];
#define SCM_EVALIM(x, env) (SCM_ILOCP (x) \
? *scm_ilookup ((x), env) \
: SCM_EVALIM2(x))
-#define SCM_XEVAL(x, env) (SCM_IMP (x) \
- ? SCM_EVALIM2(x) \
- : (*scm_ceval_ptr) ((x), (env)))
-#define SCM_XEVALCAR(x, env) (SCM_IMP (SCM_CAR (x)) \
- ? SCM_EVALIM (SCM_CAR (x), env) \
- : (SCM_SYMBOLP (SCM_CAR (x)) \
- ? *scm_lookupcar (x, env, 1) \
- : (*scm_ceval_ptr) (SCM_CAR (x), env)))
+#define SCM_XEVAL(x, env) (scm_i_eval_x ((x), (env)))
+#define SCM_XEVALCAR(x, env) (SCM_SYMBOLP (SCM_CAR (x)) \
+ ? *scm_lookupcar (x, env, 1) \
+ : scm_i_eval_x (SCM_CAR (x), (env)))
#define scm_substring_move_left_x scm_substring_move_x
diff --git a/libguile/eval.c b/libguile/eval.c
index fddc50c58..62a5748b5 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004
+ * Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -17,13 +18,11 @@
-/* This file is read twice in order to produce debugging versions of
- * scm_ceval and scm_apply. These functions, scm_deval and
- * scm_dapply, are produced when we define the preprocessor macro
- * DEVAL. The file is divided into sections which are treated
- * differently with respect to DEVAL. The heads of these sections are
- * marked with the string "SECTION:".
- */
+/* This file is read twice in order to produce debugging versions of ceval and
+ * scm_apply. These functions, deval and scm_dapply, are produced when we
+ * define the preprocessor macro DEVAL. The file is divided into sections
+ * which are treated differently with respect to DEVAL. The heads of these
+ * sections are marked with the string "SECTION:". */
/* SECTION: This code is compiled once.
*/
@@ -907,20 +906,6 @@ m_expand_body (const SCM forms, const SCM env)
}
}
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-/* Deprecated in guile 1.7.0 on 2003-11-09. */
-SCM
-scm_m_expand_body (SCM exprs, SCM env)
-{
- scm_c_issue_deprecation_warning
- ("`scm_m_expand_body' is deprecated.");
- m_expand_body (exprs, env);
- return exprs;
-}
-
-#endif
-
/* Start of the memoizers for the standard R5RS builtin macros. */
@@ -2040,10 +2025,18 @@ scm_m_atfop (SCM expr, SCM env SCM_UNUSED)
#endif /* SCM_ENABLE_ELISP */
-/* Start of the memoizers for deprecated macros. */
+#if (SCM_ENABLE_DEPRECATED == 1)
+/* Deprecated in guile 1.7.0 on 2003-11-09. */
+SCM
+scm_m_expand_body (SCM exprs, SCM env)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_m_expand_body' is deprecated.");
+ m_expand_body (exprs, env);
+ return exprs;
+}
-#if (SCM_ENABLE_DEPRECATED == 1)
SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine);
@@ -2068,10 +2061,6 @@ scm_m_undefine (SCM expr, SCM env)
return SCM_UNSPECIFIED;
}
-#endif
-
-
-#if (SCM_ENABLE_DEPRECATED == 1)
SCM
scm_macroexp (SCM x, SCM env)
@@ -2192,17 +2181,6 @@ unmemocar (SCM form, SCM env)
}
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-SCM
-scm_unmemocar (SCM form, SCM env)
-{
- return unmemocar (form, env);
-}
-
-#endif
-
-
SCM
scm_unmemocopy (SCM x, SCM env)
{
@@ -2425,6 +2403,16 @@ loop:
}
+#if (SCM_ENABLE_DEPRECATED == 1)
+
+SCM
+scm_unmemocar (SCM form, SCM env)
+{
+ return unmemocar (form, env);
+}
+
+#endif
+
/*****************************************************************************/
/*****************************************************************************/
/* The definitions for execution start here. */
@@ -2459,36 +2447,45 @@ scm_badargsp (SCM formals, SCM args)
-/* The evaluator contains a plethora of EVAL symbols.
- * This is an attempt at explanation.
+/* The evaluator contains a plethora of EVAL symbols. This is an attempt at
+ * explanation.
*
- * The following macros should be used in code which is read twice
- * (where the choice of evaluator is hard soldered):
+ * The following macros should be used in code which is read twice (where the
+ * choice of evaluator is hard soldered):
*
- * SCM_CEVAL is the symbol used within one evaluator to call itself.
- * Originally, it is defined to scm_ceval, but is redefined to
- * scm_deval during the second pass.
+ * CEVAL is the symbol used within one evaluator to call itself.
+ * Originally, it is defined to ceval, but is redefined to deval during the
+ * second pass.
*
* SCM_EVALIM is used when it is known that the expression is an
* immediate. (This macro never calls an evaluator.)
- *
- * EVALCAR evaluates the car of an expression.
+ *
+ * EVAL evaluates an expression that is expected to have its symbols already
+ * memoized. Expressions that are not of the form '(<form> <form> ...)' are
+ * evaluated inline without calling an evaluator.
+ *
+ * EVALCAR evaluates the car of an expression 'X:(Y:<form> <form> ...)',
+ * potentially replacing a symbol at the position Y:<form> by its memoized
+ * variable. If Y:<form> is not of the form '(<form> <form> ...)', the
+ * evaluation is performed inline without calling an evaluator.
*
* The following macros should be used in code which is read once
* (where the choice of evaluator is dynamic):
*
- * SCM_XEVAL takes care of immediates without calling an evaluator. It
- * then calls scm_ceval *or* scm_deval, depending on the debugging
- * mode.
+ * SCM_XEVAL corresponds to EVAL, but uses ceval *or* deval depending on the
+ * debugging mode.
*
- * SCM_XEVALCAR corresponds to EVALCAR, but uses scm_ceval *or* scm_deval
- * depending on the debugging mode.
+ * SCM_XEVALCAR corresponds to EVALCAR, but uses ceval *or* deval depending
+ * on the debugging mode.
*
* The main motivation for keeping this plethora is efficiency
* together with maintainability (=> locality of code).
*/
-#define SCM_CEVAL scm_ceval
+static SCM ceval (SCM x, SCM env);
+static SCM deval (SCM x, SCM env);
+#define CEVAL ceval
+
#define SCM_EVALIM2(x) \
((SCM_EQ_P ((x), SCM_EOL) \
@@ -2497,24 +2494,52 @@ scm_badargsp (SCM formals, SCM args)
(x))
#define SCM_EVALIM(x, env) (SCM_ILOCP (x) \
- ? *scm_ilookup ((x), env) \
+ ? *scm_ilookup ((x), (env)) \
: SCM_EVALIM2(x))
-#define SCM_XEVAL(x, env) (SCM_IMP (x) \
- ? SCM_EVALIM2(x) \
- : (*scm_ceval_ptr) ((x), (env)))
-
-#define SCM_XEVALCAR(x, env) (SCM_IMP (SCM_CAR (x)) \
- ? SCM_EVALIM (SCM_CAR (x), env) \
- : (SCM_SYMBOLP (SCM_CAR (x)) \
- ? *scm_lookupcar (x, env, 1) \
- : (*scm_ceval_ptr) (SCM_CAR (x), env)))
-
-#define EVALCAR(x, env) (SCM_IMP (SCM_CAR (x)) \
- ? SCM_EVALIM (SCM_CAR (x), env) \
- : (SCM_SYMBOLP (SCM_CAR (x)) \
- ? *scm_lookupcar (x, env, 1) \
- : SCM_CEVAL (SCM_CAR (x), env)))
+#define SCM_XEVAL(x, env) \
+ (SCM_IMP (x) \
+ ? SCM_EVALIM2 (x) \
+ : (SCM_VARIABLEP (x) \
+ ? SCM_VARIABLE_REF (x) \
+ : (SCM_CONSP (x) \
+ ? (scm_debug_mode_p \
+ ? deval ((x), (env)) \
+ : ceval ((x), (env))) \
+ : (x))))
+
+#define SCM_XEVALCAR(x, env) \
+ (SCM_IMP (SCM_CAR (x)) \
+ ? SCM_EVALIM (SCM_CAR (x), (env)) \
+ : (SCM_VARIABLEP (SCM_CAR (x)) \
+ ? SCM_VARIABLE_REF (SCM_CAR (x)) \
+ : (SCM_CONSP (SCM_CAR (x)) \
+ ? (scm_debug_mode_p \
+ ? deval (SCM_CAR (x), (env)) \
+ : ceval (SCM_CAR (x), (env))) \
+ : (!SCM_SYMBOLP (SCM_CAR (x)) \
+ ? SCM_CAR (x) \
+ : *scm_lookupcar ((x), (env), 1)))))
+
+#define EVAL(x, env) \
+ (SCM_IMP (x) \
+ ? SCM_EVALIM ((x), (env)) \
+ : (SCM_VARIABLEP (x) \
+ ? SCM_VARIABLE_REF (x) \
+ : (SCM_CONSP (x) \
+ ? CEVAL ((x), (env)) \
+ : (x))))
+
+#define EVALCAR(x, env) \
+ (SCM_IMP (SCM_CAR (x)) \
+ ? SCM_EVALIM (SCM_CAR (x), (env)) \
+ : (SCM_VARIABLEP (SCM_CAR (x)) \
+ ? SCM_VARIABLE_REF (SCM_CAR (x)) \
+ : (SCM_CONSP (SCM_CAR (x)) \
+ ? CEVAL (SCM_CAR (x), (env)) \
+ : (!SCM_SYMBOLP (SCM_CAR (x)) \
+ ? SCM_CAR (x) \
+ : *scm_lookupcar ((x), (env), 1)))))
SCM_REC_MUTEX (source_mutex);
@@ -2548,6 +2573,7 @@ SCM
scm_eval_body (SCM code, SCM env)
{
SCM next;
+
again:
next = SCM_CDR (code);
while (!SCM_NULLP (next))
@@ -2594,13 +2620,16 @@ scm_eval_body (SCM code, SCM env)
#else /* !DEVAL */
-#undef SCM_CEVAL
-#define SCM_CEVAL scm_deval /* Substitute all uses of scm_ceval */
+#undef CEVAL
+#define CEVAL deval /* Substitute all uses of ceval */
+
#undef SCM_APPLY
#define SCM_APPLY scm_dapply
+
#undef PREP_APPLY
#define PREP_APPLY(p, l) \
{ ++debug.info; debug.info->a.proc = p; debug.info->a.args = l; }
+
#undef ENTER_APPLY
#define ENTER_APPLY \
do { \
@@ -2626,28 +2655,21 @@ do { \
SCM_TRAPS_P = 1;\
}\
} while (0)
+
#undef RETURN
#define RETURN(e) do { proc = (e); goto exit; } while (0)
+
#ifdef STACK_CHECKING
#ifndef EVAL_STACK_CHECKING
#define EVAL_STACK_CHECKING
#endif
#endif
-/* scm_ceval_ptr points to the currently selected evaluator.
- * *fixme*: Although efficiency is important here, this state variable
- * should probably not be a global. It should be related to the
- * current repl.
- */
-
-
-SCM (*scm_ceval_ptr) (SCM x, SCM env);
-/* scm_last_debug_frame contains a pointer to the last debugging
- * information stack frame. It is accessed very often from the
- * debugging evaluator, so it should probably not be indirectly
- * addressed. Better to save and restore it from the current root at
- * any stack swaps.
+/* scm_last_debug_frame contains a pointer to the last debugging information
+ * stack frame. It is accessed very often from the debugging evaluator, so it
+ * should probably not be indirectly addressed. Better to save and restore it
+ * from the current root at any stack swaps.
*/
/* scm_debug_eframe_size is the number of slots available for pseudo
@@ -2656,7 +2678,10 @@ SCM (*scm_ceval_ptr) (SCM x, SCM env);
long scm_debug_eframe_size;
-int scm_debug_mode, scm_check_entry_p, scm_check_apply_p, scm_check_exit_p;
+int scm_debug_mode_p;
+int scm_check_entry_p;
+int scm_check_apply_p;
+int scm_check_exit_p;
long scm_eval_stack;
@@ -2774,46 +2799,32 @@ deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
/* This is the evaluator. Like any real monster, it has three heads:
*
- * scm_ceval is the non-debugging evaluator, scm_deval is the debugging
- * version. Both are implemented using a common code base, using the
- * following mechanism: SCM_CEVAL is a macro, which is either defined to
- * scm_ceval or scm_deval. Thus, there is no function SCM_CEVAL, but the code
- * for SCM_CEVAL actually compiles to either scm_ceval or scm_deval. When
- * SCM_CEVAL is defined to scm_ceval, it is known that the macro DEVAL is not
- * defined. When SCM_CEVAL is defined to scm_deval, then the macro DEVAL is
- * known to be defined. Thus, in SCM_CEVAL parts for the debugging evaluator
+ * ceval is the non-debugging evaluator, deval is the debugging version. Both
+ * are implemented using a common code base, using the following mechanism:
+ * CEVAL is a macro, which is either defined to ceval or deval. Thus, there
+ * is no function CEVAL, but the code for CEVAL actually compiles to either
+ * ceval or deval. When CEVAL is defined to ceval, it is known that the macro
+ * DEVAL is not defined. When CEVAL is defined to deval, then the macro DEVAL
+ * is known to be defined. Thus, in CEVAL parts for the debugging evaluator
* are enclosed within #ifdef DEVAL ... #endif.
*
- * All three (scm_ceval, scm_deval and their common implementation SCM_CEVAL)
- * take two input parameters, x and env: x is a single expression to be
- * evalutated. env is the environment in which bindings are searched.
+ * All three (ceval, deval and their common implementation CEVAL) take two
+ * input parameters, x and env: x is a single expression to be evalutated.
+ * env is the environment in which bindings are searched.
*
- * x is known to be a cell (i. e. a pair or any other non-immediate). Since x
- * is a single expression, it is necessarily in a tail position. If x is just
- * a call to another function like in the expression (foo exp1 exp2 ...), the
- * realization of that call therefore _must_not_ increase stack usage (the
- * evaluation of exp1, exp2 etc., however, may do so). This is realized by
- * making extensive use of 'goto' statements within the evaluator: The gotos
- * replace recursive calls to SCM_CEVAL, thus re-using the same stack frame
- * that SCM_CEVAL was already using. If, however, x represents some form that
- * requires to evaluate a sequence of expressions like (begin exp1 exp2 ...),
- * then recursive calls to SCM_CEVAL are performed for all but the last
- * expression of that sequence. */
+ * x is known to be a pair. Since x is a single expression, it is necessarily
+ * in a tail position. If x is just a call to another function like in the
+ * expression (foo exp1 exp2 ...), the realization of that call therefore
+ * _must_not_ increase stack usage (the evaluation of exp1, exp2 etc.,
+ * however, may do so). This is realized by making extensive use of 'goto'
+ * statements within the evaluator: The gotos replace recursive calls to
+ * CEVAL, thus re-using the same stack frame that CEVAL was already using.
+ * If, however, x represents some form that requires to evaluate a sequence of
+ * expressions like (begin exp1 exp2 ...), then recursive calls to CEVAL are
+ * performed for all but the last expression of that sequence. */
-#if 0
-SCM
-scm_ceval (SCM x, SCM env)
-{}
-#endif
-
-#if 0
-SCM
-scm_deval (SCM x, SCM env)
-{}
-#endif
-
-SCM
-SCM_CEVAL (SCM x, SCM env)
+static SCM
+CEVAL (SCM x, SCM env)
{
SCM proc, arg1;
#ifdef DEVAL
@@ -2911,7 +2922,7 @@ start:
#endif
dispatch:
SCM_TICK;
- switch (SCM_TYP7 (x))
+ switch (SCM_ITAG7 (SCM_CAR (x)))
{
case SCM_BIT7 (SCM_IM_AND):
x = SCM_CDR (x);
@@ -2969,7 +2980,7 @@ dispatch:
SCM_VALIDATE_NON_EMPTY_COMBINATION (form);
}
else
- SCM_CEVAL (form, env);
+ EVAL (form, env);
x = SCM_CDR (x);
}
@@ -3103,12 +3114,11 @@ dispatch:
* with a pair. All others are just constants. However,
* since in the common case there is no constant expression
* in a body of a do form, we just check for immediates here
- * and have SCM_CEVAL take care of other cases. In the long
- * run it would make sense to get rid of this test and have
- * the macro transformer of 'do' eliminate all forms that
- * have no sideeffect. */
- if (!SCM_IMP (form))
- SCM_CEVAL (form, env);
+ * and have CEVAL take care of other cases. In the long run
+ * it would make sense to get rid of this test and have the
+ * macro transformer of 'do' eliminate all forms that have
+ * no sideeffect. */
+ EVAL (form, env);
}
}
@@ -3546,7 +3556,7 @@ dispatch:
for (x = SCM_CDR (x); !SCM_NULLP (SCM_CDR (x)); x = SCM_CDR (x))
{
if (SCM_CONSP (SCM_CAR (x)))
- SCM_CEVAL (SCM_CAR (x), env);
+ CEVAL (SCM_CAR (x), env);
}
proc = EVALCAR (x, env);
@@ -3586,51 +3596,17 @@ dispatch:
}
- default:
- proc = x;
- goto evapply;
-
-
- case scm_tc7_vector:
- case scm_tc7_wvect:
-#if SCM_HAVE_ARRAYS
- case scm_tc7_bvect:
- case scm_tc7_byvect:
- case scm_tc7_svect:
- case scm_tc7_ivect:
- case scm_tc7_uvect:
- case scm_tc7_fvect:
- case scm_tc7_dvect:
- case scm_tc7_cvect:
-#if SCM_SIZEOF_LONG_LONG != 0
- case scm_tc7_llvect:
-#endif
-#endif
- case scm_tc7_number:
- case scm_tc7_string:
- case scm_tc7_smob:
- case scm_tcs_closures:
- case scm_tc7_cclo:
- case scm_tc7_pws:
- case scm_tcs_subrs:
- case scm_tcs_struct:
- case scm_tc7_port:
- RETURN (x);
-
- case scm_tc7_symbol:
- /* Only happens when called at top level. */
- x = scm_cons (x, SCM_UNDEFINED);
- RETURN (*scm_lookupcar (x, env, 1));
-
- case scm_tc7_variable:
- RETURN (SCM_VARIABLE_REF(x));
-
case SCM_BIT7 (SCM_ILOC00):
proc = *scm_ilookup (SCM_CAR (x), env);
goto checkmacro;
- case scm_tcs_cons_nimcar:
- if (SCM_SYMBOLP (SCM_CAR (x)))
+
+ default:
+ if (SCM_VARIABLEP (SCM_CAR (x)))
+ proc = SCM_VARIABLE_REF (SCM_CAR (x));
+ else if (SCM_CONSP (SCM_CAR (x)))
+ proc = CEVAL (SCM_CAR (x), env);
+ else if (SCM_SYMBOLP (SCM_CAR (x)))
{
SCM orig_sym = SCM_CAR (x);
{
@@ -3701,7 +3677,7 @@ dispatch:
}
}
else
- proc = SCM_CEVAL (SCM_CAR (x), env);
+ proc = SCM_CAR (x);
checkmacro:
if (SCM_MACROP (proc))
@@ -4414,7 +4390,7 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
debug.vect[0].a.args = SCM_EOL;
scm_last_debug_frame = &debug;
#else
- if (SCM_DEBUGGINGP)
+ if (scm_debug_mode_p)
return scm_dapply (proc, arg1, args);
#endif
@@ -4623,7 +4599,7 @@ tail:
SCM_VALIDATE_NON_EMPTY_COMBINATION (SCM_CAR (proc));
}
else
- SCM_CEVAL (SCM_CAR (proc), args);
+ EVAL (SCM_CAR (proc), args);
proc = arg1;
arg1 = SCM_CDR (proc);
}
@@ -4830,7 +4806,7 @@ scm_trampoline_0 (SCM proc)
/* If debugging is enabled, we want to see all calls to proc on the stack.
* Thus, we replace the trampoline shortcut with scm_call_0. */
- if (SCM_DEBUGGINGP)
+ if (scm_debug_mode_p)
return scm_call_0;
else
return trampoline;
@@ -4964,7 +4940,7 @@ scm_trampoline_1 (SCM proc)
/* If debugging is enabled, we want to see all calls to proc on the stack.
* Thus, we replace the trampoline shortcut with scm_call_1. */
- if (SCM_DEBUGGINGP)
+ if (scm_debug_mode_p)
return scm_call_1;
else
return trampoline;
@@ -5058,7 +5034,7 @@ scm_trampoline_2 (SCM proc)
/* If debugging is enabled, we want to see all calls to proc on the stack.
* Thus, we replace the trampoline shortcut with scm_call_2. */
- if (SCM_DEBUGGINGP)
+ if (scm_debug_mode_p)
return scm_call_2;
else
return trampoline;
@@ -5529,14 +5505,20 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
SCM
scm_i_eval_x (SCM exp, SCM env)
{
- return SCM_XEVAL (exp, env);
+ if (SCM_SYMBOLP (exp))
+ return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
+ else
+ return SCM_XEVAL (exp, env);
}
SCM
scm_i_eval (SCM exp, SCM env)
{
exp = scm_copy_tree (exp);
- return SCM_XEVAL (exp, env);
+ if (SCM_SYMBOLP (exp))
+ return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
+ else
+ return SCM_XEVAL (exp, env);
}
SCM
@@ -5635,13 +5617,52 @@ SCM_DEFINE (scm_eval, "eval", 2, 0, 0,
#undef FUNC_NAME
-/* At this point, scm_deval and scm_dapply are generated.
+/* At this point, deval and scm_dapply are generated.
*/
#define DEVAL
#include "eval.c"
+#if (SCM_ENABLE_DEPRECATED == 1)
+
+/* Deprecated in guile 1.7.0 on 2004-03-29. */
+SCM scm_ceval (SCM x, SCM env)
+{
+ if (SCM_CONSP (x))
+ return ceval (x, env);
+ else if (SCM_SYMBOLP (x))
+ return *scm_lookupcar (scm_cons (x, SCM_UNDEFINED), env, 1);
+ else
+ return SCM_XEVAL (x, env);
+}
+
+/* Deprecated in guile 1.7.0 on 2004-03-29. */
+SCM scm_deval (SCM x, SCM env)
+{
+ if (SCM_CONSP (x))
+ return deval (x, env);
+ else if (SCM_SYMBOLP (x))
+ return *scm_lookupcar (scm_cons (x, SCM_UNDEFINED), env, 1);
+ else
+ return SCM_XEVAL (x, env);
+}
+
+static SCM
+dispatching_eval (SCM x, SCM env)
+{
+ if (scm_debug_mode_p)
+ return scm_deval (x, env);
+ else
+ return scm_ceval (x, env);
+}
+
+/* Deprecated in guile 1.7.0 on 2004-03-29. */
+SCM (*scm_ceval_ptr) (SCM x, SCM env) = dispatching_eval;
+
+#endif
+
+
void
scm_init_eval ()
{
diff --git a/libguile/eval.h b/libguile/eval.h
index 94e07c01d..85fd78380 100644
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -3,7 +3,8 @@
#ifndef SCM_EVAL_H
#define SCM_EVAL_H
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004
+ * Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -167,8 +168,6 @@ SCM_API SCM scm_m_atslot_set_x (SCM xorig, SCM env);
SCM_API SCM scm_m_atdispatch (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);
-SCM_API SCM scm_ceval (SCM x, SCM env);
-SCM_API SCM scm_deval (SCM x, SCM env);
SCM_API SCM scm_call_0 (SCM proc);
SCM_API SCM scm_call_1 (SCM proc, SCM arg1);
SCM_API SCM scm_call_2 (SCM proc, SCM arg1, SCM arg2);
@@ -214,6 +213,11 @@ SCM_API SCM scm_m_expand_body (SCM xorig, SCM env);
SCM_API SCM scm_unmemocar (SCM form, SCM env);
SCM_API SCM scm_macroexp (SCM x, SCM env);
+/* Deprecated in guile 1.7.0 on 2004-03-29. */
+SCM_API SCM scm_ceval (SCM x, SCM env);
+SCM_API SCM scm_deval (SCM x, SCM env);
+SCM_API SCM (*scm_ceval_ptr) (SCM x, SCM env);
+
#endif
diff --git a/libguile/gdbint.c b/libguile/gdbint.c
index 912246457..3d69c92c4 100644
--- a/libguile/gdbint.c
+++ b/libguile/gdbint.c
@@ -1,5 +1,6 @@
/* GDB interface for Guile
- * Copyright (C) 1996,1997,1999,2000,2001, 2002 Free Software Foundation, Inc.
+ * Copyright (C) 1996,1997,1999,2000,2001,2002,2004
+ * Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -216,11 +217,6 @@ int
gdb_eval (SCM exp)
{
RESET_STRING;
- if (SCM_IMP (exp))
- {
- gdb_result = exp;
- return 0;
- }
if (SCM_GC_P)
{
SEND_STRING ("Can't evaluate lisp expressions during gc");
@@ -229,7 +225,7 @@ gdb_eval (SCM exp)
SCM_BEGIN_FOREIGN_BLOCK;
{
SCM env = scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE);
- gdb_result = scm_permanent_object (scm_ceval (exp, env));
+ gdb_result = scm_permanent_object (scm_i_eval_x (exp, env));
}
SCM_END_FOREIGN_BLOCK;
return 0;