mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

Simplify the interpreter for trivial inits and no letrec

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2014-12-05 16:54:35 +01:00
parent 7974c57937
commit cfdc8416a2
4 changed files with 70 additions and 187 deletions
Download patch file Download diff file Expand all files Collapse all files

67
libguile/eval.c
View file

@ -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)))) #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. */ /* NB: One may only call the following accessors if the closure is not REST. */
#define BOOT_CLOSURE_IS_FULL(x) (1) #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_; \ do { SCM fu = fu_; \
body = CAR (fu); fu = CDDR (fu); \ body = CAR (fu); fu = CDDR (fu); \
\ \
rest = kw = alt = SCM_BOOL_F; \ rest = kw = alt = SCM_BOOL_F; \
inits = SCM_EOL; \ unbound = SCM_BOOL_F; \
nopt = 0; \ nopt = ninits = 0; \
\ \
nreq = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \ nreq = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \
if (scm_is_pair (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); \ nopt = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \
kw = 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); \ 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) static void error_invalid_keyword (SCM proc, SCM obj)
{ {
scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc, 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: case SCM_M_LEXICAL_REF:
{ {
SCM pos, ret; SCM pos;
int depth, width; int depth, width;
pos = mx; pos = mx;
depth = SCM_I_INUM (CAR (pos)); depth = SCM_I_INUM (CAR (pos));
width = SCM_I_INUM (CDR (pos)); width = SCM_I_INUM (CDR (pos));
ret = env_ref (env, depth, width); return 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;
} }
case SCM_M_LEXICAL_SET: case SCM_M_LEXICAL_SET:
@ -764,12 +751,13 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
} }
else else
{ {
int i, argc, nreq, nopt, nenv; int i, argc, nreq, nopt, ninits, nenv;
SCM body, rest, kw, inits, alt; SCM body, rest, kw, unbound, alt;
SCM mx = BOOT_CLOSURE_CODE (proc); SCM mx = BOOT_CLOSURE_CODE (proc);
loop: 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); argc = scm_ilength (args);
if (argc < nreq) 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. */ /* At this point we are committed to the chosen clause. */
nenv = nreq + (scm_is_true (rest) ? 1 : 0) + scm_ilength (inits); nenv = nreq + (scm_is_true (rest) ? 1 : 0) + ninits;
env = make_env (nenv, SCM_UNDEFINED, env); env = make_env (nenv, unbound, env);
for (i = 0; i < nreq; i++, args = CDR (args)) for (i = 0; i < nreq; i++, args = CDR (args))
env_set (env, 0, i, CAR (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)) if (scm_is_false (kw))
{ {
/* Optional args (possibly), but no keyword args. */ /* Optional args (possibly), but no keyword args. */
for (; i < argc && i < nreq + nopt; for (; i < argc && i < nreq + nopt; i++, args = CDR (args))
i++, args = CDR (args), inits = CDR (inits))
env_set (env, 0, i, CAR (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)) if (scm_is_true (rest))
env_set (env, 0, i++, args); env_set (env, 0, nreq + nopt, args);
} }
else 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. */ /* Optional args. As before, but stop at the first keyword. */
for (; i < argc && i < nreq + nopt && !scm_is_keyword (CAR (args)); 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)); 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)) if (scm_is_true (rest))
env_set (env, 0, i++, args); env_set (env, 0, nreq + nopt, args);
/* Parse keyword args. */ /* Parse keyword args. */
{ {
int kw_start_idx = i;
SCM walk; SCM walk;
if (scm_is_pair (args) && scm_is_pair (CDR (args))) 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)) if (scm_is_pair (args) && scm_is_false (rest))
error_invalid_keyword (proc, CAR (args)); 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_body = body;
*out_env = env; *out_env = env;
} }

11
libguile/expand.c
View file

