- (or (when (mismatch old-inherits
- inherits
- :key #'layout-proper-name)
- (warn "change in superclasses of class ~S:~% ~
- ~A superclasses: ~S~% ~
- ~A superclasses: ~S"
- name
- old-context
- (map 'list #'layout-proper-name old-inherits)
- context
- (map 'list #'layout-proper-name inherits))
- t)
- (let ((diff (mismatch old-inherits inherits)))
- (when diff
- (warn
- "in class ~S:~% ~
- ~:(~A~) definition of superclass ~S is incompatible with~% ~
- ~A definition."
- name
- old-context
- (layout-proper-name (svref old-inherits diff))
- context)
- t))))
- (let ((old-length (layout-length old-layout)))
- (unless (= old-length length)
- (warn "change in instance length of class ~S:~% ~
- ~A length: ~W~% ~
- ~A length: ~W"
- name
- old-context old-length
- context length)
- t))
- (unless (= (layout-depthoid old-layout) depthoid)
- (warn "change in the inheritance structure of class ~S~% ~
- between the ~A definition and the ~A definition"
- name old-context context)
- t))))
+ (or (when (mismatch old-inherits
+ inherits
+ :key #'layout-proper-name)
+ (warn "change in superclasses of class ~S:~% ~
+ ~A superclasses: ~S~% ~
+ ~A superclasses: ~S"
+ name
+ old-context
+ (map 'list #'layout-proper-name old-inherits)
+ context
+ (map 'list #'layout-proper-name inherits))
+ t)
+ (let ((diff (mismatch old-inherits inherits)))
+ (when diff
+ (warn
+ "in class ~S:~% ~
+ ~:(~A~) definition of superclass ~S is incompatible with~% ~
+ ~A definition."
+ name
+ old-context
+ (layout-proper-name (svref old-inherits diff))
+ context)
+ t))))
+ (let ((old-length (layout-length old-layout)))
+ (unless (= old-length length)
+ (warn "change in instance length of class ~S:~% ~
+ ~A length: ~W~% ~
+ ~A length: ~W"
+ name
+ old-context old-length
+ context length)
+ t))
+ (let ((old-nuntagged (layout-n-untagged-slots old-layout)))
+ (unless (= old-nuntagged nuntagged)
+ (warn "change in instance layout of class ~S:~% ~
+ ~A untagged slots: ~W~% ~
+ ~A untagged slots: ~W"
+ name
+ old-context old-nuntagged
+ context nuntagged)
+ t))
+ (unless (= (layout-depthoid old-layout) depthoid)
+ (warn "change in the inheritance structure of class ~S~% ~
+ between the ~A definition and the ~A definition"
+ name old-context context)
+ t))))