summaryrefslogtreecommitdiff
path: root/libguile/eval.c
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2003-10-18 14:49:55 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2003-10-18 14:49:55 +0000
commit216286857be77676b068f36ed96ea686de03a89e (patch)
treee03b9ca5245f4d3f08cdf31cabb3645458bc72ab /libguile/eval.c
parentd6754c2398030aea59dc7b1e1a4ceb99157fd829 (diff)
downloadguile-216286857be77676b068f36ed96ea686de03a89e.tar.gz
* libguile/eval.c: Sorted include files alphabetically.
(scm_m_begin): Added comment. (scm_m_or): Use ASSERT_SYNTAX to signal syntax errors. Avoid unnecessary consing when creating the memoized code. (iqq, scm_m_quasiquote, scm_m_quote): Use ASSERT_SYNTAX to signal syntax errors. Be more specific about the kind of error that was detected. (scm_m_quote, unmemocopy): As an optimization, vector constants are now inserted unquoted into the memoized code. During unmemoization the quotes are added again to provide syntactically correct code. * test-suite/tests/syntax.test (exception:missing/extra-expr, exception:missing/extra-expr-misc): Renamed exception:missing/extra-expr to exception:missing/extra-expr-misc. (exception:missing/extra-expr-syntax, exception:missing/extra-expr): Renamed exception:missing/extra-expr-syntax to exception:missing/extra-expr.
Diffstat (limited to 'libguile/eval.c')
-rw-r--r--libguile/eval.c121
1 files changed, 78 insertions, 43 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index 91cd36d81..ac5d006b6 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -54,36 +54,36 @@ char *alloca ();
#endif
#include "libguile/_scm.h"
+#include "libguile/alist.h"
+#include "libguile/async.h"
+#include "libguile/continuations.h"
#include "libguile/debug.h"
#include "libguile/dynwind.h"
-#include "libguile/alist.h"
#include "libguile/eq.h"
-#include "libguile/continuations.h"
+#include "libguile/feature.h"
+#include "libguile/fluids.h"
#include "libguile/futures.h"
-#include "libguile/strings.h"
-#include "libguile/throw.h"
-#include "libguile/smob.h"
+#include "libguile/goops.h"
+#include "libguile/hash.h"
+#include "libguile/hashtab.h"
+#include "libguile/lang.h"
#include "libguile/list.h"
#include "libguile/macros.h"
-#include "libguile/procprop.h"
-#include "libguile/hashtab.h"
-#include "libguile/hash.h"
-#include "libguile/srcprop.h"
-#include "libguile/stackchk.h"
-#include "libguile/objects.h"
-#include "libguile/async.h"
-#include "libguile/feature.h"
#include "libguile/modules.h"
+#include "libguile/objects.h"
#include "libguile/ports.h"
+#include "libguile/procprop.h"
#include "libguile/root.h"
-#include "libguile/vectors.h"
-#include "libguile/fluids.h"
-#include "libguile/goops.h"
+#include "libguile/smob.h"
+#include "libguile/srcprop.h"
+#include "libguile/stackchk.h"
+#include "libguile/strings.h"
+#include "libguile/throw.h"
+#include "libguile/validate.h"
#include "libguile/values.h"
+#include "libguile/vectors.h"
-#include "libguile/validate.h"
#include "libguile/eval.h"
-#include "libguile/lang.h"
@@ -755,7 +755,9 @@ SCM
scm_m_begin (SCM expr, SCM env SCM_UNUSED)
{
const SCM cdr_expr = SCM_CDR (expr);
-
+ /* Dirk:FIXME:: An empty begin clause is not generally allowed by R5RS.
+ * That means, there should be a distinction between uses of begin where an
+ * empty clause is OK and where it is not. */
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
SCM_SETCAR (expr, SCM_IM_BEGIN);
@@ -1359,14 +1361,23 @@ SCM_SYNTAX (s_or, "or", scm_i_makbimacro, scm_m_or);
SCM_GLOBAL_SYMBOL (scm_sym_or, s_or);
SCM
-scm_m_or (SCM xorig, SCM env SCM_UNUSED)
+scm_m_or (SCM expr, SCM env SCM_UNUSED)
{
- long len = scm_ilength (SCM_CDR (xorig));
- SCM_ASSYNT (len >= 0, s_test, s_or);
- if (len >= 1)
- return scm_cons (SCM_IM_OR, SCM_CDR (xorig));
+ const SCM cdr_expr = SCM_CDR (expr);
+ const long length = scm_ilength (cdr_expr);
+
+ ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
+
+ if (length == 0)
+ {
+ /* Special case: (or) is replaced by #f. */
+ return SCM_BOOL_F;
+ }
else
- return SCM_BOOL_F;
+ {
+ SCM_SETCAR (expr, SCM_IM_OR);
+ return expr;
+ }
}
@@ -1382,17 +1393,17 @@ iqq (SCM form, SCM env, unsigned long int depth)
{
if (SCM_CONSP (form))
{
- SCM tmp = SCM_CAR (form);
+ const SCM tmp = SCM_CAR (form);
if (SCM_EQ_P (tmp, scm_sym_quasiquote))
{
- SCM args = SCM_CDR (form);
- SCM_ASSYNT (scm_ilength (args) == 1, s_expression, s_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))
{
- SCM args = SCM_CDR (form);
- SCM_ASSYNT (scm_ilength (args) == 1, s_expression, s_quasiquote);
+ const SCM args = SCM_CDR (form);
+ ASSERT_SYNTAX (scm_ilength (args) == 1, s_expression, form);
if (depth - 1 == 0)
return scm_eval_car (args, env);
else
@@ -1401,13 +1412,14 @@ iqq (SCM form, SCM env, unsigned long int depth)
else if (SCM_CONSP (tmp)
&& SCM_EQ_P (SCM_CAR (tmp), scm_sym_uq_splicing))
{
- SCM args = SCM_CDR (tmp);
- SCM_ASSYNT (scm_ilength (args) == 1, s_expression, s_quasiquote);
+ const SCM args = SCM_CDR (tmp);
+ ASSERT_SYNTAX (scm_ilength (args) == 1, s_expression, form);
if (depth - 1 == 0)
{
- SCM list = scm_eval_car (args, env);
- SCM rest = SCM_CDR (form);
- SCM_ASSYNT (scm_ilength (list) >= 0, s_splicing, s_quasiquote);
+ const SCM list = scm_eval_car (args, env);
+ const SCM rest = SCM_CDR (form);
+ ASSERT_SYNTAX_2 (scm_ilength (list) >= 0,
+ s_splicing, list, form);
return scm_append (scm_list_2 (list, iqq (rest, env, depth)));
}
else
@@ -1433,11 +1445,12 @@ iqq (SCM form, SCM env, unsigned long int depth)
}
SCM
-scm_m_quasiquote (SCM xorig, SCM env)
+scm_m_quasiquote (SCM expr, SCM env)
{
- SCM x = SCM_CDR (xorig);
- SCM_ASSYNT (scm_ilength (x) == 1, s_expression, s_quasiquote);
- return iqq (SCM_CAR (x), env, 1);
+ const SCM cdr_expr = SCM_CDR (expr);
+ ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
+ ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
+ return iqq (SCM_CAR (cdr_expr), env, 1);
}
@@ -1445,10 +1458,26 @@ SCM_SYNTAX (s_quote, "quote", scm_i_makbimacro, scm_m_quote);
SCM_GLOBAL_SYMBOL (scm_sym_quote, s_quote);
SCM
-scm_m_quote (SCM xorig, SCM env SCM_UNUSED)
+scm_m_quote (SCM expr, SCM env SCM_UNUSED)
{
- SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, s_expression, s_quote);
- return scm_cons (SCM_IM_QUOTE, SCM_CDR (xorig));
+ SCM quotee;
+
+ const SCM cdr_expr = SCM_CDR (expr);
+ ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
+ ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
+ quotee = SCM_CAR (cdr_expr);
+ if (SCM_IMP (quotee) && !SCM_NULLP (quotee))
+ return quotee;
+ else if (SCM_VECTORP (quotee))
+ return quotee;
+#if 0
+ /* The following optimization would be possible if all variable references
+ * were resolved during memoization: */
+ else if (SCM_SYMBOLP (quotee))
+ return quotee;
+#endif
+ SCM_SETCAR (expr, SCM_IM_QUOTE);
+ return expr;
}
@@ -1868,8 +1897,14 @@ unmemocopy (SCM x, SCM env)
{
SCM ls, z;
SCM p;
- if (!SCM_CONSP (x))
+
+ if (SCM_VECTORP (x))
+ {
+ return scm_list_2 (scm_sym_quote, x);
+ }
+ else if (!SCM_CONSP (x))
return x;
+
p = scm_whash_lookup (scm_source_whash, x);
switch (SCM_ITAG7 (SCM_CAR (x)))
{