From: William Harold Newman Date: Tue, 26 Aug 2003 13:21:18 +0000 (+0000) Subject: 0.8.3.3: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c41cb4c87eae7b04f844dca5f7edb5086c5d2d68;p=sbcl.git 0.8.3.3: revised PARSE-BODY to eliminate bogus style-warning for (MACROLET (...) (DECLAIM ...)) Since there are now two optional flags, use &KEY args instead of trying to remember the position of &OPTIONAL args. code-sharing in PROG and PROG* 'Twas passing strange passing ENV as the second argument to PARSE-BODY in ADD-METHOD-DECLARATIONS... new old BUGS (dunno why I discovered both on the same day) --- diff --git a/BUGS b/BUGS index dc5f0b3..0ad71a7 100644 --- a/BUGS +++ b/BUGS @@ -1117,6 +1117,62 @@ WORKAROUND: b. For the example above, the compiler does not issue a note. +279: type propagation error -- correctly inferred type goes astray? + In sbcl-0.8.3 and sbcl-0.8.1.47, the warning + The binding of ABS-FOO is a (VALUES (INTEGER 0 0) + &OPTIONAL), not a (INTEGER 1 536870911) + is emitted when compiling this file: + (declaim (ftype (function ((integer 0 #.most-positive-fixnum)) + (integer #.most-negative-fixnum 0)) + foo)) + (defun foo (x) + (- x)) + (defun bar (x) + (let* (;; Uncomment this for a type mismatch warning indicating + ;; that the type of (FOO X) is correctly understood. + #+nil (fs-foo (float-sign (foo x))) + ;; Uncomment this for a type mismatch warning + ;; indicating that the type of (ABS (FOO X)) is + ;; correctly understood. + #+nil (fs-abs-foo (float-sign (abs (foo x)))) + ;; something wrong with this one though + (abs-foo (abs (foo x)))) + (declare (type (integer 1 100) abs-foo)) + (print abs-foo))) + +280: bogus WARNING about duplicate function definition + In sbcl-0.8.3 and sbcl-0.8.1.47, if BS.MIN is defined inline, + e.g. by + (declaim (inline bs.min)) + (defun bs.min (bases) nil) + before compiling the file below, the compiler warns + Duplicate definition for BS.MIN found in one static + unit (usually a file). + when compiling + (declaim (special *minus* *plus* *stagnant*)) + (defun b.*.min (&optional (x () xp) (y () yp) &rest rest) + (bs.min avec)) + (define-compiler-macro b.*.min (&rest rest) + `(bs.min ,@rest)) + (defun afish-d-rbd (pd) + (if *stagnant* + (b.*.min (foo-d-rbd *stagnant*)) + (multiple-value-bind (reduce-fn initial-value) + (etypecase pd + (list (values #'bs.min 0)) + (vector (values #'bs.min *plus*))) + (let ((cv-ks (cv (kpd.ks pd)))) + (funcall reduce-fn d-rbds))))) + (defun bfish-d-rbd (pd) + (if *stagnant* + (b.*.min (foo-d-rbd *stagnant*)) + (multiple-value-bind (reduce-fn initial-value) + (etypecase pd + (list (values #'bs.min *minus*)) + (vector (values #'bs.min 0))) + (let ((cv-ks (cv (kpd.ks pd)))) + (funcall reduce-fn d-rbds))))) + DEFUNCT CATEGORIES OF BUGS IR1-#: These labels were used for bugs related to the old IR1 interpreter. diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 440fe2d..2379081 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -105,19 +105,17 @@ ;;;; various sequencing constructs -(defmacro-mundanely prog (varlist &body body-decls) - (multiple-value-bind (body decls) (parse-body body-decls nil) - `(block nil - (let ,varlist - ,@decls - (tagbody ,@body))))) - -(defmacro-mundanely prog* (varlist &body body-decls) - (multiple-value-bind (body decls) (parse-body body-decls nil) - `(block nil - (let* ,varlist - ,@decls - (tagbody ,@body))))) +(flet ((prog-expansion-from-let (varlist body-decls let) + (multiple-value-bind (body decls) + (parse-body body-decls :doc-string-allowed nil) + `(block nil + (,let ,varlist + ,@decls + (tagbody ,@body)))))) + (defmacro-mundanely prog (varlist &body body-decls) + (prog-expansion-from-let varlist body-decls 'let)) + (defmacro-mundanely prog* (varlist &body body-decls) + (prog-expansion-from-let varlist body-decls 'let*))) (defmacro-mundanely prog1 (result &body body) (let ((n-result (gensym))) @@ -305,7 +303,7 @@ ;; environment. We spuriously reference the gratuitous variable, ;; since we don't want to use IGNORABLE on what might be a special ;; var. - (multiple-value-bind (forms decls) (parse-body body nil) + (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil) (let ((n-list (gensym))) `(do* ((,n-list ,list (cdr ,n-list))) ((endp ,n-list) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 81b6f7b..065f569 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -370,7 +370,7 @@ ;;; Iterate over the entries in a HASH-TABLE. (defmacro dohash ((key-var value-var table &optional result) &body body) - (multiple-value-bind (forms decls) (parse-body body nil) + (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil) (let ((gen (gensym)) (n-more (gensym))) `(with-hash-table-iterator (,gen ,table) diff --git a/src/code/eval.lisp b/src/code/eval.lisp index 2b9f400..d77f90f 100644 --- a/src/code/eval.lisp +++ b/src/code/eval.lisp @@ -47,7 +47,8 @@ (return (eval-in-lexenv (first i) lexenv))))) (defun eval-locally (exp lexenv &optional vars) - (multiple-value-bind (body decls) (parse-body (rest exp) nil) + (multiple-value-bind (body decls) + (parse-body (rest exp) :doc-string-allowed nil) (let ((lexenv ;; KLUDGE: Uh, yeah. I'm not anticipating ;; winning any prizes for this code, which was diff --git a/src/code/macros.lisp b/src/code/macros.lisp index 1091114..4ef3dc0 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -319,7 +319,8 @@ ;;;; WITH-FOO i/o-related macros (defmacro-mundanely with-open-stream ((var stream) &body forms-decls) - (multiple-value-bind (forms decls) (parse-body forms-decls nil) + (multiple-value-bind (forms decls) + (parse-body forms-decls :doc-string-allowed nil) (let ((abortp (gensym))) `(let ((,var ,stream) (,abortp t)) @@ -338,7 +339,8 @@ (defmacro-mundanely with-input-from-string ((var string &key index start end) &body forms-decls) - (multiple-value-bind (forms decls) (parse-body forms-decls nil) + (multiple-value-bind (forms decls) + (parse-body forms-decls :doc-string-allowed nil) ;; The ONCE-ONLY inhibits compiler note for unreachable code when ;; END is true. (once-only ((string string)) @@ -366,7 +368,8 @@ (defmacro-mundanely with-output-to-string ((var &optional string &key (element-type ''character)) &body forms-decls) - (multiple-value-bind (forms decls) (parse-body forms-decls nil) + (multiple-value-bind (forms decls) + (parse-body forms-decls :doc-string-allowed nil) (if string `(let ((,var (make-fill-pointer-output-stream ,string))) ,@decls diff --git a/src/code/package.lisp b/src/code/package.lisp index 4239b37..bc7ca27 100644 --- a/src/code/package.lisp +++ b/src/code/package.lisp @@ -111,7 +111,8 @@ "DO-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECLARATION}* {TAG | FORM}* Executes the FORMs at least once for each symbol accessible in the given PACKAGE with VAR bound to the current symbol." - (multiple-value-bind (body decls) (parse-body body-decls nil) + (multiple-value-bind (body decls) + (parse-body body-decls :doc-string-allowed nil) (let ((flet-name (gensym "DO-SYMBOLS-"))) `(block nil (flet ((,flet-name (,var) @@ -146,7 +147,8 @@ "DO-EXTERNAL-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECL}* {TAG | FORM}* Executes the FORMs once for each external symbol in the given PACKAGE with VAR bound to the current symbol." - (multiple-value-bind (body decls) (parse-body body-decls nil) + (multiple-value-bind (body decls) + (parse-body body-decls :doc-string-allowed nil) (let ((flet-name (gensym "DO-SYMBOLS-"))) `(block nil (flet ((,flet-name (,var) @@ -171,7 +173,8 @@ "DO-ALL-SYMBOLS (VAR [RESULT-FORM]) {DECLARATION}* {TAG | FORM}* Executes the FORMs once for each symbol in every package with VAR bound to the current symbol." - (multiple-value-bind (body decls) (parse-body body-decls nil) + (multiple-value-bind (body decls) + (parse-body body-decls :doc-string-allowed nil) (let ((flet-name (gensym "DO-SYMBOLS-"))) `(block nil (flet ((,flet-name (,var) diff --git a/src/code/parse-body.lisp b/src/code/parse-body.lisp index 616b16b..53365a6 100644 --- a/src/code/parse-body.lisp +++ b/src/code/parse-body.lisp @@ -26,53 +26,55 @@ ;;; ;;; If DOC-STRING-ALLOWED is NIL, then no forms will be treated as ;;; documentation strings. -(defun parse-body (body &optional (doc-string-allowed t)) +(defun parse-body (body &key (doc-string-allowed t) (toplevel nil)) (let ((reversed-decls nil) (forms body) (doc nil)) - ;; Since we don't have macros like AND, OR, and NOT yet, it's - ;; hard to express these tests clearly. Giving them names - ;; seems to help a little bit. + ;; Since we don't have macros like AND, OR, and NOT yet, it's hard + ;; to express these tests clearly. Giving them names seems to help + ;; a little bit. (flet ((doc-string-p (x remaining-forms) (if (stringp x) - (if doc-string-allowed - ;; ANSI 3.4.11 explicitly requires that a doc - ;; string be followed by another form (either an - ;; ordinary form or a declaration). Hence: - (if remaining-forms - (if doc - ;; ANSI 3.4.11 says that the consequences of - ;; duplicate doc strings are unspecified. - ;; That's probably not something the - ;; programmer intends. We raise an error so - ;; that this won't pass unnoticed. - (error "duplicate doc string ~S" x) - t))))) + (if doc-string-allowed + ;; ANSI 3.4.11 explicitly requires that a doc + ;; string be followed by another form (either an + ;; ordinary form or a declaration). Hence: + (if remaining-forms + (if doc + ;; ANSI 3.4.11 says that the consequences of + ;; duplicate doc strings are unspecified. + ;; That's probably not something the + ;; programmer intends. We raise an error so + ;; that this won't pass unnoticed. + (error "duplicate doc string ~S" x) + t))))) (declaration-p (x) (if (consp x) (let ((name (car x))) - (if (eq name 'declaim) - ;; technically legal, but rather unlikely to - ;; be what the user intended... - (progn - (style-warn - "DECLAIM where DECLARE was probably intended") - nil) - (eq name 'declare)))))) + (case name + ((declare) t) + ((declaim) + (unless toplevel + ;; technically legal, but rather unlikely to + ;; be what the user meant to do... + (style-warn + "DECLAIM where DECLARE was probably intended") + nil)) + (t nil)))))) (tagbody :again (if forms - (let ((form1 (first forms))) - ;; Note: The (IF (IF ..) ..) stuff is because we don't - ;; have the macro AND yet.:-| - (if (doc-string-p form1 (rest forms)) - (setq doc form1) - (if (declaration-p form1) - (setq reversed-decls - (cons form1 reversed-decls)) - (go :done))) - (setq forms (rest forms)) - (go :again))) + (let ((form1 (first forms))) + ;; Note: The (IF (IF ..) ..) stuff is because we don't + ;; have the macro AND yet.:-| + (if (doc-string-p form1 (rest forms)) + (setq doc form1) + (if (declaration-p form1) + (setq reversed-decls + (cons form1 reversed-decls)) + (go :done))) + (setq forms (rest forms)) + (go :again))) :done) (values forms (nreverse reversed-decls) diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp index 55121c9..94f8325 100644 --- a/src/code/parse-defmacro.lisp +++ b/src/code/parse-defmacro.lisp @@ -28,7 +28,7 @@ (defvar *ignorable-vars*) (declaim (type list *ignorable-vars*)) -;;; Return, as multiple values, a body, possibly a declare form to put +;;; Return, as multiple values, a body, possibly a DECLARE form to put ;;; where this code is inserted, the documentation for the parsed ;;; body, and bounds on the number of arguments. (defun parse-defmacro (lambda-list arg-list-name body name error-kind @@ -40,7 +40,7 @@ (error-fun 'error) (wrap-block t)) (multiple-value-bind (forms declarations documentation) - (parse-body body doc-string-allowed) + (parse-body body :doc-string-allowed doc-string-allowed) (let ((*arg-tests* ()) (*user-lets* ()) (*system-lets* ()) diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp index a68c54a..a70b2c2 100644 --- a/src/code/primordial-extensions.lisp +++ b/src/code/primordial-extensions.lisp @@ -98,7 +98,8 @@ (t (illegal-varlist))))) (t (illegal-varlist))))) ;; Construct the new form. - (multiple-value-bind (code decls) (parse-body decls-and-code nil) + (multiple-value-bind (code decls) + (parse-body decls-and-code :doc-string-allowed nil) `(block ,block (,bind ,(nreverse r-inits) ,@decls diff --git a/src/code/seq.lisp b/src/code/seq.lisp index 0d4a153..2d0b5a7 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -77,7 +77,7 @@ (sb!xc:defmacro define-sequence-traverser (name args &body body) (multiple-value-bind (body declarations docstring) - (parse-body body t) + (parse-body body :doc-string-allowed t) (collect ((new-args) (new-declarations) (adjustments)) (dolist (arg args) (case arg diff --git a/src/code/typedefs.lisp b/src/code/typedefs.lisp index 45b9104..2317930 100644 --- a/src/code/typedefs.lisp +++ b/src/code/typedefs.lisp @@ -43,7 +43,8 @@ (if (eq '&whole (car arglist)) (values (cadr arglist) (cddr arglist)) (values (gensym) arglist)) - (multiple-value-bind (forms decls) (parse-body body nil) + (multiple-value-bind (forms decls) + (parse-body body :doc-string-allowed nil) `(progn (!cold-init-forms (setf (info :type :translator ',name) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index b271599..e188acb 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -530,7 +530,8 @@ evaluated." (if (null bindings) (ir1-translate-locally body start cont) - (multiple-value-bind (forms decls) (parse-body body nil) + (multiple-value-bind (forms decls) + (parse-body body :doc-string-allowed nil) (multiple-value-bind (vars values) (extract-let-vars bindings 'let) (let* ((fun-cont (make-continuation)) (cont (processing-decls (decls vars nil cont) @@ -548,7 +549,8 @@ "LET* ({(Var [Value]) | Var}*) Declaration* Form* Similar to LET, but the variables are bound sequentially, allowing each Value form to reference any of the previous Vars." - (multiple-value-bind (forms decls) (parse-body body nil) + (multiple-value-bind (forms decls) + (parse-body body :doc-string-allowed nil) (multiple-value-bind (vars values) (extract-let-vars bindings 'let*) (processing-decls (decls vars nil cont) (ir1-convert-aux-bindings start cont forms vars values))))) @@ -562,7 +564,7 @@ ;;; forms before we hit the IR1 transform level. (defun ir1-translate-locally (body start cont &key vars funs) (declare (type list body) (type continuation start cont)) - (multiple-value-bind (forms decls) (parse-body body nil) + (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil) (processing-decls (decls vars funs cont) (ir1-convert-progn-body start cont forms)))) @@ -607,7 +609,8 @@ Evaluate the Body-Forms with some local function definitions. The bindings do not enclose the definitions; any use of Name in the Forms will refer to the lexically apparent function definition in the enclosing environment." - (multiple-value-bind (forms decls) (parse-body body nil) + (multiple-value-bind (forms decls) + (parse-body body :doc-string-allowed nil) (multiple-value-bind (names defs) (extract-flet-vars definitions 'flet) (let ((fvars (mapcar (lambda (n d) @@ -627,7 +630,7 @@ Evaluate the Body-Forms with some local function definitions. The bindings enclose the new definitions, so the defined functions can call themselves or each other." - (multiple-value-bind (forms decls) (parse-body body nil) + (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil) (multiple-value-bind (names defs) (extract-flet-vars definitions 'labels) (let* ( ;; dummy LABELS functions, to be used as placeholders diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index bb0ecb5..9c8597a 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -835,7 +835,8 @@ ;;; We parse declarations and then recursively process the body. (defun process-toplevel-locally (body path compile-time-too &key vars funs) (declare (list path)) - (multiple-value-bind (forms decls) (parse-body body nil) + (multiple-value-bind (forms decls) + (parse-body body :doc-string-allowed nil :toplevel t) (let* ((*lexenv* (process-decls decls vars funs)) ;; FIXME: VALUES declaration ;; diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index fb6f0f7..478e578 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -1001,41 +1001,41 @@ ;;; a function. ;;; ;;; Given the continuation ARG, derive the resulting type using the -;;; DERIVE-FCN. DERIVE-FCN takes exactly one argument which is some +;;; DERIVE-FUN. DERIVE-FUN takes exactly one argument which is some ;;; "atomic" continuation type like numeric-type or member-type ;;; (containing just one element). It should return the resulting ;;; type, which can be a list of types. ;;; -;;; For the case of member types, if a member-fcn is given it is +;;; For the case of member types, if a MEMBER-FUN is given it is ;;; called to compute the result otherwise the member type is first -;;; converted to a numeric type and the derive-fcn is call. -(defun one-arg-derive-type (arg derive-fcn member-fcn +;;; converted to a numeric type and the DERIVE-FUN is called. +(defun one-arg-derive-type (arg derive-fun member-fun &optional (convert-type t)) - (declare (type function derive-fcn) - (type (or null function) member-fcn)) + (declare (type function derive-fun) + (type (or null function) member-fun)) (let ((arg-list (prepare-arg-for-derive-type (continuation-type arg)))) (when arg-list (flet ((deriver (x) (typecase x (member-type - (if member-fcn + (if member-fun (with-float-traps-masked (:underflow :overflow :divide-by-zero) (make-member-type :members (list - (funcall member-fcn + (funcall member-fun (first (member-type-members x)))))) ;; Otherwise convert to a numeric type. (let ((result-type-list - (funcall derive-fcn (convert-member-type x)))) + (funcall derive-fun (convert-member-type x)))) (if convert-type (convert-back-numeric-type-list result-type-list) result-type-list)))) (numeric-type (if convert-type (convert-back-numeric-type-list - (funcall derive-fcn (convert-numeric-type x))) - (funcall derive-fcn x))) + (funcall derive-fun (convert-numeric-type x))) + (funcall derive-fun x))) (t *universal-type*)))) ;; Run down the list of args and derive the type of each one, @@ -1051,14 +1051,14 @@ (first results))))))) ;;; Same as ONE-ARG-DERIVE-TYPE, except we assume the function takes -;;; two arguments. DERIVE-FCN takes 3 args in this case: the two +;;; two arguments. DERIVE-FUN takes 3 args in this case: the two ;;; original args and a third which is T to indicate if the two args ;;; really represent the same continuation. This is useful for ;;; deriving the type of things like (* x x), which should always be ;;; positive. If we didn't do this, we wouldn't be able to tell. -(defun two-arg-derive-type (arg1 arg2 derive-fcn fcn +(defun two-arg-derive-type (arg1 arg2 derive-fun fun &optional (convert-type t)) - (declare (type function derive-fcn fcn)) + (declare (type function derive-fun fun)) (flet ((deriver (x y same-arg) (cond ((and (member-type-p x) (member-type-p y)) (let* ((x (first (member-type-members x))) @@ -1066,7 +1066,7 @@ (result (with-float-traps-masked (:underflow :overflow :divide-by-zero :invalid) - (funcall fcn x y)))) + (funcall fun x y)))) (cond ((null result)) ((and (floatp result) (float-nan-p result)) (make-numeric-type :class 'float @@ -1077,21 +1077,21 @@ ((and (member-type-p x) (numeric-type-p y)) (let* ((x (convert-member-type x)) (y (if convert-type (convert-numeric-type y) y)) - (result (funcall derive-fcn x y same-arg))) + (result (funcall derive-fun x y same-arg))) (if convert-type (convert-back-numeric-type-list result) result))) ((and (numeric-type-p x) (member-type-p y)) (let* ((x (if convert-type (convert-numeric-type x) x)) (y (convert-member-type y)) - (result (funcall derive-fcn x y same-arg))) + (result (funcall derive-fun x y same-arg))) (if convert-type (convert-back-numeric-type-list result) result))) ((and (numeric-type-p x) (numeric-type-p y)) (let* ((x (if convert-type (convert-numeric-type x) x)) (y (if convert-type (convert-numeric-type y) y)) - (result (funcall derive-fcn x y same-arg))) + (result (funcall derive-fun x y same-arg))) (if convert-type (convert-back-numeric-type-list result) result))) @@ -2226,10 +2226,10 @@ (t (specifier-type 'integer)))))) -(macrolet ((deffrob (logfcn) - (let ((fcn-aux (symbolicate logfcn "-DERIVE-TYPE-AUX"))) - `(defoptimizer (,logfcn derive-type) ((x y)) - (two-arg-derive-type x y #',fcn-aux #',logfcn))))) +(macrolet ((deffrob (logfun) + (let ((fun-aux (symbolicate logfun "-DERIVE-TYPE-AUX"))) + `(defoptimizer (,logfun derive-type) ((x y)) + (two-arg-derive-type x y #',fun-aux #',logfun))))) (deffrob logand) (deffrob logior) (deffrob logxor)) diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index b0ba8d2..8541b0b 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -499,11 +499,12 @@ bootstrapping. env)))) (defun add-method-declarations (name qualifiers lambda-list body env) + (declare (ignore env)) (multiple-value-bind (parameters unspecialized-lambda-list specializers) (parse-specialized-lambda-list lambda-list) (declare (ignore parameters)) (multiple-value-bind (real-body declarations documentation) - (parse-body body env) + (parse-body body) (values `(lambda ,unspecialized-lambda-list ,@(when documentation `(,documentation)) ;; (Old PCL code used a somewhat different style of @@ -635,7 +636,7 @@ bootstrapping. is not a lambda form." method-lambda)) (multiple-value-bind (real-body declarations documentation) - (parse-body (cddr method-lambda) env) + (parse-body (cddr method-lambda)) (let* ((name-decl (get-declaration '%method-name declarations)) (sll-decl (get-declaration '%method-lambda-list declarations)) (method-name (when (consp name-decl) (car name-decl))) @@ -725,7 +726,7 @@ bootstrapping. (multiple-value-bind (walked-lambda-body walked-declarations walked-documentation) - (parse-body (cddr walked-lambda) env) + (parse-body (cddr walked-lambda)) (declare (ignore walked-documentation)) (when (or next-method-p-p call-next-method-p) (setq plist (list* :needs-next-methods-p t plist))) diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index 9a1f11e..e6bfa4b 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -1013,8 +1013,8 @@ ;;; body given, or return NIL if no %METHOD-NAME declaration is found. (defun body-method-name (body) (multiple-value-bind (real-body declarations documentation) - (parse-body body nil) - (declare (ignore documentation real-body)) + (parse-body body) + (declare (ignore real-body documentation)) (let ((name-decl (get-declaration '%method-name declarations))) (and name-decl (destructuring-bind (name) name-decl diff --git a/version.lisp-expr b/version.lisp-expr index 4fd277c..2b1f5af 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -16,4 +16,4 @@ ;;; with something arbitrary in the fourth field, is used for CVS ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS -"0.8.3.2" +"0.8.3.3"