@ -977,8 +977,8 @@ expand_named_let (const SCM expr, SCM env)
scm_list_1 (name), scm_list_1 (name_sym), scm_list_1 (name), scm_list_1 (name_sym),
scm_list_1 (LAMBDA (SCM_BOOL_F, scm_list_1 (LAMBDA (SCM_BOOL_F,
SCM_EOL, SCM_EOL,
LAMBDA_CASE (SCM_BOOL_F, var_names, SCM_BOOL_F, SCM_BOOL_F, LAMBDA_CASE (SCM_BOOL_F, var_names, SCM_EOL, SCM_BOOL_F,
SCM_BOOL_F, SCM_BOOL_F, var_syms, SCM_BOOL_F, SCM_EOL, var_syms,
expand_sequence (CDDDR (expr), inner_env), expand_sequence (CDDDR (expr), inner_env),
SCM_BOOL_F))), SCM_BOOL_F))),
CALL (SCM_BOOL_F, CALL (SCM_BOOL_F,
@ -1511,7 +1511,7 @@ convert_assignment (SCM exp, SCM assigned)
case SCM_EXPANDED_LETREC: case SCM_EXPANDED_LETREC:
{ {
SCM src, names, syms, vals, unbound, boxes, body; SCM src, names, syms, vals, empty_box, boxes, body;
src = REF (exp, LETREC, SRC); src = REF (exp, LETREC, SRC);
names = REF (exp, LETREC, NAMES); names = REF (exp, LETREC, NAMES);
@ -1519,10 +1519,11 @@ convert_assignment (SCM exp, SCM assigned)
vals = convert_assignment (REF (exp, LETREC, VALS), assigned); vals = convert_assignment (REF (exp, LETREC, VALS), assigned);
body = convert_assignment (REF (exp, LETREC, BODY), assigned); body = convert_assignment (REF (exp, LETREC, BODY), assigned);
unbound = PRIMCALL (SCM_BOOL_F, empty_box =
PRIMCALL (SCM_BOOL_F,
scm_from_latin1_symbol ("make-undefined-variable"), scm_from_latin1_symbol ("make-undefined-variable"),
SCM_EOL); SCM_EOL);
boxes = scm_make_list (scm_length (names), unbound); boxes = scm_make_list (scm_length (names), empty_box);
if (scm_is_true (REF (exp, LETREC, IN_ORDER_P))) if (scm_is_true (REF (exp, LETREC, IN_ORDER_P)))
return LET return LET

94
libguile/memoize.c
View file

@ -119,9 +119,9 @@ scm_t_bits scm_tc16_memoized;
scm_list_1 (SCM_I_MAKINUM (nreq)) scm_list_1 (SCM_I_MAKINUM (nreq))
#define REST_ARITY(nreq, rest) \ #define REST_ARITY(nreq, rest) \
scm_list_2 (SCM_I_MAKINUM (nreq), rest) scm_list_2 (SCM_I_MAKINUM (nreq), rest)
#define FULL_ARITY(nreq, rest, nopt, kw, inits, alt) \ #define FULL_ARITY(nreq, rest, nopt, kw, ninits, unbound, alt) \
scm_list_n (SCM_I_MAKINUM (nreq), rest, SCM_I_MAKINUM (nopt), kw, inits, \ scm_list_n (SCM_I_MAKINUM (nreq), rest, SCM_I_MAKINUM (nopt), kw, \
alt, SCM_UNDEFINED) SCM_I_MAKINUM (ninits), unbound, alt, SCM_UNDEFINED)
#define MAKMEMO_LAMBDA(body, arity, meta) \ #define MAKMEMO_LAMBDA(body, arity, meta) \
MAKMEMO (SCM_M_LAMBDA, \ MAKMEMO (SCM_M_LAMBDA, \
scm_cons (body, scm_cons (meta, arity))) scm_cons (body, scm_cons (meta, arity)))
@ -418,8 +418,8 @@ memoize (SCM exp, SCM env)
case SCM_EXPANDED_LAMBDA_CASE: case SCM_EXPANDED_LAMBDA_CASE:
{ {
SCM req, rest, opt, kw, inits, vars, body, alt; SCM req, rest, opt, kw, inits, vars, body, alt;
SCM walk, minits, arity, rib, new_env; SCM unbound, arity, rib;
int nreq, nopt; int nreq, nopt, ninits;
req = REF (exp, LAMBDA_CASE, REQ); req = REF (exp, LAMBDA_CASE, REQ);
rest = scm_not (scm_not (REF (exp, LAMBDA_CASE, REST))); rest = scm_not (scm_not (REF (exp, LAMBDA_CASE, REST)));
@ -432,17 +432,12 @@ memoize (SCM exp, SCM env)
nreq = scm_ilength (req); nreq = scm_ilength (req);
nopt = scm_is_pair (opt) ? scm_ilength (opt) : 0; nopt = scm_is_pair (opt) ? scm_ilength (opt) : 0;
ninits = scm_ilength (inits);
/* The vars are the gensyms, according to the divine plan. But we need /* This relies on assignment conversion turning inits into a
to memoize the inits within their appropriate environment, sequence of CONST expressions whose values are a unique
complicating things. */ "unbound" token. */
unbound = ninits ? REF (CAR (inits), CONST, EXP) : SCM_BOOL_F;
rib = scm_vector (vars); rib = scm_vector (vars);
new_env = scm_cons (rib, env);
minits = SCM_EOL;
for (walk = inits; scm_is_pair (walk); walk = CDR (walk))
minits = scm_cons (memoize (CAR (walk), new_env), minits);
minits = scm_reverse_x (minits, SCM_UNDEFINED);
if (scm_is_true (kw)) if (scm_is_true (kw))
{ {
@ -468,12 +463,13 @@ memoize (SCM exp, SCM env)
arity = REST_ARITY (nreq, SCM_BOOL_T); arity = REST_ARITY (nreq, SCM_BOOL_T);
} }
else if (scm_is_true (alt)) else if (scm_is_true (alt))
arity = FULL_ARITY (nreq, rest, nopt, kw, minits, arity = FULL_ARITY (nreq, rest, nopt, kw, ninits, unbound,
SCM_MEMOIZED_ARGS (memoize (alt, env))); SCM_MEMOIZED_ARGS (memoize (alt, env)));
else else
arity = FULL_ARITY (nreq, rest, nopt, kw, minits, SCM_BOOL_F); arity = FULL_ARITY (nreq, rest, nopt, kw, ninits, unbound,
SCM_BOOL_F);
return MAKMEMO_LAMBDA (memoize (body, new_env), arity, return MAKMEMO_LAMBDA (memoize (body, scm_cons (rib, env)), arity,
SCM_BOOL_F /* meta, filled in later */); SCM_BOOL_F /* meta, filled in later */);
} }
@ -497,64 +493,6 @@ memoize (SCM exp, SCM env)
(MAKMEMO_LET (inits, memoize (body, new_env)), env); (MAKMEMO_LET (inits, memoize (body, new_env)), env);
} }
case SCM_EXPANDED_LETREC:
{
SCM vars, varsv, exps, expsv, body, undefs, new_env;
int i, nvars, in_order_p;
vars = REF (exp, LETREC, GENSYMS);
exps = REF (exp, LETREC, VALS);
body = REF (exp, LETREC, BODY);
in_order_p = scm_is_true (REF (exp, LETREC, IN_ORDER_P));
varsv = scm_vector (vars);
nvars = VECTOR_LENGTH (varsv);
expsv = scm_vector (exps);
undefs = scm_c_make_vector (nvars, MAKMEMO_QUOTE (SCM_UNDEFINED));
new_env = scm_cons (varsv, capture_env (env));
if (in_order_p)
{
SCM body_exps = memoize (body, new_env);
for (i = nvars - 1; i >= 0; i--)
{
SCM init = memoize (VECTOR_REF (expsv, i), new_env);
body_exps = MAKMEMO_SEQ (MAKMEMO_LEX_SET (make_pos (0, i), init),
body_exps);
}
return maybe_makmemo_capture_module
(MAKMEMO_LET (undefs, body_exps), env);
}
else
{
SCM sets = SCM_BOOL_F, inits = scm_c_make_vector (nvars, SCM_BOOL_F);
for (i = nvars - 1; i >= 0; i--)
{
SCM init, set;
init = memoize (VECTOR_REF (expsv, i), new_env);
VECTOR_SET (inits, i, init);
set = MAKMEMO_LEX_SET (make_pos (1, i),
MAKMEMO_LEX_REF (make_pos (0, i)));
if (scm_is_false (sets))
sets = set;
else
sets = MAKMEMO_SEQ (set, sets);
}
if (scm_is_false (sets))
return memoize (body, env);
return maybe_makmemo_capture_module
(MAKMEMO_LET (undefs,
MAKMEMO_SEQ (MAKMEMO_LET (inits, sets),
memoize (body, new_env))),
env);
}
}
default: default:
abort (); abort ();
} }
@ -670,7 +608,7 @@ unmemoize (const SCM expr)
{ {
SCM alt, tail; SCM alt, tail;
alt = CADDR (CDDDR (spec)); alt = CADDDR (CDDDR (spec));
if (scm_is_true (alt)) if (scm_is_true (alt))
tail = CDR (unmemoize (alt)); tail = CDR (unmemoize (alt));
else else
@ -682,7 +620,7 @@ unmemoize (const SCM expr)
CADR (spec), CADR (spec),
CADDR (spec), CADDR (spec),
CADDDR (spec), CADDDR (spec),
unmemoize_exprs (CADR (CDDDR (spec)))), CADR (CDDDR (spec))),
unmemoize (body)), unmemoize (body)),
tail)); tail));
} }

