Changeset 15307


Ignore:
Timestamp:
Apr 9, 2012, 10:41:52 AM (8 years ago)
Author:
gb
Message:

Revert to previous versions (these files were checked in accidentally
in r15306.)

Location:
trunk/source/compiler
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx-basic.lisp

    r15306 r15307  
    690690    (:format-error . "~:{~@?~%~}")
    691691    (:program-error . "~a")
    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.")))
     692    (:unsure . "Nonspecific warning")))
    695693
    696694(defun report-invalid-type-compiler-warning (condition stream)
  • trunk/source/compiler/nx.lisp

    r15306 r15307  
    232232    (:format-error . style-warning)
    233233    (:unused . style-warning)
    234     (:type-conflict . style-warning)
    235     (:duplicate-binding . style-warning)))
     234    (:type-conflict . style-warning)))
    236235
    237236
  • trunk/source/compiler/nx0.lisp

    r15306 r15307  
    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              
    11321112
    11331113(defun nx1-punt-var (var initform)
     
    19531933
    19541934(defun nx1-whine (about &rest forms)
    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*)))
     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*))
    19721941
    19731942(defun p2-whine (afunc about &rest forms)
  • trunk/source/compiler/nx1.lisp

    r15306 r15307  
    207207(defnx1 nx1-macrolet macrolet context (defs &body body)
    208208  (let* ((old-env *nx-lexical-environment*)
    209          (new-env (new-lexical-environment old-env))
    210          (names ()))
     209         (new-env (new-lexical-environment old-env)))
    211210    (dolist (def defs)
    212211      (destructuring-bind (name arglist &body mbody) def
    213         (push name names)
    214212        (push
    215213         (cons
     
    222220             function)))
    223221         (lexenv.functions new-env))))
    224     (nx1-check-duplicate-bindings names 'macrolet)
    225222    (let* ((*nx-lexical-environment* new-env))
    226223      (with-nx-declarations (pending)
     
    238235        (let ((env *nx-lexical-environment*)
    239236              (*nx-bound-vars* *nx-bound-vars*))
    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))
     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)))))
    253245          (nx-effect-other-decls pending env)
    254246          (nx1-env-body context body old-env))))))
     
    17811773       *nx-new-p2decls*))))
    17821774
    1783 (defun maybe-warn-about-shadowing-cl-function-name (funcname)
     1775(defun maybe-warn-about-nx1-alphatizer-binding (funcname)
    17841776  (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 
    1790 (defun maybe-warn-about-nx1-alphatizer-binding (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 
     1777             (gethash funcname *nx1-alphatizers*))
     1778    (nx1-whine :special-fbinding funcname)))
    17971779
    17981780(defnx1 nx1-flet flet context (defs &body forms)
     
    18061788           (pairs nil)
    18071789           (fname nil)
    1808            (name nil)
    1809            (fnames ()))
     1790           (name nil))
    18101791      (multiple-value-bind (body decls) (parse-body forms env nil)
    18111792        (nx-process-declarations pending decls)
     
    18131794          (destructuring-bind (funcname lambda-list &body flet-function-body) def
    18141795            (setq fname (nx-need-function-name funcname))
    1815             (push fname fnames)
    18161796            (maybe-warn-about-nx1-alphatizer-binding funcname)
    18171797            (multiple-value-bind (body decls)
     
    18351815                (push (setq name (make-symbol (symbol-name funcname))) names)
    18361816                (push (cons funcname (cons 'function (cons func name))) (lexenv.functions new-env))))))
    1837         (nx1-check-duplicate-bindings fnames 'flet)
    18381817        (let ((vars nil)
    18391818              (rvars nil)
     
    18951874           (blockname nil)
    18961875           (fname nil)
    1897            (name nil)
    1898            (fnames ()))
     1876           (name nil))
    18991877      (multiple-value-bind (body decls) (parse-body forms env nil)
    19001878        (dolist (def defs (setq funcs (nreverse funcs) bodies (nreverse bodies)))
     
    19041882            (setq blockname funcname)
    19051883            (setq fname (nx-need-function-name funcname))
    1906             (push fname fnames)
    19071884            (when (consp funcname)
    19081885              (setq blockname (%cadr funcname) funcname fname))
     
    19311908        (nx-reconcile-inherited-vars funcrefs)
    19321909        (dolist (f funcrefs) (nx1-afunc-ref f))
    1933         (nx1-check-duplicate-bindings fnames 'labels)
    19341910        (make-acode
    19351911         (%nx1-operator labels)
     
    24912467  (nx1-progn-body context (if (or (memq 'eval when) (memq :execute when)) body)))
    24922468
    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,
    2496 possibly because it's the result of macroexpansion. DECLARE expressions
    2497 can only appear in specified contexts and must be actual subexressions
    2498 of the containing forms." w))
    2499 
    2500 
     2469(defnx1 nx1-misplaced (declare) context (&rest args)
     2470  (nx-error "~S not expected in ~S." *nx-sfname* (cons *nx-sfname* args)))
     2471
Note: See TracChangeset for help on using the changeset viewer.