Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv26091
Modified Files:
compiler.lisp
Log Message:
Add support for &aux in defun.
--- /project/movitz/cvsroot/movitz/compiler.lisp 2007/03/16 18:03:09 1.184
+++ /project/movitz/cvsroot/movitz/compiler.lisp 2007/03/21 19:57:52 1.185
@@ -8,7 +8,7 @@
;;;; Created at: Wed Oct 25 12:30:49 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: compiler.lisp,v 1.184 2007/03/16 18:03:09 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.185 2007/03/21 19:57:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -246,8 +246,7 @@
;; mutually recursive (lexically bound) functions.
(with-retries-until-true (retry-pass1 "Retry first-pass compilation of ~S." name)
;; First-pass is mostly functional, so it can safely be restarted.
- (multiple-value-bind (required-vars optional-vars rest-var key-vars
- aux-vars allow-p min max edx-var)
+ (multiple-value-bind (required-vars optional-vars rest-var key-vars aux-vars allow-p min max edx-var)
(decode-normal-lambda-list lambda-list)
(declare (ignore aux-vars allow-p min max))
;; There are several main branches through the function
@@ -307,7 +306,7 @@
(setf (extended-code function-env)
(append arg-init-code
(compiler-call #'compile-form
- :form (make-special-funarg-shadowing function-env function-form)
+ :form (make-special-funarg-shadowing function-env function-form)
:funobj funobj
:env function-env
:top-level-p top-level-p
@@ -4190,13 +4189,12 @@
(defun add-bindings-from-lambda-list (lambda-list env)
"From a (normal) <lambda-list>, add bindings to <env>."
(let ((arg-pos 0))
- (multiple-value-bind (required-vars optional-vars rest-var key-vars auxes allow-p
- min-args max-args edx-var oddeven key-vars-p)
+ (multiple-value-bind (required-vars optional-vars rest-var key-vars auxes allow-p min-args max-args edx-var oddeven key-vars-p)
(decode-normal-lambda-list lambda-list)
- (declare (ignore auxes))
(setf (min-args env) min-args
(max-args env) max-args
(oddeven-args env) oddeven
+ (aux-vars env) auxes
(allow-other-keys-p env) allow-p)
(flet ((shadow-when-special (formal env)
"Iff <formal> is special, return a fresh variable-name that takes <formal>'s place
@@ -4999,6 +4997,7 @@
function-body
(let ((shadowing
(append (special-variable-shadows env)
+ (aux-vars env)
(when (and (rest-var env)
(not (movitz-env-get (rest-var env) 'dynamic-extent nil env nil))
(not (movitz-env-get (rest-var env) 'ignore nil env nil)))
@@ -5518,7 +5517,7 @@
(compiler-values-bind (&all upstream)
(typecase form
(symbol (compiler-call #'compile-symbol :forward downstream))
- (cons (compiler-call #'compile-cons :forward downstream))
+ (cons (compiler-call #'compile-cons :forward downstream))
(t (compiler-call #'compile-self-evaluating :forward downstream)))
(when (typep (upstream :final-form) 'lexical-binding)
(labels ((fix-extent (binding)