Changeset 12163


Ignore:
Timestamp:
May 30, 2009, 1:43:51 PM (10 years ago)
Author:
gz
Message:

Tweaks for type warnings from r12158/r12159/r12160: don't warn about unknown types from proclaim; minimize usually-gratuitous warnings from defstruct readers; consistently report unknown declaration idenitifers as bad declarations when they're not known types; check for invalid types in defstruct;

Location:
trunk/source
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx0.lisp

    r12131 r12163  
    366366    (dolist (spec (%cdr decl))
    367367      (if (memq (setq s (car spec)) *nx-known-declarations*)
    368         ;;  Hmm, NOTSPECIAL and FUNCTION are in *nx-known-declarations* but have no standard handler.
    369368        (if (setq f (getf *nx-standard-declaration-handlers* s))
    370369          (funcall f pending spec env))
    371370        ; Any type name is now (ANSI CL) a valid declaration.
    372         (nx-process-type-decl pending spec s (%cdr spec) env)))))
     371        (if (specifier-type-if-known s env)
     372          (nx-process-type-decl pending spec s (%cdr spec) env)
     373          (nx-bad-decls spec))))))
    373374
    374375; Put all variable decls for the symbol VAR into effect in environment ENV.  Now.
     
    685686    (parse-unknown-type (c)
    686687      (when (and whine *compiler-warn-on-undefined-type-references*)
    687         (nx1-whine :undefined-type (parse-unknown-type-specifier c)))
     688        (nx1-whine :undefined-type typespec))
    688689      (values nil (parse-unknown-type-specifier c)))
    689690    ;; catch any errors due to destructuring in type-expand
     
    698699                                       (break "caught unknown-type ~s" c)
    699700                                       (when (and whine *compiler-warn-on-undefined-type-references*)
    700                                          (nx1-whine :undefined-type (parse-unknown-type-specifier c)))
     701                                         (nx1-whine :undefined-type typespec))
    701702                                       (return-from specifier-type-if-known
    702703                                         (values nil (parse-unknown-type-specifier c)))))
     
    21682169        (unless (listp note) note)))))
    21692170
     2171#-BOOTSTRAPPED
     2172(when (= 2 (let ((bits (lfun-bits #'defstruct-ref-transform)))
     2173             (+ (ldb $lfbits-numreq bits) (ldb $lfbits-numopt bits))))
     2174  (let ((old #'defstruct-ref-transform))
     2175    (fset 'defstruct-ref-transform (lambda (a b &optional env)
     2176                                     (declare (ignore env))
     2177                                     (funcall old a b)))))
     2178
    21702179(defun nx-transform (form &optional (environment *nx-lexical-environment*) (source-note-map *nx-source-note-map*))
    21712180  (macrolet ((form-changed (form)
     
    22452254                                      (and (boundp '%structure-refs%)
    22462255                                           (gethash sym %structure-refs%))))
    2247              (setq form (defstruct-ref-transform transforms (%cdr form)))
     2256             (setq form (defstruct-ref-transform transforms (%cdr form) environment))
    22482257             (form-changed form)
    22492258             (go START))
  • trunk/source/level-1/l1-utils.lisp

    r12131 r12163  
    540540    (function (apply #'proclaim-type spec))
    541541    (t (unless (memq (%car spec) *nx-known-declarations*)
    542          ;; Any type name is now (ANSI CL) a valid declaration.  Any symbol could become a type.
     542         ;; Any type name is now (ANSI CL) a valid declaration.
    543543         (if (specifier-type-if-known (%car spec))
    544544           (apply #'proclaim-type spec)
    545            (warn "Unknown declaration specifier(s) in ~S" spec))))))
     545           (signal-program-error "Unknown declaration specifier ~s in ~S" (%car spec) spec))))))
    546546
    547547(defun bad-proclaim-spec (spec)
     
    554554  (when *type-system-initialized*
    555555    ;; Check the type.  This will signal program-error's in case of invalid types, let it.
    556     (handler-case (specifier-type type)
    557       (parse-unknown-type (c)
    558         (warn "Undefined type ~s in declaration specifier ~s"
    559               (parse-unknown-type-specifier c) `(,type ,@vars)))))
     556    ;; Do not signal anything about unknown types though -- it should be ok to have forward
     557    ;; references here, before anybody needs the info.
     558    (specifier-type type))
    560559  (dolist (var vars)
    561560    (let ((spec (assq var *nx-proclaimed-types*)))
     
    571570    (setq *nx-proclaimed-ftypes* (make-hash-table :test #'eq)))
    572571  ;; Check the type.  This will signal program-error's in case of invalid types, let it.
    573   ;; TODO: should also check it for being a function type.
    574   (handler-case (specifier-type ftype)
    575     (parse-unknown-type (c)
    576       (warn "Undefined type ~s in declaration specifier ~s"
    577             (parse-unknown-type-specifier c) `(ftype ,ftype ,@names))))
     572  ;; Do not signal anything about unknown types though -- it should be ok to have forward
     573  ;; references here, before anybody needs the info.
     574  (specifier-type ftype)
    578575  (dolist (name names)
    579576    (setf (gethash (maybe-setf-function-name name) *nx-proclaimed-ftypes*) ftype)))
  • trunk/source/lib/defstruct-lds.lisp

    r12045 r12163  
    226226                  (t (go bad-slot)))
    227227            (setq args (%cddr args)))
     228         (specifier-type slot-type env) ;; Check for validity (signals program error)
    228229         (push (make-ssd name initform offset read-only slot-type) slot-list)
    229230         (setq slots (%cdr slots) offset (%i+ offset 1))))
    230 
    231231    (setq slot-list (nreverse slot-list))
    232232    (when (and (null type) include)
  • trunk/source/lib/defstruct.lisp

    r11127 r12163  
    226226    `((declaim (inline ,@defs)))))
    227227
    228 ;;;Used by setf and whatever...
    229 (defun defstruct-ref-transform (predicate-or-type-and-refinfo args)
     228;;;Used by nx-transform, setf, and whatever...
     229(defun defstruct-ref-transform (predicate-or-type-and-refinfo args &optional env)
    230230  (if (type-and-refinfo-p predicate-or-type-and-refinfo)
    231231    (multiple-value-bind (type refinfo)
     
    249249        (if (eq type 't)
    250250          accessor
    251           `(the ,type ,accessor))))
     251          (if (specifier-type-if-known type env)
     252            `(the ,type ,accessor)
     253            (if (nx-the-typechecks env)
     254              `(require-type ,accessor ',type)
     255              ;; Otherwise just ignore the type, it's most likely a forward reference,
     256              ;; and while it means we might be missing out on a possible optimization,
     257              ;; most of the time it's not worth warning about.
     258              accessor)))))
    252259    `(structure-typep ,@args ',predicate-or-type-and-refinfo)))
    253260
  • trunk/source/lib/macros.lisp

    r12045 r12163  
    559559                             ;; strip off type, but add in a require-type
    560560                             (let ((type (%car temp)))
    561                                `(the ,type (setf ,(defstruct-ref-transform (%cdr temp) (%cdar args))
     561                               `(the ,type (setf ,(defstruct-ref-transform (%cdr temp) (%cdar args) env)
    562562                                            (require-type ,value ',type))))
    563                              `(setf ,(defstruct-ref-transform temp (%cdar args))
     563                             `(setf ,(defstruct-ref-transform temp (%cdar args) env)
    564564                               ,value)))
    565565                          (t
     
    32273227                                 (gethash sym %structure-refs%))))
    32283228      (if struct-transform
    3229         (setq place (defstruct-ref-transform struct-transform (cdr place))
     3229        (setq place (defstruct-ref-transform struct-transform (cdr place) env)
    32303230              sym (car place)))
    32313231      (ecase sym
     
    34713471                                 (gethash sym ccl::%structure-refs%))))
    34723472      (if struct-transform
    3473         (setq place (ccl::defstruct-ref-transform struct-transform (cdr place))
     3473        (setq place (defstruct-ref-transform struct-transform (cdr place) env)
    34743474              sym (car place)))
    34753475      (if (member  sym '(svref ccl::%svref ccl::struct-ref))
  • trunk/source/lib/nfcomp.lisp

    r12131 r12163  
    837837         (unless (memq sym *nx-known-declarations*)
    838838           ;; Any type name is now (ANSI CL) a valid declaration.
    839            (if (specifier-type-if-known sym env :whine t)
     839           (if (specifier-type-if-known sym env)
    840840             (fcomp-proclaim-type sym spec env)
    841841             (nx-bad-decls `(,sym ,@spec)))))))))
  • trunk/source/lib/setf.lisp

    r11067 r12163  
    110110                (multiple-value-bind
    111111                  (temps values storevars storeform accessform)
    112                   (get-setf-method (defstruct-ref-transform (%cdr temp) (%cdr form)) environment)
     112                  (get-setf-method (defstruct-ref-transform (%cdr temp) (%cdr form) environment) environment)
    113113                  (values temps values storevars
    114114                          (let ((storevar (first storevars)))
     
    117117                                    ,storeform)))
    118118                          `(the ,type ,accessform))))
    119               (get-setf-method (defstruct-ref-transform temp (%cdr form)) environment)))
     119              (get-setf-method (defstruct-ref-transform temp (%cdr form) environment) environment)))
    120120           (t
    121121            (multiple-value-bind (res win)
Note: See TracChangeset for help on using the changeset viewer.