/[cmucl]/src/code/defstruct.lisp
ViewVC logotype

Diff of /src/code/defstruct.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.98 by rtoy, Thu Jun 11 16:03:57 2009 UTC revision 1.98.12.4 by rtoy, Sat Feb 13 17:10:08 2010 UTC
# Line 13  Line 13 
13  ;;; Written by Rob MacLachlan, William Lott and Skef Wholey.  ;;; Written by Rob MacLachlan, William Lott and Skef Wholey.
14  ;;;  ;;;
15  (in-package "LISP")  (in-package "LISP")
16    
17    (intl:textdomain "cmucl")
18    
19  (export '(defstruct copy-structure structure-object))  (export '(defstruct copy-structure structure-object))
20  (in-package "KERNEL")  (in-package "KERNEL")
21  (export '(default-structure-print make-structure-load-form  (export '(default-structure-print make-structure-load-form
# Line 35  Line 38 
38    
39    
40  (defparameter *ANSI-defstruct-options-p* nil  (defparameter *ANSI-defstruct-options-p* nil
41    "Controls compiling DEFSTRUCT :print-function and :print-method    _N"Controls compiling DEFSTRUCT :print-function and :print-method
42     options according to ANSI spec. MUST be NIL to compile CMUCL & PCL")     options according to ANSI spec. MUST be NIL to compile CMUCL & PCL")
43    
44  ;;;; Structure frobbing primitives.  ;;;; Structure frobbing primitives.
45    
46  (defun %make-instance (length)  (defun %make-instance (length)
47    "Allocate a new instance with LENGTH data slots."    _N"Allocate a new instance with LENGTH data slots."
48    (declare (type index length))    (declare (type index length))
49    (%make-instance length))    (%make-instance length))
50    
51  (defun %instance-length (instance)  (defun %instance-length (instance)
52    "Given an instance, return its length."    _N"Given an instance, return its length."
53    (declare (type instance instance))    (declare (type instance instance))
54    (%instance-length instance))    (%instance-length instance))
55    
56  (defun %instance-ref (instance index)  (defun %instance-ref (instance index)
57    "Return the value from the INDEXth slot of INSTANCE.  This is SETFable."    _N"Return the value from the INDEXth slot of INSTANCE.  This is SETFable."
58    (%instance-ref instance index))    (%instance-ref instance index))
59    
60  (defun %instance-set (instance index new-value)  (defun %instance-set (instance index new-value)
61    "Set the INDEXth slot of INSTANCE to NEW-VALUE."    _N"Set the INDEXth slot of INSTANCE to NEW-VALUE."
62    (setf (%instance-ref instance index) new-value))    (setf (%instance-ref instance index) new-value))
63    
64  (defun %raw-ref-single (vec index)  (defun %raw-ref-single (vec index)
# Line 319  Line 322 
322  (defun compiler-layout-or-lose (name)  (defun compiler-layout-or-lose (name)
323    (let ((res (info type compiler-layout name)))    (let ((res (info type compiler-layout name)))
324      (cond ((not res)      (cond ((not res)
325             (error "Class not yet defined or was undefined: ~S" name))             (error _"Class not yet defined or was undefined: ~S" name))
326            ((not (typep (layout-info res) 'defstruct-description))            ((not (typep (layout-info res) 'defstruct-description))
327             (error "Class is not a structure class: ~S" name))             (error _"Class is not a structure class: ~S" name))
328            (t res))))            (t res))))
329    
330  (defun dd-maybe-make-print-method (defstruct)  (defun dd-maybe-make-print-method (defstruct)
# Line 415  Line 418 
418  ;;; DEFSTRUCT  --  Public  ;;; DEFSTRUCT  --  Public
419  ;;;  ;;;
420  (defmacro defstruct (name-and-options &rest slot-descriptions)  (defmacro defstruct (name-and-options &rest slot-descriptions)
421    "DEFSTRUCT {Name | (Name Option*)} {Slot | (Slot [Default] {Key Value}*)}    _N"DEFSTRUCT {Name | (Name Option*)} {Slot | (Slot [Default] {Key Value}*)}
422     Define the structure type Name.  Instances are created by MAKE-<name>, which     Define the structure type Name.  Instances are created by MAKE-<name>, which
423     takes keyword arguments allowing initial slot values to the specified.     takes keyword arguments allowing initial slot values to the specified.
424     A SETF'able function <name>-<slot> is defined for each slot to read&write     A SETF'able function <name>-<slot> is defined for each slot to read&write
# Line 455  Line 458 
458        (restart-case        (restart-case
459            (error 'lisp::package-locked-error            (error 'lisp::package-locked-error
460                   :package pkg                   :package pkg
461                   :format-control "defining structure ~A"                   :format-control _"defining structure ~A"
462                   :format-arguments (list name))                   :format-arguments (list name))
463          (continue ()          (continue ()
464            :report "Ignore the lock and continue")            :report (lambda (stream)
465                        (write-string _"Ignore the lock and continue" stream)))
466          (unlock-package ()          (unlock-package ()
467            :report "Disable package's definition lock then continue"            :report (lambda (stream)
468                        (write-string _"Disable package's definition lock then continue" stream))
469            (setf (ext:package-definition-lock pkg) nil))            (setf (ext:package-definition-lock pkg) nil))
470          (unlock-all ()          (unlock-all ()
471            :report "Unlock all packages, then continue"            :report (lambda (stream)
472                        (write-string _"Unlock all packages, then continue" stream))
473            (lisp::unlock-all-packages))))            (lisp::unlock-all-packages))))
474      (when (info declaration recognized name)      (when (info declaration recognized name)
475        (error "Defstruct already names a declaration: ~S." name))        (error _"Defstruct already names a declaration: ~S." name))
476      (when (stringp (car slot-descriptions))      (when (stringp (car slot-descriptions))
477        (setf (dd-doc defstruct) (pop slot-descriptions)))        (setf (dd-doc defstruct) (pop slot-descriptions)))
478      (dolist (slot slot-descriptions)      (dolist (slot slot-descriptions)
# Line 524  Line 530 
530           (setf (dd-predicate defstruct) pred)))           (setf (dd-predicate defstruct) pred)))
531        (:include        (:include
532         (when (dd-include defstruct)         (when (dd-include defstruct)
533           (error "Can't have more than one :INCLUDE option."))           (error _"Can't have more than one :INCLUDE option."))
534         (setf (dd-include defstruct) args))         (setf (dd-include defstruct) args))
535        (:alternate-metaclass        (:alternate-metaclass
536         (setf (dd-alternate-metaclass defstruct) args))         (setf (dd-alternate-metaclass defstruct) args))
# Line 547  Line 553 
553                    (setf (dd-element-type defstruct) vtype)                    (setf (dd-element-type defstruct) vtype)
554                    (setf (dd-type defstruct) 'vector)))                    (setf (dd-type defstruct) 'vector)))
555                 (t                 (t
556                  (error "~S is a bad :TYPE for Defstruct." type)))))                  (error _"~S is a bad :TYPE for Defstruct." type)))))
557        (:named        (:named
558         (error "The Defstruct option :NAMED takes no arguments."))         (error _"The Defstruct option :NAMED takes no arguments."))
559        (:initial-offset        (:initial-offset
560         (destructuring-bind (offset) args         (destructuring-bind (offset) args
561           (setf (dd-offset defstruct) offset)))           (setf (dd-offset defstruct) offset)))
# Line 559  Line 565 
565        (:pure        (:pure
566         (destructuring-bind (fun) args         (destructuring-bind (fun) args
567           (setf (dd-pure defstruct) fun)))           (setf (dd-pure defstruct) fun)))
568        (t (error "Unknown DEFSTRUCT option~%  ~S" option)))))        (t (error _"Unknown DEFSTRUCT option~%  ~S" option)))))
569    
570  #+ORIGINAL  #+ORIGINAL
571  (defun parse-1-option (option defstruct)  (defun parse-1-option (option defstruct)
# Line 587  Line 593 
593           (setf (dd-predicate defstruct) pred)))           (setf (dd-predicate defstruct) pred)))
594        (:include        (:include
595         (when (dd-include defstruct)         (when (dd-include defstruct)
596           (error "Can't have more than one :INCLUDE option."))           (error _"Can't have more than one :INCLUDE option."))
597         (setf (dd-include defstruct) args))         (setf (dd-include defstruct) args))
598        (:alternate-metaclass        (:alternate-metaclass
599         (setf (dd-alternate-metaclass defstruct) args))         (setf (dd-alternate-metaclass defstruct) args))
# Line 607  Line 613 
613                    (setf (dd-element-type defstruct) vtype)                    (setf (dd-element-type defstruct) vtype)
614                    (setf (dd-type defstruct) 'vector)))                    (setf (dd-type defstruct) 'vector)))
615                 (t                 (t
616                  (error "~S is a bad :TYPE for Defstruct." type)))))                  (error _"~S is a bad :TYPE for Defstruct." type)))))
617        (:named        (:named
618         (error "The Defstruct option :NAMED takes no arguments."))         (error _"The Defstruct option :NAMED takes no arguments."))
619        (:initial-offset        (:initial-offset
620         (destructuring-bind (offset) args         (destructuring-bind (offset) args
621           (setf (dd-offset defstruct) offset)))           (setf (dd-offset defstruct) offset)))
# Line 619  Line 625 
625        (:pure        (:pure
626         (destructuring-bind (fun) args         (destructuring-bind (fun) args
627           (setf (dd-pure defstruct) fun)))           (setf (dd-pure defstruct) fun)))
628        (t (error "Unknown DEFSTRUCT option~%  ~S" option)))))        (t (error _"Unknown DEFSTRUCT option~%  ~S" option)))))
629    
630    
631  ;;; PARSE-NAME-AND-OPTIONS  --  Internal  ;;; PARSE-NAME-AND-OPTIONS  --  Internal
# Line 638  Line 644 
644                                  :conc-name))                                  :conc-name))
645                 (parse-1-option (list option) defstruct))                 (parse-1-option (list option) defstruct))
646                (t                (t
647                 (error "Unrecognized DEFSTRUCT option: ~S" option))))                 (error _"Unrecognized DEFSTRUCT option: ~S" option))))
648    
649        (case (dd-type defstruct)        (case (dd-type defstruct)
650          (structure          (structure
651           (when (dd-offset defstruct)           (when (dd-offset defstruct)
652             (error "Can't specify :OFFSET unless :TYPE is specified."))             (error _"Can't specify :OFFSET unless :TYPE is specified."))
653           (unless (dd-include defstruct)           (unless (dd-include defstruct)
654             (incf (dd-length defstruct))))             (incf (dd-length defstruct))))
655          (funcallable-structure)          (funcallable-structure)
656          (t          (t
657           (when (dd-print-function defstruct)           (when (dd-print-function defstruct)
658             (warn "Silly to specify :PRINT-FUNCTION with :TYPE."))             (warn _"Silly to specify :PRINT-FUNCTION with :TYPE."))
659           (when (dd-make-load-form-fun defstruct)           (when (dd-make-load-form-fun defstruct)
660             (warn "Silly to specify :MAKE-LOAD-FORM-FUN with :TYPE."))             (warn _"Silly to specify :MAKE-LOAD-FORM-FUN with :TYPE."))
661           (when (dd-named defstruct) (incf (dd-length defstruct)))           (when (dd-named defstruct) (incf (dd-length defstruct)))
662           (let ((offset (dd-offset defstruct)))           (let ((offset (dd-offset defstruct)))
663             (when offset (incf (dd-length defstruct) offset)))))             (when offset (incf (dd-length defstruct) offset)))))
# Line 682  Line 688 
688                 (values name default default-p type type-p read-only ro-p)))                 (values name default default-p type type-p read-only ro-p)))
689              (t              (t
690               (when (keywordp spec)               (when (keywordp spec)
691                 (warn "Keyword slot name indicates probable syntax ~                 (warn _"Keyword slot name indicates probable syntax ~
692                        error in DEFSTRUCT -- ~S."                        error in DEFSTRUCT -- ~S."
693                       spec))                       spec))
694               spec))               spec))
695      (when (find name (dd-slots defstruct) :test #'string= :key #'dsd-%name)      (when (find name (dd-slots defstruct) :test #'string= :key #'dsd-%name)
696        (error 'simple-program-error        (error 'simple-program-error
697               :format-control "Duplicate slot name ~S."               :format-control _"Duplicate slot name ~S."
698               :format-arguments (list name)))               :format-arguments (list name)))
699      (setf (dsd-name islot) name)      (setf (dsd-name islot) name)
700      (setf (dd-slots defstruct) (nconc (dd-slots defstruct) (list islot)))      (setf (dd-slots defstruct) (nconc (dd-slots defstruct) (list islot)))
# Line 704  Line 710 
710        (if read-only        (if read-only
711            (setf (dsd-read-only islot) t)            (setf (dsd-read-only islot) t)
712            (when (dsd-read-only islot)            (when (dsd-read-only islot)
713              (error "Slot ~S must be read-only in subtype ~S." name              (error _"Slot ~S must be read-only in subtype ~S." name
714                     (dsd-name islot)))))                     (dsd-name islot)))))
715      islot))      islot))
716    
# Line 774  Line 780 
780        (unless (and (eq type (dd-type included-structure))        (unless (and (eq type (dd-type included-structure))
781                     (type= (specifier-type (dd-element-type included-structure))                     (type= (specifier-type (dd-element-type included-structure))
782                            (specifier-type (dd-element-type defstruct))))                            (specifier-type (dd-element-type defstruct))))
783          (error ":TYPE option mismatch between structures ~S and ~S."          (error _":TYPE option mismatch between structures ~S and ~S."
784                 (dd-name defstruct) included-name))                 (dd-name defstruct) included-name))
785    
786        (incf (dd-length defstruct) (dd-length included-structure))        (incf (dd-length defstruct) (dd-length included-structure))
# Line 824  Line 830 
830    
831  (defun typed-structure-info-or-lose (name)  (defun typed-structure-info-or-lose (name)
832    (or (info typed-structure info name)    (or (info typed-structure info name)
833        (error ":TYPE'd defstruct ~S not found for inclusion." name)))        (error _":TYPE'd defstruct ~S not found for inclusion." name)))
834    
835  ;;; %GET-COMPILER-LAYOUT  --  Internal  ;;; %GET-COMPILER-LAYOUT  --  Internal
836  ;;;  ;;;
# Line 1099  Line 1105 
1105    
1106      (when no-constructors      (when no-constructors
1107        (when (or defaults boas)        (when (or defaults boas)
1108          (error "(:CONSTRUCTOR NIL) combined with other :CONSTRUCTORs."))          (error _"(:CONSTRUCTOR NIL) combined with other :CONSTRUCTORs."))
1109        (return-from define-constructors ()))        (return-from define-constructors ()))
1110    
1111      (unless (or defaults boas)      (unless (or defaults boas)
# Line 1259  Line 1265 
1265                  ((not (= (cdr inherited) index))                  ((not (= (cdr inherited) index))
1266                   (warn 'simple-style-warning                   (warn 'simple-style-warning
1267                         :format-control                         :format-control
1268                         "~@<Non-overwritten accessor ~S does not access ~                         _"~@<Non-overwritten accessor ~S does not access ~
1269                          slot with name ~S (accessing an inherited slot ~                          slot with name ~S (accessing an inherited slot ~
1270                          instead).~:@>"                          instead).~:@>"
1271                         :format-arguments (list aname (dsd-%name slot))))))                         :format-arguments (list aname (dsd-%name slot))))))
# Line 1331  Line 1337 
1337  (defun typep-to-layout (obj layout &optional no-error)  (defun typep-to-layout (obj layout &optional no-error)
1338    (declare (type layout layout) (optimize (speed 3) (safety 0)))    (declare (type layout layout) (optimize (speed 3) (safety 0)))
1339    (when (layout-invalid layout)    (when (layout-invalid layout)
1340      (error "Obsolete structure accessor function called."))      (error _"Obsolete structure accessor function called."))
1341    (and (%instancep obj)    (and (%instancep obj)
1342         (let ((depth (layout-inheritance-depth layout))         (let ((depth (layout-inheritance-depth layout))
1343               (obj-layout (%instance-layout obj)))               (obj-layout (%instance-layout obj)))
# Line 1363  Line 1369 
1369                (error 'simple-type-error                (error 'simple-type-error
1370                       :datum structure                       :datum structure
1371                       :expected-type class                       :expected-type class
1372                       :format-control "Structure for accessor ~S is not a ~S:~% ~S"                       :format-control _"Structure for accessor ~S is not a ~S:~% ~S"
1373                       :format-arguments (list (dsd-accessor dsd)                       :format-arguments (list (dsd-accessor dsd)
1374                                               (%class-name class)                                               (%class-name class)
1375                                               structure)))                                               structure)))
# Line 1374  Line 1380 
1380                (error 'simple-type-error                (error 'simple-type-error
1381                       :datum structure                       :datum structure
1382                       :expected-type class                       :expected-type class
1383                       :format-control "Structure for accessor ~S is not a ~S:~% ~S"                       :format-control _"Structure for accessor ~S is not a ~S:~% ~S"
1384                       :format-arguments (list (dsd-accessor dsd) class                       :format-arguments (list (dsd-accessor dsd) class
1385                                               structure)))                                               structure)))
1386              (%instance-ref structure (dsd-index dsd))))))              (%instance-ref structure (dsd-index dsd))))))
# Line 1388  Line 1394 
1394                (error 'simple-type-error                (error 'simple-type-error
1395                       :datum structure                       :datum structure
1396                       :expected-type class                       :expected-type class
1397                       :format-control "Structure for setter ~S is not a ~S:~% ~S"                       :format-control _"Structure for setter ~S is not a ~S:~% ~S"
1398                       :format-arguments (list `(setf ,(dsd-accessor dsd))                       :format-arguments (list `(setf ,(dsd-accessor dsd))
1399                                               (%class-name class)                                               (%class-name class)
1400                                               structure)))                                               structure)))
# Line 1396  Line 1402 
1402                (error 'simple-type-error                (error 'simple-type-error
1403                       :datum new-value                       :datum new-value
1404                       :expected-type (dsd-type dsd)                       :expected-type (dsd-type dsd)
1405                       :format-control "New-Value for setter ~S is not a ~S:~% ~S."                       :format-control _"New-Value for setter ~S is not a ~S:~% ~S."
1406                       :format-arguments (list `(setf ,(dsd-accessor dsd))                       :format-arguments (list `(setf ,(dsd-accessor dsd))
1407                                               (dsd-type dsd)                                               (dsd-type dsd)
1408                                               new-value)))                                               new-value)))
# Line 1407  Line 1413 
1413                (error 'simple-type-error                (error 'simple-type-error
1414                       :datum structure                       :datum structure
1415                       :expected-type class                       :expected-type class
1416                       :format-control "Structure for setter ~S is not a ~S:~% ~S"                       :format-control _"Structure for setter ~S is not a ~S:~% ~S"
1417                       :format-arguments (list `(setf ,(dsd-accessor dsd))                       :format-arguments (list `(setf ,(dsd-accessor dsd))
1418                                               (%class-name class)                                               (%class-name class)
1419                                               structure)))                                               structure)))
# Line 1415  Line 1421 
1421                (error 'simple-type-error                (error 'simple-type-error
1422                       :datum new-value                       :datum new-value
1423                       :expected-type (dsd-type dsd)                       :expected-type (dsd-type dsd)
1424                       :format-control "New-Value for setter ~S is not a ~S:~% ~S."                       :format-control _"New-Value for setter ~S is not a ~S:~% ~S."
1425                       :format-arguments (list `(setf ,(dsd-accessor dsd))                       :format-arguments (list `(setf ,(dsd-accessor dsd))
1426                                               (dsd-type dsd)                                               (dsd-type dsd)
1427                                               new-value)))                                               new-value)))
# Line 1485  Line 1491 
1491                      (error 'simple-type-error                      (error 'simple-type-error
1492                             :datum structure                             :datum structure
1493                             :expected-type class                             :expected-type class
1494                             :format-control "Structure for copier is not a ~S:~% ~S"                             :format-control _"Structure for copier is not a ~S:~% ~S"
1495                             :format-arguments (list class structure)))                             :format-arguments (list class structure)))
1496                    (copy-structure structure))))                    (copy-structure structure))))
1497    
# Line 1556  Line 1562 
1562               (setf (layout-info old-layout) info)               (setf (layout-info old-layout) info)
1563               (values class old-layout nil))               (values class old-layout nil))
1564              (t              (t
1565               (warn "Shouldn't happen!  Some strange thing in LAYOUT-INFO:~               (warn _"Shouldn't happen!  Some strange thing in LAYOUT-INFO:~
1566                      ~%  ~S"                      ~%  ~S"
1567                     old-layout)                     old-layout)
1568               (values class new-layout old-layout)))))))))               (values class new-layout old-layout)))))))))
# Line 1603  Line 1609 
1609                           (compare-slots old new)                           (compare-slots old new)
1610        (when (or moved retyped deleted)        (when (or moved retyped deleted)
1611          (warn          (warn
1612           "Incompatibly redefining slots of structure class ~S~@           _"Incompatibly redefining slots of structure class ~S~@
1613            Make sure any uses of affected accessors are recompiled:~@            Make sure any uses of affected accessors are recompiled:~@
1614            ~@[  These slots were moved to new positions:~%    ~S~%~]~            ~@[  These slots were moved to new positions:~%    ~S~%~]~
1615            ~@[  These slots have new incompatible types:~%    ~S~%~]~            ~@[  These slots have new incompatible types:~%    ~S~%~]~
# Line 1629  Line 1635 
1635    (declare (type class class) (type layout old-layout new-layout))    (declare (type class class) (type layout old-layout new-layout))
1636    (let ((name (class-proper-name class)))    (let ((name (class-proper-name class)))
1637      (restart-case      (restart-case
1638          (error "Redefining class ~S incompatibly with the current ~          (error _"Redefining class ~S incompatibly with the current ~
1639                  definition."                  definition."
1640                 name)                 name)
1641        (continue ()        (continue ()
1642          :report "Invalidate already loaded code and instances, use new definition."          :report "Invalidate already loaded code and instances, use new definition."
1643          (warn "Previously loaded ~S accessors will no longer work." name)          (warn _"Previously loaded ~S accessors will no longer work." name)
1644          (register-layout new-layout))          (register-layout new-layout))
1645        (clobber-it ()        (clobber-it ()
1646          :report "Assume redefinition is compatible, allow old code and instances."          :report "Assume redefinition is compatible, allow old code and instances."
1647          (warn "Any old ~S instances will be in a bad way.~@          (warn _"Any old ~S instances will be in a bad way.~@
1648                 I hope you know what you're doing..."                 I hope you know what you're doing..."
1649                name)                name)
1650          (register-layout new-layout :invalidate nil          (register-layout new-layout :invalidate nil
# Line 1749  Line 1755 
1755              (undefine-structure class)              (undefine-structure class)
1756              (subs (class-proper-name class)))              (subs (class-proper-name class)))
1757            (when (subs)            (when (subs)
1758              (warn "Removing old subclasses of ~S:~%  ~S"              (warn _"Removing old subclasses of ~S:~%  ~S"
1759                    (%class-name class) (subs))))))                    (%class-name class) (subs))))))
1760       (t       (t
1761        (unless (eq (%class-layout class) layout)        (unless (eq (%class-layout class) layout)
# Line 1793  Line 1799 
1799                 (unless (= (cdr inherited) (dsd-index slot))                 (unless (= (cdr inherited) (dsd-index slot))
1800                   (warn 'simple-style-warning                   (warn 'simple-style-warning
1801                         :format-control                         :format-control
1802                         "~@<Non-overwritten accessor ~S does not access ~                         _"~@<Non-overwritten accessor ~S does not access ~
1803                          slot with name ~S (accessing an inherited slot ~                          slot with name ~S (accessing an inherited slot ~
1804                          instead).~:@>"                          instead).~:@>"
1805                         :format-arguments (list aname (dsd-%name slot)))))                         :format-arguments (list aname (dsd-%name slot)))))
# Line 1818  Line 1824 
1824  ;;;    Copy any old kind of structure.  ;;;    Copy any old kind of structure.
1825  ;;;  ;;;
1826  (defun copy-structure (structure)  (defun copy-structure (structure)
1827    "Return a copy of Structure with the same (EQL) slot values."    _N"Return a copy of Structure with the same (EQL) slot values."
1828    (declare (type structure-object structure) (optimize (speed 3) (safety 0)))    (declare (type structure-object structure) (optimize (speed 3) (safety 0)))
1829    (let* ((len (%instance-length structure))    (let* ((len (%instance-length structure))
1830           (res (%make-instance len))           (res (%make-instance len))
1831           (layout (%instance-layout structure)))           (layout (%instance-layout structure)))
1832      (declare (type index len))      (declare (type index len))
1833      (when (layout-invalid layout)      (when (layout-invalid layout)
1834        (error "Copying an obsolete structure:~%  ~S" structure))        (error _"Copying an obsolete structure:~%  ~S" structure))
1835    
1836      (dotimes (i len)      (dotimes (i len)
1837        (declare (type index i))        (declare (type index i))
# Line 1918  Line 1924 
1924        ((member :just-dump-it-normally :ignore-it)        ((member :just-dump-it-normally :ignore-it)
1925         fun)         fun)
1926        (null        (null
1927         (error "Structures of type ~S cannot be dumped as constants."         (error _"Structures of type ~S cannot be dumped as constants."
1928                (%class-name class)))                (%class-name class)))
1929        (function        (function
1930         (funcall fun structure))         (funcall fun structure))

Legend:
Removed from v.1.98  
changed lines
  Added in v.1.98.12.4

  ViewVC Help
Powered by ViewVC 1.1.5