Changeset 12073


Ignore:
Timestamp:
May 16, 2009, 11:24:00 AM (10 years ago)
Author:
gz
Message:

Merge r12071

Location:
branches/working-0711/ccl/compiler
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/nx-basic.lisp

    r12048 r12073  
    582582    (:unused . "Unused lexical variable ~S")
    583583    (:ignore . "Variable ~S not ignored.")
    584     (:undefined-function . "Undefined function ~S")
    585     (:undefined-type . "Undefined type ~S")
    586     (:unknown-declaration . "Unknown declaration ~S")
     584    (:undefined-function . "Undefined function ~S") ;; (not reported if defined later)
     585    (:undefined-type . "Undefined type ~S")         ;; (not reported if defined later)
     586    (:unknown-type-in-declaration . "Unknown or invalid type ~S, declaration ignored")
     587    (:bad-declaration . "Unknown or invalid declaration ~S")
    587588    (:invalid-type . report-invalid-type-compiler-warning)
    588589    (:unknown-declaration-variable . "~s declaration for unknown variable ~s")
  • branches/working-0711/ccl/compiler/nx0.lisp

    r12054 r12073  
    778778
    779779(defun nx-bad-decls (decls)
    780   (nx1-whine :unknown-declaration decls))
    781 
    782 
    783 
    784 (defnxdecl special (pending decl env)
     780  (nx1-whine :bad-declaration decls))
     781
     782
     783(defnxdecl special (pending decl env &aux whined)
    785784  (declare (ignore env))
    786785  (dolist (s (%cdr decl))
    787786    (if (symbolp s)
    788787      (nx-new-vdecl pending s 'special)
    789       (nx-bad-decls decl))))
    790 
    791 (defnxdecl notspecial (pending decl env)
     788      (unless (shiftf whined t) (nx-bad-decls decl)))))
     789
     790(defnxdecl notspecial (pending decl env &aux whined)
    792791  (declare (ignore env))
    793792  (dolist (s (%cdr decl))
    794793    (if (symbolp s)
    795794      (nx-new-vdecl pending s 'notspecial)
    796       (nx-bad-decls decl))))
    797 
    798 
    799 (defnxdecl dynamic-extent (pending decl env)
     795      (unless (shiftf whined t) (nx-bad-decls decl)))))
     796
     797(defnxdecl dynamic-extent (pending decl env &aux whined)
    800798  (declare (ignore env))
    801799  (dolist (s (%cdr decl))
     
    808806               (setq s (validate-function-name (cadr s))))
    809807        (nx-new-fdecl pending s 'dynamic-extent t)
    810         (nx-bad-decls decl)))))
    811 
    812 (defnxdecl ignorable (pending decl env)
     808        (unless (shiftf whined t) (nx-bad-decls decl))))))
     809
     810(defnxdecl ignorable (pending decl env &aux whined)
    813811  (declare (ignore env))
    814812  (dolist (s (%cdr decl))
    815813    (if (symbolp s)
    816       (nx-new-vdecl pending s 'ignore-if-unused t)
     814      (nx-new-vdecl pending s 'ignorable)
    817815      (if (and (consp s)
    818816               (eq (%car s) 'function)
     
    820818               (valid-function-name-p (cadr s))
    821819               (setq s (validate-function-name (cadr s))))
    822         (nx-new-fdecl pending s 'ignore-if-unused t)
    823         (nx-bad-decls decl)))))
    824 
    825 (defnxdecl ftype (pending decl env)
     820        (nx-new-fdecl pending s 'ignorable)
     821        (unless (shiftf whined t) (nx-bad-decls decl))))))
     822
     823(defnxdecl ftype (pending decl env &aux whined)
    826824  (destructuring-bind (type &rest fnames) (%cdr decl)
    827     (if (not (every (lambda (f) (or (symbolp f) (setf-function-name-p f))) fnames))
    828       (nx-bad-decls decl)
    829       (let ((ctype (specifier-type-if-known type env :whine t)))
    830         (when ctype
    831           (dolist (s fnames)
    832             (nx-new-fdecl pending s 'ftype type)))))))
     825    (if (specifier-type-if-known type env)
     826      (dolist (s fnames)
     827        (if (or (symbolp s) (setf-function-name-p s))
     828            (nx-new-fdecl pending s 'ftype type)
     829            (unless (shiftf whined t) (nx-bad-decls decl))))
     830      (nx1-whine :unknown-type-in-declaration type))))
    833831
    834832(defnxdecl settable (pending decl env)
     
    838836  (nx-settable-decls pending decl env nil))
    839837
    840 (defun nx-settable-decls (pending decl env val)
     838(defun nx-settable-decls (pending decl env val &aux whined)
    841839  (declare (ignore env))
    842840  (dolist (s (%cdr decl))
    843841    (if (symbolp s)
    844842      (nx-new-vdecl pending s 'settable val)
    845       (nx-bad-decls decl))))
     843      (unless (shiftf whined t) (nx-bad-decls decl)))))
    846844
    847845(defnxdecl function (pending decl env)
     
    851849  (nx-process-type-decl pending decl (cadr decl) (cddr decl) env))
    852850
    853 (defun nx-process-type-decl (pending decl type vars env)
    854   (if (not (every #'symbolp vars))
    855     (nx-bad-decls decl)
    856     (let ((ctype (specifier-type-if-known type env :whine t)))
    857       (when ctype
    858         (dolist (sym vars)
    859           (nx-new-vdecl pending sym 'type ctype))))))
     851(defun nx-process-type-decl (pending decl type vars env &aux whined)
     852  (if (specifier-type-if-known type env)
     853    (dolist (sym vars)
     854      (if (symbolp sym)
     855        (nx-new-vdecl pending sym 'type type)
     856        (unless (shiftf whined t) (nx-bad-decls decl))))
     857    (nx1-whine :unknown-type-in-declaration type)))
    860858
    861859(defnxdecl global-function-name (pending decl env)
     
    877875
    878876
    879 (defun nx-inline-decl (pending decl val &aux valid-name)
     877(defun nx-inline-decl (pending decl val &aux valid-name whined)
    880878  (dolist (s (%cdr decl))
    881879    (multiple-value-setq (valid-name s) (valid-function-name-p s))
     
    885883          (setq *nx-inlined-self* val))
    886884        (nx-new-fdecl pending s 'inline (if val 'inline 'notinline)))
    887       (nx-bad-decls decl))))
     885      (unless (shiftf whined t) (nx-bad-decls decl)))))
    888886
    889887(defnxdecl inline (pending decl env)
     
    895893  (nx-inline-decl pending decl nil))
    896894
    897 (defnxdecl ignore (pending decl env)
     895(defnxdecl ignore (pending decl env &aux whined)
    898896  (declare (ignore env))
    899897  (dolist (s (%cdr decl))
     
    906904               (setq s (validate-function-name (cadr s))))
    907905        (nx-new-fdecl pending s 'ignore t)
    908         (nx-bad-decls decl)))))
    909 
    910 (defnxdecl ignore-if-unused (pending decl env)
     906        (unless (shiftf whined t) (nx-bad-decls decl))))))
     907
     908(defnxdecl ignore-if-unused (pending decl env &aux whined)
    911909  (declare (ignore env))
    912910  (dolist (s (%cdr decl))
    913911    (if (symbolp s)
    914912      (nx-new-vdecl pending s 'ignore-if-unused)
    915       (nx-bad-decls decl))))
     913      (unless (shiftf whined t) (nx-bad-decls decl)))))
    916914
    917915(defun nx-self-call-p (name &optional ignore-lexical (allow *nx-inlined-self*))
     
    10741072      (if (and (fixnump v) (<= 0 v 3) (memq q '(speed space compilation-speed safety debug)))
    10751073        (push (cons q v) mdecls)
    1076         (nx-bad-decls specs)))))
     1074        (nx-bad-decls spec)))))
    10771075
    10781076(defun %proclaim-optimize (specs &aux q v)
  • branches/working-0711/ccl/compiler/nx1.lisp

    r12052 r12073  
    2929  ;; in type declarations, but aren't legal args to TYPEP;
    3030  ;; treat them as the simple FUNCTION type.
    31   (let* ((ctype (handler-case (values-specifier-type typespec)
     31  (let* ((ctype (handler-case (values-specifier-type typespec env)
    3232                  (parse-unknown-type (c)
    33                     (when *compiler-warn-on-undefined-type-references*
    34                       (nx1-whine :undefined-type (parse-unknown-type-specifier c))
    35                       nil))
     33                    (nx1-whine :unknown-type-in-declaration (parse-unknown-type-specifier c))
     34                    nil)
    3635                  (program-error (c)
    3736                    (nx1-whine :invalid-type typespec c)
  • branches/working-0711/ccl/compiler/nxenv.lisp

    r11701 r12073  
    546546        (special (setq bits (%ilogior bits (ash -1 $vbitspecial) (%ilsl $vbitparameter 1))))
    547547        (ignore (setq bits (%ilogior bits (%ilsl $vbitignore 1))))
    548         (ignore-if-unused (setq bits (%ilogior bits (%ilsl $vbitignoreunused 1))))
     548        ((ignorable ignore-if-unused) (setq bits (%ilogior bits (%ilsl $vbitignoreunused 1))))
    549549        (dynamic-extent (setq bits (%ilogior bits (%ilsl $vbitdynamicextent 1))))))
    550550    node))
Note: See TracChangeset for help on using the changeset viewer.