73
module/ice-9/eval.scm
View file

@ -329,16 +329,10 @@
;; of arguments, and some rest arities; see make-fixed-closure and ;; of arguments, and some rest arities; see make-fixed-closure and
;; make-rest-closure above. ;; make-rest-closure above.
;; A unique marker for unbound keywords. NB: There should be no
;; other instance of '(unbound-arg) in this compilation unit, so
;; that this marker is indeed unique. It's a hack, but it allows
;; the constant to propagate to inner closures, reducing free
;; variable counts all around, so it is important for perf.
(define unbound-arg '(unbound-arg))
;; Procedures with rest, optional, or keyword arguments, potentially with ;; Procedures with rest, optional, or keyword arguments, potentially with
;; multiple arities, as with case-lambda. ;; multiple arities, as with case-lambda.
(define (make-general-closure env body nreq rest? nopt kw inits alt) (define (make-general-closure env body nreq rest? nopt kw ninits unbound
alt)
(define alt-proc (define alt-proc
(and alt ; (body meta nreq ...) (and alt ; (body meta nreq ...)
(let* ((body (car alt)) (let* ((body (car alt))
@ -348,9 +342,11 @@
(tail (and (pair? (cdr spec)) (pair? (cddr spec)) (cddr spec))) (tail (and (pair? (cdr spec)) (pair? (cddr spec)) (cddr spec)))
(nopt (if tail (car tail) 0)) (nopt (if tail (car tail) 0))
(kw (and tail (cadr tail))) (kw (and tail (cadr tail)))
(inits (if tail (caddr tail) '())) (ninits (if tail (caddr tail) 0))
(alt (and tail (cadddr tail)))) (unbound (and tail (cadddr tail)))
(make-general-closure env body nreq rest nopt kw inits alt)))) (alt (and tail (car (cddddr tail)))))
(make-general-closure env body nreq rest nopt kw ninits unbound
alt))))
(define (set-procedure-arity! proc) (define (set-procedure-arity! proc)
(let lp ((alt alt) (nreq nreq) (nopt nopt) (rest? rest?)) (let lp ((alt alt) (nreq nreq) (nopt nopt) (rest? rest?))
(if (not alt) (if (not alt)
@ -367,7 +363,7 @@
(rest?* (if (null? (cdr spec)) #f (cadr spec))) (rest?* (if (null? (cdr spec)) #f (cadr spec)))
(tail (and (pair? (cdr spec)) (pair? (cddr spec)) (cddr spec))) (tail (and (pair? (cdr spec)) (pair? (cddr spec)) (cddr spec)))
(nopt* (if tail (car tail) 0)) (nopt* (if tail (car tail) 0))
(alt* (and tail (cadddr tail)))) (alt* (and tail (car (cddddr tail)))))
(if (or (< nreq* nreq) (if (or (< nreq* nreq)
(and (= nreq* nreq) (and (= nreq* nreq)
(if rest? (if rest?
@ -395,8 +391,8 @@
"eval" "Wrong number of arguments" "eval" "Wrong number of arguments"
'() #f)))) '() #f))))
(else (else
(let* ((nvals (+ nreq (if rest? 1 0) (length inits))) (let* ((nvals (+ nreq (if rest? 1 0) ninits))
(env (make-env nvals unbound-arg env))) (env (make-env nvals unbound env)))
(let lp ((i 0) (args %args)) (let lp ((i 0) (args %args))
(cond (cond
((< i nreq) ((< i nreq)
@ -405,39 +401,30 @@
(lp (1+ i) (cdr args))) (lp (1+ i) (cdr args)))
((not kw) ((not kw)
;; Optional args (possibly), but no keyword args. ;; Optional args (possibly), but no keyword args.
(let lp ((i i) (args args) (inits inits)) (let lp ((i i) (args args))
(cond (cond
((< i (+ nreq nopt)) ((and (< i (+ nreq nopt)) (< i nargs))
(cond
((< i nargs)
(env-set! env 0 i (car args)) (env-set! env 0 i (car args))
(lp (1+ i) (cdr args) (cdr inits))) (lp (1+ i) (cdr args)))
(else
(env-set! env 0 i (eval (car inits) env))
(lp (1+ i) args (cdr inits)))))
(else (else
(when rest? (when rest?
(env-set! env 0 i args)) (env-set! env 0 (+ nreq nopt) args))
(eval body env))))) (eval body env)))))
(else (else
;; Optional args. As before, but stop at the first ;; Optional args. As before, but stop at the first
;; keyword. ;; keyword.
(let lp ((i i) (args args) (inits inits)) (let lp ((i i) (args args))
(cond (cond
((< i (+ nreq nopt)) ((and (< i (+ nreq nopt))
(cond (< i nargs)
((and (< i nargs) (not (keyword? (car args)))) (not (keyword? (car args))))
(env-set! env 0 i (car args)) (env-set! env 0 i (car args))
(lp (1+ i) (cdr args) (cdr inits))) (lp (1+ i) (cdr args)))
(else
(env-set! env 0 i (eval (car inits) env))
(lp (1+ i) args (cdr inits)))))
(else (else
(when rest? (when rest?
(env-set! env 0 i args)) (env-set! env 0 (+ nreq nopt) args))
(let ((aok (car kw)) (let ((aok (car kw))
(kw (cdr kw)) (kw (cdr kw)))
(kw-base (if rest? (1+ i) i)))
;; Now scan args for keywords. ;; Now scan args for keywords.
(let lp ((args args)) (let lp ((args args))
(cond (cond
@ -462,20 +449,9 @@
((scm-error 'keyword-argument-error ((scm-error 'keyword-argument-error
"eval" "Invalid keyword" "eval" "Invalid keyword"
'() (list (car args)))))) '() (list (car args))))))
(else
;; Finished parsing keywords. Fill in
;; uninitialized kwargs by evalling init
;; expressions in their appropriate
;; environment.
(let lp ((i kw-base) (inits inits))
(cond
((pair? inits)
(when (eq? (env-ref env 0 i) unbound-arg)
(env-set! env 0 i (eval (car inits) env)))
(lp (1+ i) (cdr inits)))
(else (else
;; Finally, eval the body. ;; Finally, eval the body.
(eval body env))))))))))))))))))))) (eval body env))))))))))))))))))
;; The "engine". EXP is a memoized expression. ;; The "engine". EXP is a memoized expression.
(define (eval exp env) (define (eval exp env)
@ -513,9 +489,10 @@
(if (null? tail) (if (null? tail)
(make-rest-closure eval nreq body env) (make-rest-closure eval nreq body env)
(mx-bind (mx-bind
tail (nopt kw inits alt) tail (nopt kw ninits unbound alt)
(make-general-closure env body nreq rest? (make-general-closure env body nreq rest?
nopt kw inits alt))))))) nopt kw ninits unbound
alt)))))))
(let lp ((meta meta)) (let lp ((meta meta))
(unless (null? meta) (unless (null? meta)
(set-procedure-property! proc (caar meta) (cdar meta)) (set-procedure-property! proc (caar meta) (cdar meta))