summaryrefslogtreecommitdiff
path: root/libguile/eval.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-12-05 16:54:35 +0100
committerAndy Wingo <wingo@pobox.com>2014-12-05 16:54:35 +0100
commitcfdc8416a2540e43504a021d4f7c44c7d21a668d (patch)
tree375bf90b132efb6668d0084234eb66ef54c92e38 /libguile/eval.c
parent7974c57937104b0617d93fa492d3bd323b053f20 (diff)
downloadguile-cfdc8416a2540e43504a021d4f7c44c7d21a668d.tar.gz
Simplify the interpreter for trivial inits and no letrec
* libguile/memoize.c (FULL_ARITY): Serialize "ninits" and the unbound value instead of the init list. (memoize): Adapt to FULL_ARITY changes. Remove LETREC case. (unmemoize): Adapt to memoized code change. * libguile/eval.c (BOOT_CLOSURE_PARSE_FULL): Adapt to parse ninits and unbound instead of inits. (eval): Lexical-ref can no longer raise an error. (prepare_boot_closure_env_for_apply): Adapt to inits change. * module/ice-9/eval.scm (primitive-eval): Adapt to ninits/unbound change. * libguile/expand.c (expand_named_let): Fix lambda-case creation to make lists for opt and inits.
Diffstat (limited to 'libguile/eval.c')
-rw-r--r--libguile/eval.c67
1 files changed, 17 insertions, 50 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index 2488ee272..d76fbd30d 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -116,13 +116,13 @@ static scm_t_bits scm_tc16_boot_closure;
#define BOOT_CLOSURE_IS_REST(x) scm_is_null (SCM_CDR (CDDDR (BOOT_CLOSURE_CODE (x))))
/* NB: One may only call the following accessors if the closure is not REST. */
#define BOOT_CLOSURE_IS_FULL(x) (1)
-#define BOOT_CLOSURE_PARSE_FULL(fu_,body,nargs,rest,nopt,kw,inits,alt) \
+#define BOOT_CLOSURE_PARSE_FULL(fu_,body,nargs,rest,nopt,kw,ninits,unbound,alt) \
do { SCM fu = fu_; \
body = CAR (fu); fu = CDDR (fu); \
\
rest = kw = alt = SCM_BOOL_F; \
- inits = SCM_EOL; \
- nopt = 0; \
+ unbound = SCM_BOOL_F; \
+ nopt = ninits = 0; \
\
nreq = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \
if (scm_is_pair (fu)) \
@@ -132,7 +132,8 @@ static scm_t_bits scm_tc16_boot_closure;
{ \
nopt = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \
kw = CAR (fu); fu = CDR (fu); \
- inits = CAR (fu); fu = CDR (fu); \
+ ninits = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \
+ unbound = CAR (fu); fu = CDR (fu); \
alt = CAR (fu); \
} \
} \
@@ -196,14 +197,6 @@ env_set (SCM env, int depth, int width, SCM val)
}
-SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable");
-
-static void error_used_before_defined (void)
-{
- scm_error (scm_unbound_variable_key, NULL,
- "Variable used before given a value", SCM_EOL, SCM_BOOL_F);
-}
-
static void error_invalid_keyword (SCM proc, SCM obj)
{
scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc,
@@ -358,20 +351,14 @@ eval (SCM x, SCM env)
case SCM_M_LEXICAL_REF:
{
- SCM pos, ret;
+ SCM pos;
int depth, width;
pos = mx;
depth = SCM_I_INUM (CAR (pos));
width = SCM_I_INUM (CDR (pos));
- ret = env_ref (env, depth, width);
-
- if (SCM_UNLIKELY (SCM_UNBNDP (ret)))
- /* we don't know what variable, though, because we don't have its
- name */
- error_used_before_defined ();
- return ret;
+ return env_ref (env, depth, width);
}
case SCM_M_LEXICAL_SET:
@@ -764,12 +751,13 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
}
else
{
- int i, argc, nreq, nopt, nenv;
- SCM body, rest, kw, inits, alt;
+ int i, argc, nreq, nopt, ninits, nenv;
+ SCM body, rest, kw, unbound, alt;
SCM mx = BOOT_CLOSURE_CODE (proc);
loop:
- BOOT_CLOSURE_PARSE_FULL (mx, body, nargs, rest, nopt, kw, inits, alt);
+ BOOT_CLOSURE_PARSE_FULL (mx, body, nargs, rest, nopt, kw,
+ ninits, unbound, alt);
argc = scm_ilength (args);
if (argc < nreq)
@@ -814,8 +802,8 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
}
/* At this point we are committed to the chosen clause. */
- nenv = nreq + (scm_is_true (rest) ? 1 : 0) + scm_ilength (inits);
- env = make_env (nenv, SCM_UNDEFINED, env);
+ nenv = nreq + (scm_is_true (rest) ? 1 : 0) + ninits;
+ env = make_env (nenv, unbound, env);
for (i = 0; i < nreq; i++, args = CDR (args))
env_set (env, 0, i, CAR (args));
@@ -823,15 +811,10 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
if (scm_is_false (kw))
{
/* Optional args (possibly), but no keyword args. */
- for (; i < argc && i < nreq + nopt;
- i++, args = CDR (args), inits = CDR (inits))
+ for (; i < argc && i < nreq + nopt; i++, args = CDR (args))
env_set (env, 0, i, CAR (args));
-
- for (; i < nreq + nopt; i++, inits = CDR (inits))
- env_set (env, 0, i, EVAL1 (CAR (inits), env));
-
if (scm_is_true (rest))
- env_set (env, 0, i++, args);
+ env_set (env, 0, nreq + nopt, args);
}
else
{
@@ -842,18 +825,13 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
/* Optional args. As before, but stop at the first keyword. */
for (; i < argc && i < nreq + nopt && !scm_is_keyword (CAR (args));
- i++, args = CDR (args), inits = CDR (inits))
+ i++, args = CDR (args))
env_set (env, 0, i, CAR (args));
-
- for (; i < nreq + nopt; i++, inits = CDR (inits))
- env_set (env, 0, i, EVAL1 (CAR (inits), env));
-
if (scm_is_true (rest))
- env_set (env, 0, i++, args);
+ env_set (env, 0, nreq + nopt, args);
/* Parse keyword args. */
{
- int kw_start_idx = i;
SCM walk;
if (scm_is_pair (args) && scm_is_pair (CDR (args)))
@@ -880,20 +858,9 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
}
if (scm_is_pair (args) && scm_is_false (rest))
error_invalid_keyword (proc, CAR (args));
-
- /* Now fill in unbound values, evaluating init expressions in their
- appropriate environment. */
- for (i = kw_start_idx; scm_is_pair (inits); i++, inits = CDR (inits))
- if (SCM_UNBNDP (env_ref (env, 0, i)))
- env_set (env, 0, i, EVAL1 (CAR (inits), env));
}
}
- if (!scm_is_null (inits))
- abort ();
- if (i != nenv)
- abort ();
-
*out_body = body;
*out_env = env;
}