#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)) \
{ \
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); \
} \
} \
}
-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,
case SCM_M_LAMBDA:
RETURN_BOOT_CLOSURE (mx, env);
+ case SCM_M_CAPTURE_ENV:
+ {
+ SCM locs = CAR (mx);
+ SCM new_env;
+ int i;
+
+ new_env = make_env (VECTOR_LENGTH (locs), SCM_BOOL_F, env);
+ for (i = 0; i < VECTOR_LENGTH (locs); i++)
+ {
+ SCM loc = VECTOR_REF (locs, i);
+ int depth, width;
+
+ depth = SCM_I_INUM (CAR (loc));
+ width = SCM_I_INUM (CDR (loc));
+ env_set (new_env, 0, i, env_ref (env, depth, width));
+ }
+
+ env = new_env;
+ x = CDR (mx);
+ goto loop;
+ }
+
case SCM_M_QUOTE:
return mx;
- case SCM_M_DEFINE:
- scm_define (CAR (mx), EVAL1 (CDR (mx), env));
- return SCM_UNSPECIFIED;
-
case SCM_M_CAPTURE_MODULE:
return eval (mx, scm_current_module ());
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:
return SCM_UNSPECIFIED;
}
- case SCM_M_TOPLEVEL_REF:
- if (SCM_VARIABLEP (mx))
- return SCM_VARIABLE_REF (mx);
- else
- {
- env = env_tail (env);
- return SCM_VARIABLE_REF (scm_memoize_variable_access_x (x, env));
- }
+ case SCM_M_BOX_REF:
+ {
+ SCM box = mx;
- case SCM_M_TOPLEVEL_SET:
+ return scm_variable_ref (EVAL1 (box, env));
+ }
+
+ case SCM_M_BOX_SET:
{
- SCM var = CAR (mx);
- SCM val = EVAL1 (CDR (mx), env);
- if (SCM_VARIABLEP (var))
- {
- SCM_VARIABLE_SET (var, val);
- return SCM_UNSPECIFIED;
- }
- else
- {
- env = env_tail (env);
- SCM_VARIABLE_SET (scm_memoize_variable_access_x (x, env), val);
- return SCM_UNSPECIFIED;
- }
+ SCM box = CAR (mx), val = CDR (mx);
+
+ return scm_variable_set_x (EVAL1 (box, env), EVAL1 (val, env));
}
- case SCM_M_MODULE_REF:
+ case SCM_M_RESOLVE:
if (SCM_VARIABLEP (mx))
- return SCM_VARIABLE_REF (mx);
- else
- return SCM_VARIABLE_REF
- (scm_memoize_variable_access_x (x, SCM_BOOL_F));
-
- case SCM_M_MODULE_SET:
- if (SCM_VARIABLEP (CDR (mx)))
- {
- SCM_VARIABLE_SET (CDR (mx), EVAL1 (CAR (mx), env));
- return SCM_UNSPECIFIED;
- }
+ return mx;
else
{
- SCM_VARIABLE_SET
- (scm_memoize_variable_access_x (x, SCM_BOOL_F),
- EVAL1 (CAR (mx), env));
- return SCM_UNSPECIFIED;
+ SCM var;
+
+ var = scm_sys_resolve_variable (mx, env_tail (env));
+ scm_set_cdr_x (x, var);
+
+ return var;
}
case SCM_M_CALL_WITH_PROMPT:
}
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)
}
/* 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));
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
{
/* 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)))
}
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;
}
HCoop / bpt / guile.git / blobdiff