Changeset 12158


Ignore:
Timestamp:
May 29, 2009, 8:49:20 PM (10 years ago)
Author:
gz
Message:

Try to arrange it so that calling structure slot readers doesn't cause warnings about unknown types in the slot :type. There are times where this might indicate a missed optimization opportunity, but most of the time it's just a gratuitous warning.

Also:

make defstruct check for validity (but not definedness) of the slot type.

Fix the undefined type warnings to record the whole type, not just the thing that's undefined,
in case there are more than one undefined references in the type.

Make proclaim again signal an error (not just warn) if the declaration is invalid.

Location:
branches/working-0711/ccl
Files:
6 edited

Legend:

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

    r12154 r12158  
    694694    (parse-unknown-type (c)
    695695      (when (and whine *compiler-warn-on-undefined-type-references*)
    696         (nx1-whine :undefined-type (parse-unknown-type-specifier c)))
     696        (nx1-whine :undefined-type typespec))
    697697      (values nil (parse-unknown-type-specifier c)))
    698698    ;; catch any errors due to destructuring in type-expand
     
    707707                                       (break "caught unknown-type ~s" c)
    708708                                       (when (and whine *compiler-warn-on-undefined-type-references*)
    709                                          (nx1-whine :undefined-type (parse-unknown-type-specifier c)))
     709                                         (nx1-whine :undefined-type typespec))
    710710                                       (return-from specifier-type-if-known
    711711                                         (values nil (parse-unknown-type-specifier c)))))
     
    21872187)
    21882188
     2189#-BOOTSTRAPPED
     2190(when (= 2 (let ((bits (lfun-bits #'defstruct-ref-transform)))
     2191             (+ (ldb $lfbits-numreq bits) (ldb $lfbits-numopt bits))))
     2192  (let ((old #'defstruct-ref-transform))
     2193    (fset 'defstruct-ref-transform (lambda (a b &optional env)
     2194                                     (declare (ignore env))
     2195                                     (funcall old a b)))))
     2196
    21892197(defun nx-transform (form &optional (environment *nx-lexical-environment*) (source-note-map *nx-source-note-map*))
    21902198  (macrolet ((form-changed (form)
     
    22642272                                      (and (boundp '%structure-refs%)
    22652273                                           (gethash sym %structure-refs%))))
    2266              (setq form (defstruct-ref-transform transforms (%cdr form)))
     2274             (setq form (defstruct-ref-transform transforms (%cdr form) environment))
    22672275             (form-changed form)
    22682276             (go START))
  • branches/working-0711/ccl/level-1/l1-utils.lisp

    r12154 r12158  
    539539    (function (apply #'proclaim-type spec))
    540540    (t (unless (memq (%car spec) *nx-known-declarations*)
    541          ;; Any type name is now (ANSI CL) a valid declaration.  Any symbol could become a type.
     541         ;; Any type name is now (ANSI CL) a valid declaration.
    542542         (if (specifier-type-if-known (%car spec))
    543543           (apply #'proclaim-type spec)
    544            (warn "Unknown declaration specifier(s) in ~S" spec))))))
     544           (signal-program-error "Unknown declaration specifier ~s in ~S" (%car spec) spec))))))
    545545
    546546(defun bad-proclaim-spec (spec)
  • branches/working-0711/ccl/lib/defstruct-lds.lisp

    r12048 r12158  
    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)
  • branches/working-0711/ccl/lib/defstruct.lisp

    r11069 r12158  
    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-declarations-typecheck 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
  • branches/working-0711/ccl/lib/macros.lisp

    r12048 r12158  
    563563                             ;; strip off type, but add in a require-type
    564564                             (let ((type (%car temp)))
    565                                `(the ,type (setf ,(defstruct-ref-transform (%cdr temp) (%cdar args))
     565                               `(the ,type (setf ,(defstruct-ref-transform (%cdr temp) (%cdar args) env)
    566566                                            (require-type ,value ',type))))
    567                              `(setf ,(defstruct-ref-transform temp (%cdar args))
     567                             `(setf ,(defstruct-ref-transform temp (%cdar args) env)
    568568                               ,value)))
    569569                          (t
     
    32163216                                 (gethash sym %structure-refs%))))
    32173217      (if struct-transform
    3218         (setq place (defstruct-ref-transform struct-transform (cdr place))
     3218        (setq place (defstruct-ref-transform struct-transform (cdr place) env)
    32193219              sym (car place)))
    32203220      (ecase sym
     
    34603460                                 (gethash sym ccl::%structure-refs%))))
    34613461      (if struct-transform
    3462         (setq place (ccl::defstruct-ref-transform struct-transform (cdr place))
     3462        (setq place (defstruct-ref-transform struct-transform (cdr place) env)
    34633463              sym (car place)))
    34643464      (if (member  sym '(svref ccl::%svref ccl::struct-ref))
  • branches/working-0711/ccl/lib/setf.lisp

    r11164 r12158  
    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.