summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2013-07-19 15:16:32 +0200
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2013-07-19 15:17:07 +0200
commit3ea60151acc931a7e9c994a05fd8b25c3019b929 (patch)
tree614e99595f0a704773343d5ac1d84a921014640e
parent3de8e964c89fdaf2789b608363ccc852480acaf5 (diff)
LAMBDA: Do not reserve environment space for special variables.
-rw-r--r--sb-eval2.lisp14
1 files changed, 7 insertions, 7 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp
index dc128d9..62f0486 100644
--- a/sb-eval2.lisp
+++ b/sb-eval2.lisp
@@ -450,16 +450,12 @@
(optional-num (length optional))
(key-num (length keys))
(aux-num (length aux))
- (varnum (length argvars))
(default-values (append (mapcar #'lambda-binding-default optional)
(mapcar #'lambda-binding-default keys)
(mapcar #'lambda-binding-default aux)))
- (envp (or (> varnum +stack-max+)
- (maybe-closes-over-p context `(progn ,@body) argvars)
- (some (lambda (x) (maybe-closes-over-p context x argvars))
- default-values)))
(new-context (make-lexical-context context))
(varspecs (list))
+ (varnum 0)
(default-values*
(flet ((register-var (var)
(if (or (member var specials :test #'eq)
@@ -469,7 +465,8 @@
(push (cons :special var) varspecs))
(progn
(context-add-env-lexical! new-context var)
- (push :lexical varspecs)))))
+ (push :lexical varspecs)
+ (incf (the fixnum varnum))))))
(mapc #'register-var required)
(loop for default-value in default-values
for binding in (append optional keys aux)
@@ -477,6 +474,10 @@
collect (prepare-form default-value new-context)
do (mapc #'register-var vars)
finally (when restp (register-var rest)))))
+ (envp (or (> varnum +stack-max+)
+ (maybe-closes-over-p context `(progn ,@body) argvars)
+ (some (lambda (x) (maybe-closes-over-p context x argvars))
+ default-values)))
(body* (prepare-progn body new-context))
(unbound (gensym)))
(setq varspecs (nreverse varspecs))
@@ -614,7 +615,6 @@
(lambda (env)
(lambda (&rest args)
(declare (dynamic-extent args))
- ;;XXX VARNUM is too big--- need only lexicals
(let ((new-env (make-environment env varnum)))
(handle-arguments args new-env body*))))
(lambda (env)