diff options
| author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-19 15:16:32 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-19 15:17:07 +0200 |
| commit | 3ea60151acc931a7e9c994a05fd8b25c3019b929 (patch) | |
| tree | 614e99595f0a704773343d5ac1d84a921014640e | |
| parent | 3de8e964c89fdaf2789b608363ccc852480acaf5 (diff) | |
LAMBDA: Do not reserve environment space for special variables.
| -rw-r--r-- | sb-eval2.lisp | 14 |
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) |