Index: /trunk/source/compiler/nx-basic.lisp =================================================================== --- /trunk/source/compiler/nx-basic.lisp (revision 15306) +++ /trunk/source/compiler/nx-basic.lisp (revision 15307) @@ -690,7 +690,5 @@ (:format-error . "~:{~@?~%~}") (:program-error . "~a") - (:unsure . "Nonspecific warning") - (:duplicate-binding . "Multiple bindings of ~S in ~A form") - (:shadow-cl-package-definition . "Local function or macro name ~s shadows standard CL definition."))) + (:unsure . "Nonspecific warning"))) (defun report-invalid-type-compiler-warning (condition stream) Index: /trunk/source/compiler/nx.lisp =================================================================== --- /trunk/source/compiler/nx.lisp (revision 15306) +++ /trunk/source/compiler/nx.lisp (revision 15307) @@ -232,6 +232,5 @@ (:format-error . style-warning) (:unused . style-warning) - (:type-conflict . style-warning) - (:duplicate-binding . style-warning))) + (:type-conflict . style-warning))) Index: /trunk/source/compiler/nx0.lisp =================================================================== --- /trunk/source/compiler/nx0.lisp (revision 15306) +++ /trunk/source/compiler/nx0.lisp (revision 15307) @@ -1110,24 +1110,4 @@ (neq (nx-var-root-nsetqs target) (cadr pair))) (push (cons var target) *nx-punted-vars*))))) - -;;; Someone might be able to come up with a case where (perhaps through -;;; use of (DECLAIM (IGNORE ...))) it might make some sense to bind -;;; the same variable more than once in a parallel binding construct. -;;; Even if that's done intentionally, there's probably some value -;;; in warning about it (and it's hard to guess whether it's done -;;; intentionally. -;;; Something like (LET* ((X 1) (X (1+ X))) ...) is well-defined (even -;;; if it's a bit unaesthetic. -;;; We error if there are duplicate required args in a lambda list, -;;; but let things like (LAMBDA (A &OPTIONAL A) ...) slide. (Those -;;; cases generally generate an unused-variable warning, so we don't - -(defun nx1-check-duplicate-bindings (syms context) - (do* () - ((null syms)) - (let* ((sym (pop syms))) - (when (member sym syms :test #'eq) - (nx1-whine :duplicate-binding (maybe-setf-name sym) context))))) - (defun nx1-punt-var (var initform) @@ -1953,21 +1933,10 @@ (defun nx1-whine (about &rest forms) - ;; Don't turn STYLE-WARNINGs generated during compilation into - ;; vanilla COMPILER-WARNINGs. - (let* ((c (if (and (eq about :program-error) - (typep (car forms) 'style-warning)) - (let* ((c (car forms))) - (with-slots (source-note function-name) c - (setq source-note *nx-current-note* - function-name (list *nx-cur-func-name*)) - c)) - (make-condition (or (cdr (assq about *compiler-whining-conditions*)) - 'compiler-warning) - :function-name (list *nx-cur-func-name*) - :source-note *nx-current-note* - :warning-type about - :args (or forms (list nil)))))) - - (push c *nx-warnings*))) + (push (make-condition (or (cdr (assq about *compiler-whining-conditions*)) 'compiler-warning) + :function-name (list *nx-cur-func-name*) + :source-note *nx-current-note* + :warning-type about + :args (or forms (list nil))) + *nx-warnings*)) (defun p2-whine (afunc about &rest forms) Index: /trunk/source/compiler/nx1.lisp =================================================================== --- /trunk/source/compiler/nx1.lisp (revision 15306) +++ /trunk/source/compiler/nx1.lisp (revision 15307) @@ -207,9 +207,7 @@ (defnx1 nx1-macrolet macrolet context (defs &body body) (let* ((old-env *nx-lexical-environment*) - (new-env (new-lexical-environment old-env)) - (names ())) + (new-env (new-lexical-environment old-env))) (dolist (def defs) (destructuring-bind (name arglist &body mbody) def - (push name names) (push (cons @@ -222,5 +220,4 @@ function))) (lexenv.functions new-env)))) - (nx1-check-duplicate-bindings names 'macrolet) (let* ((*nx-lexical-environment* new-env)) (with-nx-declarations (pending) @@ -238,17 +235,12 @@ (let ((env *nx-lexical-environment*) (*nx-bound-vars* *nx-bound-vars*)) - (collect ((vars) - (symbols)) - (dolist (def defs) - (destructuring-bind (sym expansion) def - (let* ((var (nx-new-var pending sym)) - (bits (nx-var-bits var))) - (symbols sym) - (when (%ilogbitp $vbitspecial bits) - (nx-error "SPECIAL declaration applies to symbol macro ~s" sym)) - (nx-set-var-bits var (%ilogior (%ilsl $vbitignoreunused 1) bits)) - (setf (var-ea var) (cons :symbol-macro expansion)) - (vars var)))) - (nx1-check-duplicate-bindings (symbols) 'symbol-macrolet)) + (dolist (def defs) + (destructuring-bind (sym expansion) def + (let* ((var (nx-new-var pending sym)) + (bits (nx-var-bits var))) + (when (%ilogbitp $vbitspecial bits) + (nx-error "SPECIAL declaration applies to symbol macro ~s" sym)) + (nx-set-var-bits var (%ilogior (%ilsl $vbitignoreunused 1) bits)) + (setf (var-ea var) (cons :symbol-macro expansion))))) (nx-effect-other-decls pending env) (nx1-env-body context body old-env)))))) @@ -1781,18 +1773,8 @@ *nx-new-p2decls*)))) -(defun maybe-warn-about-shadowing-cl-function-name (funcname) +(defun maybe-warn-about-nx1-alphatizer-binding (funcname) (when (and (symbolp funcname) - (fboundp funcname) - (eq (symbol-package funcname) (find-package "CL"))) - (nx1-whine :shadow-cl-package-definition funcname) - t)) - -(defun maybe-warn-about-nx1-alphatizer-binding (funcname) - (or (maybe-warn-about-shadowing-cl-function-name funcname) - (when (and (symbolp funcname) - (gethash funcname *nx1-alphatizers*)) - (nx1-whine :special-fbinding funcname)))) - - + (gethash funcname *nx1-alphatizers*)) + (nx1-whine :special-fbinding funcname))) (defnx1 nx1-flet flet context (defs &body forms) @@ -1806,6 +1788,5 @@ (pairs nil) (fname nil) - (name nil) - (fnames ())) + (name nil)) (multiple-value-bind (body decls) (parse-body forms env nil) (nx-process-declarations pending decls) @@ -1813,5 +1794,4 @@ (destructuring-bind (funcname lambda-list &body flet-function-body) def (setq fname (nx-need-function-name funcname)) - (push fname fnames) (maybe-warn-about-nx1-alphatizer-binding funcname) (multiple-value-bind (body decls) @@ -1835,5 +1815,4 @@ (push (setq name (make-symbol (symbol-name funcname))) names) (push (cons funcname (cons 'function (cons func name))) (lexenv.functions new-env)))))) - (nx1-check-duplicate-bindings fnames 'flet) (let ((vars nil) (rvars nil) @@ -1895,6 +1874,5 @@ (blockname nil) (fname nil) - (name nil) - (fnames ())) + (name nil)) (multiple-value-bind (body decls) (parse-body forms env nil) (dolist (def defs (setq funcs (nreverse funcs) bodies (nreverse bodies))) @@ -1904,5 +1882,4 @@ (setq blockname funcname) (setq fname (nx-need-function-name funcname)) - (push fname fnames) (when (consp funcname) (setq blockname (%cadr funcname) funcname fname)) @@ -1931,5 +1908,4 @@ (nx-reconcile-inherited-vars funcrefs) (dolist (f funcrefs) (nx1-afunc-ref f)) - (nx1-check-duplicate-bindings fnames 'labels) (make-acode (%nx1-operator labels) @@ -2491,10 +2467,5 @@ (nx1-progn-body context (if (or (memq 'eval when) (memq :execute when)) body))) -(defnx1 nx1-misplaced (declare) context (&whole w &rest args) - (declare (ignore args)) - (nx-error "The DECLARE expression ~s is being treated as a form, -possibly because it's the result of macroexpansion. DECLARE expressions -can only appear in specified contexts and must be actual subexressions -of the containing forms." w)) - - +(defnx1 nx1-misplaced (declare) context (&rest args) + (nx-error "~S not expected in ~S." *nx-sfname* (cons *nx-sfname* args))) +