Changeset 15314


Ignore:
Timestamp:
Apr 10, 2012, 5:57:45 AM (13 years ago)
Author:
Gary Byers
Message:

Warn (via full warning) on duplicate bindings in SYMBOL-MACROLET,
MACROLET, FLET, LABELS (fixes ticket:927.)

If a DECLARE expression is encountered when a form is expected,
make the error message more verbose (and mention macroexpansion
as a possible cause of the problem.) Fixes ticket:926.

Warn (via a full warning) if a local function shadows a global
CL function name. Fixes ticket:923.

If STYLE-WARNINGs are incidentally signaled during (e.g.)
macroexpansion and are handled and postprocessed by the compiler,
ensure that the warning actually generated will be a STYLE-WARNING.

Location:
trunk/source/compiler
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/compiler/nx-basic.lisp

    r15307 r15314  
    690690    (:format-error . "~:{~@?~%~}")
    691691    (:program-error . "~a")
    692     (:unsure . "Nonspecific warning")))
     692    (:unsure . "Nonspecific warning")
     693    (:duplicate-binding . "Multiple bindings of ~S in ~A form")
     694    (:shadow-cl-package-definition . "Local function or macro name ~s shadows standard CL definition.")))
    693695
    694696(defun report-invalid-type-compiler-warning (condition stream)

  • trunk/source/compiler/nx0.lisp

    r15307 r15314  
    11101110               (neq (nx-var-root-nsetqs target) (cadr pair)))
    11111111             (push (cons var target) *nx-punted-vars*)))))
     1112
     1113;;; Someone might be able to come up with a case where (perhaps through
     1114;;; use of (DECLAIM (IGNORE ...))) it might make some sense to bind
     1115;;; the same variable more than once in a parallel binding construct.
     1116;;; Even if that's done intentionally, there's probably some value
     1117;;; in warning about it (and it's hard to guess whether it's done
     1118;;; intentionally.
     1119;;; Something like (LET* ((X 1) (X (1+ X))) ...) is well-defined (even
     1120;;; if it's a bit unaesthetic.
     1121;;; We error if there are duplicate required args in a lambda list,
     1122;;; but let things like (LAMBDA (A &OPTIONAL A) ...) slide.  (Those
     1123;;; cases generally generate an unused-variable warning, so we don't
     1124
     1125(defun nx1-check-duplicate-bindings (syms context)
     1126  (do* ()
     1127       ((null syms))
     1128    (let* ((sym (pop syms)))
     1129      (when (member sym syms :test #'eq)
     1130        (nx1-whine :duplicate-binding (maybe-setf-name sym) context)))))
     1131             
    11121132
    11131133(defun nx1-punt-var (var initform)
    … …  
    19331953
    19341954(defun nx1-whine (about &rest forms)
    1935   (push (make-condition (or (cdr (assq about *compiler-whining-conditions*)) 'compiler-warning)
    1936                         :function-name (list *nx-cur-func-name*)
    1937                         :source-note *nx-current-note*
    1938                         :warning-type about
    1939                         :args (or forms (list nil)))
    1940         *nx-warnings*))
     1955  ;; Don't turn STYLE-WARNINGs generated during compilation into
     1956  ;; vanilla COMPILER-WARNINGs.
     1957  (let* ((c (if (and (eq about :program-error)
     1958                     (typep (car forms) 'style-warning))
     1959              (let* ((c (car forms)))
     1960                (with-slots (source-note function-name) c
     1961                  (setq source-note *nx-current-note*
     1962                        function-name (list *nx-cur-func-name*))
     1963                  c))
     1964              (make-condition (or (cdr (assq about *compiler-whining-conditions*))
     1965                                  'compiler-warning)
     1966                              :function-name (list *nx-cur-func-name*)
     1967                              :source-note *nx-current-note*
     1968                              :warning-type about
     1969                              :args (or forms (list nil))))))
     1970
     1971    (push c *nx-warnings*)))
    19411972
    19421973(defun p2-whine (afunc about &rest forms)

  • trunk/source/compiler/nx1.lisp

    r15307 r15314  
    207207(defnx1 nx1-macrolet macrolet context (defs &body body)
    208208  (let* ((old-env *nx-lexical-environment*)
    209          (new-env (new-lexical-environment old-env)))
     209         (new-env (new-lexical-environment old-env))
     210         (names ()))
    210211    (dolist (def defs)
    211212      (destructuring-bind (name arglist &body mbody) def
     213        (push name names)
    212214        (push
    213215         (cons
    … …  
    220222             function)))
    221223         (lexenv.functions new-env))))
     224    (nx1-check-duplicate-bindings names 'macrolet)
    222225    (let* ((*nx-lexical-environment* new-env))
    223226      (with-nx-declarations (pending)
    … …  
    235238        (let ((env *nx-lexical-environment*)
    236239              (*nx-bound-vars* *nx-bound-vars*))
    237           (dolist (def defs)
    238             (destructuring-bind (sym expansion) def
    239               (let* ((var (nx-new-var pending sym))
    240                      (bits (nx-var-bits var)))
    241                 (when (%ilogbitp $vbitspecial bits)
    242                   (nx-error "SPECIAL declaration applies to symbol macro ~s" sym))
    243                 (nx-set-var-bits var (%ilogior (%ilsl $vbitignoreunused 1) bits))
    244                 (setf (var-ea var) (cons :symbol-macro expansion)))))
     240          (collect ((vars)
     241                    (symbols))
     242            (dolist (def defs)
     243              (destructuring-bind (sym expansion) def
     244                (let* ((var (nx-new-var pending sym))
     245                       (bits (nx-var-bits var)))
     246                  (symbols sym)
     247                  (when (%ilogbitp $vbitspecial bits)
     248                    (nx-error "SPECIAL declaration applies to symbol macro ~s" sym))
     249                  (nx-set-var-bits var (%ilogior (%ilsl $vbitignoreunused 1) bits))
     250                  (setf (var-ea var) (cons :symbol-macro expansion))
     251                  (vars var))))
     252            (nx1-check-duplicate-bindings (symbols) 'symbol-macrolet))
    245253          (nx-effect-other-decls pending env)
    246254          (nx1-env-body context body old-env))))))
    … …  
    17731781       *nx-new-p2decls*))))
    17741782
     1783(defun maybe-warn-about-shadowing-cl-function-name (funcname)
     1784  (when (and (symbolp funcname)
     1785             (fboundp funcname)
     1786             (eq (symbol-package funcname) (find-package "CL")))
     1787    (nx1-whine :shadow-cl-package-definition funcname)
     1788    t))
     1789
    17751790(defun maybe-warn-about-nx1-alphatizer-binding (funcname)
    1776   (when (and (symbolp funcname)
    1777              (gethash funcname *nx1-alphatizers*))
    1778     (nx1-whine :special-fbinding funcname)))
     1791  (or (maybe-warn-about-shadowing-cl-function-name funcname)
     1792      (when (and (symbolp funcname)
     1793                 (gethash funcname *nx1-alphatizers*))
     1794        (nx1-whine :special-fbinding funcname))))
     1795
     1796
    17791797
    17801798(defnx1 nx1-flet flet context (defs &body forms)
    … …  
    17881806           (pairs nil)
    17891807           (fname nil)
    1790            (name nil))
     1808           (name nil)
     1809           (fnames ()))
    17911810      (multiple-value-bind (body decls) (parse-body forms env nil)
    17921811        (nx-process-declarations pending decls)
    … …  
    17941813          (destructuring-bind (funcname lambda-list &body flet-function-body) def
    17951814            (setq fname (nx-need-function-name funcname))
     1815            (push fname fnames)
    17961816            (maybe-warn-about-nx1-alphatizer-binding funcname)
    17971817            (multiple-value-bind (body decls)
    … …  
    18151835                (push (setq name (make-symbol (symbol-name funcname))) names)
    18161836                (push (cons funcname (cons 'function (cons func name))) (lexenv.functions new-env))))))
     1837        (nx1-check-duplicate-bindings fnames 'flet)
    18171838        (let ((vars nil)
    18181839              (rvars nil)
    … …  
    18741895           (blockname nil)
    18751896           (fname nil)
    1876            (name nil))
     1897           (name nil)
     1898           (fnames ()))
    18771899      (multiple-value-bind (body decls) (parse-body forms env nil)
    18781900        (dolist (def defs (setq funcs (nreverse funcs) bodies (nreverse bodies)))
    … …  
    18821904            (setq blockname funcname)
    18831905            (setq fname (nx-need-function-name funcname))
     1906            (push fname fnames)
    18841907            (when (consp funcname)
    18851908              (setq blockname (%cadr funcname) funcname fname))
    … …  
    19081931        (nx-reconcile-inherited-vars funcrefs)
    19091932        (dolist (f funcrefs) (nx1-afunc-ref f))
     1933        (nx1-check-duplicate-bindings fnames 'labels)
    19101934        (make-acode
    19111935         (%nx1-operator labels)
    … …  
    24672491  (nx1-progn-body context (if (or (memq 'eval when) (memq :execute when)) body)))
    24682492
    2469 (defnx1 nx1-misplaced (declare) context (&rest args)
    2470   (nx-error "~S not expected in ~S." *nx-sfname* (cons *nx-sfname* args)))
    2471 
     2493(defnx1 nx1-misplaced (declare) context (&whole w &rest args)
     2494  (declare (ignore args))
     2495  (nx-error "The DECLARE expression ~s is being treated as a form,
     2496possibly because it's the result of macroexpansion. DECLARE expressions
     2497can only appear in specified contexts and must be actual subexressions
     2498of the containing forms." w))
     2499
     2500
Note: See TracChangeset for help on using the changeset viewer.