diff options
-rw-r--r-- | sb-eval2.lisp | 26 |
1 files changed, 13 insertions, 13 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp index ccb0d14..8d05ba9 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -366,7 +366,7 @@ (mapcar (lambda (x) (prepare-form x new-context)) default-values)) (body* (prepare-progn body new-context)) (unbound (gensym))) - (macrolet ((handle-arguments (args env-ref env) + (macrolet ((handle-arguments (args env) ;; All this ELT and LENGTH stuff is not as ;; inefficient as it looks. SBCL transforms ;; &rest into &more here. @@ -384,11 +384,11 @@ (go missing-optionals)) (when (>= argi (the fixnum (+ required-num optional-num))) (go keys)) - (setf (,@env-ref 0 vari) (elt ,args argi)) + (setf (environment-value ,env 0 vari) (elt ,args argi)) (when (>= argi required-num) (pop default-values*) (incf vari) - (setf (,@env-ref 0 vari) t)) + (setf (environment-value ,env 0 vari) t)) (incf vari) (incf argi) (go positional) @@ -397,9 +397,9 @@ (when (>= vari (the fixnum (+ required-num (the fixnum (* 2 optional-num))))) (go keys)) (let ((val* (pop default-values*))) - (setf (,@env-ref 0 vari) + (setf (environment-value ,env 0 vari) (funcall (the eval-closure val*) ,env) - (,@env-ref 0 (1+ vari)) + (environment-value ,env 0 (1+ vari)) nil)) (incf vari 2) (go missing-optionals) @@ -412,13 +412,13 @@ (val* (pop default-values*)) (x (getf rest key unbound))) (if (eq unbound x) - (setf (,@env-ref 0 vari) + (setf (environment-value ,env 0 vari) (funcall (the eval-closure val*) ,env) - (,@env-ref 0 (1+ vari)) + (environment-value ,env 0 (1+ vari)) nil) - (setf (,@env-ref 0 vari) + (setf (environment-value ,env 0 vari) x - (,@env-ref 0 (1+ vari)) + (environment-value ,env 0 (1+ vari)) t))) (incf vari 2) (go keys) @@ -430,27 +430,27 @@ aux-num))) (go rest)) (let ((val* (pop default-values*))) - (setf (,@env-ref 0 vari) + (setf (environment-value ,env 0 vari) (funcall (the eval-closure val*) ,env))) (incf vari) (go aux) rest (assert (null default-values*)) (when restp - (setf (,@env-ref 0 (1- varnum)) + (setf (environment-value ,env 0 (1- varnum)) rest)))))) (if envp (lambda (env) (lambda (&rest args) (declare (dynamic-extent args)) (let ((new-env (make-environment env varnum))) - (handle-arguments args (environment-value new-env) new-env) + (handle-arguments args new-env) (funcall body* new-env)))) (lambda (env) (lambda (&rest args) (declare (dynamic-extent args)) (with-dynamic-extent-environment (new-env env varnum) - (handle-arguments args (environment-value new-env) new-env) + (handle-arguments args new-env) (funcall body* new-env)))))))))) |