(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP") (il:filecreated "29-Oct-86 21:55:34" ("compiled on " il:{eris}sources>defstruct.\;10) "21-Oct-86 04:13:01" "COMPILE-FILEd" il:|in| "Xerox Lisp 21-Oct-86 ..." il:|dated| "21-Oct-86 04:48:43") (il:filecreated "29-Oct-86 21:54:36" il:{eris}sources>defstruct.\;10 55510 il:|changes| il:|to:| (il:functions structure-pointer-slots build-copier-type-check declare-structure ensure-consistent-ps assign-field-descriptors defstruct assign-structure-representation defstruct-parse-options) (il:structures ps) (il:vars il:defstructcoms) (il:variables %default-structure-include) il:|previous| il:|date:| "24-Oct-86 15:47:06" il:{eris}zebra>defstruct.\;32) (il:rpaqq il:defstructcoms ((il:* il:|;;;| "Implementation of defstruct") (il:* il:|;;;| "public interface ") (il:functions defstruct) (il:p (setf (macro-function (quote il:defstruct)) nil)) (il:define-types il:structures) (il:* il:|;;;| "top-level ") (il:files il:defstruct-run-time) ( il:functions declare-structure) (il:* il:|;;;| "parsing code") (il:structures ps parsed-slot) ( il:functions assign-slot-accessor remove-documentation record-documentation ensure-valid-type parse-slot defstruct-parse-options ensure-consistent-ps ps-number-of-slots ps-type-specifier) ( il:variables %default-defstruct-type %default-slot-type %default-structure-include %defstruct-options %no-constructor %defstruct-consp-options) (il:* il:|;;;| "slot resolution code") (il:functions assign-slot-offset resolve-slots add-name-slot insert-included-slot merge-slots name-slot add-initial-offset-slots) (il:* il:|;;;| "data layout code") (il:functions pack-datatype-fieldspecs assign-structure-representation define-structure-type defstruct-slot-to-datatype-fieldspec %structure-type-to-fieldspec assign-field-descriptors structure-pointer-slots) (il:* il:|;;;| "accessors and setfs") (il:functions define-accessors pslot-internal-accessor define-setfs setf-name) (il:* il:|;;;| "constructor definition code") (il:functions define-constructors define-boa-constructor argument-names boa-arg-list-with-initial-values boa-slot-setfs find-slot raw-constructor build-constructor-arglist build-constructor-slot-setfs boa-constructor-p default-constructor-name) (il:* il:|;;;| "predicate") (il:functions construct-predicate ps-name-slot-position default-predicate-name function-defining-form) (il:* il:|;;;| "copiers") (il:functions define-copiers build-copier-slot-setfs build-copier-type-check) (il:* il:|;;;| "print functions") (il:variables %default-print-function) (il:* il:|;;;| "internal stuff.") (il:setfs il:ffetchfield) (il:* il:|;;;| "utilities") (il:functions safe-type-expand defstruct-assert-subtypep) (il:* il:|;;;| "file properties") (il:prop il:filetype il:defstruct) (il:prop il:makefile-environment il:defstruct))) (let* ((il:a1257 (quote defstruct)) (il:a1258 (quote il:definer-for)) (il:a1260 (quote il:structures)) ) (il:putprop il:a1257 il:a1258 il:a1260)) (let* ((il:a1261 (quote il:structures)) (il:a1262 (quote il:defined-by)) (il:a1264 (adjoin (quote defstruct) (get il:a1261 il:a1262)))) (il:putprop il:a1261 il:a1262 il:a1264)) il:|expand-DEFSTRUCTA0001| il:d1 (il:l (1 si::$$macro-environment 0 si::$$macro-form)) "@1HHI [J K gK (30 declare-structure 23 resolve-slots 19 remove-documentation 14 defstruct-parse-options) (26 progn) () |expand-DEFSTRUCT| il:d1 (il:l (1 si::$$macro-environment 0 si::$$macro-form)) f@1AH ZdggggJIhhgogoggKhogHhhhhgKhh(9 il:remove-comments) (90 quote 70 quote 59 quote 56 il:\\define-type-save-defn 49 unless 42 eval-when 29 il:|expand-DEFSTRUCTA0001| 26 si::macro-funcall 23 il:without-filepkg 20 progn) ( 67 (quote il:structures) 53 (null il:filepkgflg) 46 (eval)) (il:setf-macro-function (quote defstruct) (quote |expand-DEFSTRUCT|)) (il:setq il:prettyprintmacros (adjoin (quote (defstruct . il:pprint-definer)) il:prettyprintmacros :test (quote equal))) (il:setf-macro-function (quote il:defstruct) nil) (let* ((il:a1266 (quote il:structures)) (il:a1267 (quote il:define-types)) (il:a1268 (quote "Common Lisp structures"))) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1266 il:a1267 il:a1268))) il:a1268)) (il:setq il:prettydefmacros (adjoin (quote (il:structures il:x (il:p il:* (il:mapcar (quote il:x) ( il:function (il:lambda (il:item) (do ((il:def (il:getdef il:item (quote il:structures)))) (il:def il:def ) (cerror "Re-fetch the definition" "No ~S definition for ~S" (quote il:structures) il:item)))))))) il:prettydefmacros :test (quote equal))) (il:setq il:prettytypelst (adjoin (quote (il:changedstructureslst il:structures "Common Lisp structures")) il:prettytypelst :test (quote equal))) (proclaim (quote (il:global il:changedstructureslst))) (or (boundp (quote il:changedstructureslst)) (il:setq il:changedstructureslst nil)) (cond ((not (gethash (quote il:structures) il:*definition-hash-table*)) (let* ((il:a1269 (quote il:structures)) (il:a1270 il:*definition-hash-table*) (il:a1272 (make-hash-table :test (quote equal) :size 50 :rehash-size 50))) (puthash il:a1269 il:a1270 il:a1272)))) (il:setq il:filepkgtypes (adjoin (quote il:structures) il:filepkgtypes)) (let* ((il:a1273 (quote il:structures)) (il:a1274 (quote il:getdef)) (il:a1276 (quote il:\\define-type-getdef))) (il:putprop il:a1273 il:a1274 il:a1276)) (let* ((il:a1277 (quote il:structures)) (il:a1278 (quote il:deldef)) (il:a1280 (quote il:\\define-type-deldef))) (il:putprop il:a1277 il:a1278 il:a1280)) (let* ((il:a1281 (quote il:structures)) (il:a1282 (quote il:filepkgcontents)) (il:a1284 (quote il:nill ))) (il:putprop il:a1281 il:a1282 il:a1284)) (let* ((il:a1285 (quote il:structures)) (il:a1286 (quote il:undefiners)) (il:a1288 (adjoin (quote nil) (get il:a1285 il:a1286)))) (il:putprop il:a1285 il:a1286 il:a1288)) (il:filesload il:defstruct-run-time) declare-structure il:d1 (il:l (0 ps)) agoggg@ hhg@hhh@ @ @ @ @ @ @ @ (93 il:\\append2 90 il:\\append2 87 il:\\append2 84 il:\\append2 81 il:\\append2 78 il:\\append2 75 il:\\append2 72 define-copiers 68 define-constructors 64 define-setfs 60 define-accessors 56 construct-predicate 52 define-structure-type 48 assign-structure-representation 44 record-documentation 19 ps-name) (28 quote 15 quote 12 parsed-structure 9 setf 2 eval-when) ( 6 (eval compile load)) (let* ((il:a1289 (quote declare-structure)) (il:a1290 (quote function)) (il:a1291 "accomplishes all the work of declaring a structure.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1289 il:a1290 il:a1291))) il:a1291)) (set-parsed-structure (quote ps) (quote (ps ps make-ps (#:|name| name standard-constructor all-slot-names type vector-type include conc-name constructors predicate print-function copier named initial-offset local-slots all-slots included-slots documentation-string field-specifiers pointer-descriptors) list nil nil ps- (make-ps) ps-p default-structure-printer copy-ps t 0 ((#:|name| (quote ps) t t 0 nil) (name name t nil 1 ps-name) (standard-constructor nil t nil 2 ps-standard-constructor) (all-slot-names nil t nil 3 ps-all-slot-names) (type %default-defstruct-type t nil 4 ps-type) (vector-type nil t nil 5 ps-vector-type) (include nil t nil 6 ps-include) (conc-name (xcl:pack (list name (quote -))) t nil 7 ps-conc-name) (constructors %no-constructor t nil 8 ps-constructors) (predicate nil t nil 9 ps-predicate) (print-function nil t nil 10 ps-print-function) (copier (xcl:pack (list (quote copy-) name)) t nil 11 ps-copier) (named nil t nil 12 ps-named) ( initial-offset 0 t nil 13 ps-initial-offset) (local-slots nil t nil 14 ps-local-slots) (all-slots nil t nil 15 ps-all-slots) (included-slots nil t nil 16 ps-included-slots) (documentation-string nil t nil 17 ps-documentation-string) (field-specifiers nil t nil 18 ps-field-specifiers) (pointer-descriptors nil t nil 19 ps-pointer-descriptors)) ((#:|name| (quote ps) t t 0 nil) (name name t nil 1 ps-name) ( standard-constructor nil t nil 2 ps-standard-constructor) (all-slot-names nil t nil 3 ps-all-slot-names) (type %default-defstruct-type t nil 4 ps-type) (vector-type nil t nil 5 ps-vector-type) (include nil t nil 6 ps-include) (conc-name (xcl:pack (list name (quote -))) t nil 7 ps-conc-name) (constructors %no-constructor t nil 8 ps-constructors) (predicate nil t nil 9 ps-predicate) (print-function nil t nil 10 ps-print-function) (copier (xcl:pack (list (quote copy-) name)) t nil 11 ps-copier) (named nil t nil 12 ps-named) (initial-offset 0 t nil 13 ps-initial-offset) (local-slots nil t nil 14 ps-local-slots) (all-slots nil t nil 15 ps-all-slots) (included-slots nil t nil 16 ps-included-slots) (documentation-string nil t nil 17 ps-documentation-string) ( field-specifiers nil t nil 18 ps-field-specifiers) (pointer-descriptors nil t nil 19 ps-pointer-descriptors)) nil "contains the parsed information for a SINGLE structure type" nil nil))) (let* ((il:a1296 (quote ps)) (il:a1297 (quote structure)) (il:a1298 "contains the parsed information for a SINGLE structure type")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1296 il:a1297 il:a1298))) il:a1298)) ps-p il:d1 (il:l (0 object)) @d @d @j g(19 elt 4 vectorp) (22 ps 12 il:listp) () ps-name il:d1 (il:l (0 ps)) k@ (4 nth) nil () ps-standard-constructor il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-all-slot-names il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-type il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-vector-type il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-include il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-conc-name il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-constructors il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-predicate il:d1 (il:l (0 ps)) l @ (5 nth) nil () ps-print-function il:d1 (il:l (0 ps)) l @ (5 nth) nil () ps-copier il:d1 (il:l (0 ps)) l @ (5 nth) nil () ps-named il:d1 (il:l (0 ps)) l @ (5 nth) nil () ps-initial-offset il:d1 (il:l (0 ps)) l @ (5 nth) nil () ps-local-slots il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-all-slots il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-included-slots il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-documentation-string il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-field-specifiers il:d1 (il:l (0 ps)) l@ (5 nth) nil () ps-pointer-descriptors il:d1 (il:l (0 ps)) l@ (5 nth) nil () (remprop (quote ps-name) (quote il:setf-method-expander)) (il:putprops ps-name il:setf-inverse %%setf-ps-name) %%setf-ps-name il:d1 (il:l (1 value 0 ps)) k@A (5 il:%setnth) nil () (remprop (quote ps-standard-constructor) (quote il:setf-method-expander)) (il:putprops ps-standard-constructor il:setf-inverse %%setf-ps-standard-constructor) %%setf-ps-standard-constructor il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-all-slot-names) (quote il:setf-method-expander)) (il:putprops ps-all-slot-names il:setf-inverse %%setf-ps-all-slot-names) %%setf-ps-all-slot-names il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-type) (quote il:setf-method-expander)) (il:putprops ps-type il:setf-inverse %%setf-ps-type) %%setf-ps-type il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-vector-type) (quote il:setf-method-expander)) (il:putprops ps-vector-type il:setf-inverse %%setf-ps-vector-type) %%setf-ps-vector-type il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-include) (quote il:setf-method-expander)) (il:putprops ps-include il:setf-inverse %%setf-ps-include) %%setf-ps-include il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-conc-name) (quote il:setf-method-expander)) (il:putprops ps-conc-name il:setf-inverse %%setf-ps-conc-name) %%setf-ps-conc-name il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-constructors) (quote il:setf-method-expander)) (il:putprops ps-constructors il:setf-inverse %%setf-ps-constructors) %%setf-ps-constructors il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-predicate) (quote il:setf-method-expander)) (il:putprops ps-predicate il:setf-inverse %%setf-ps-predicate) %%setf-ps-predicate il:d1 (il:l (1 value 0 ps)) l @A (6 il:%setnth) nil () (remprop (quote ps-print-function) (quote il:setf-method-expander)) (il:putprops ps-print-function il:setf-inverse %%setf-ps-print-function) %%setf-ps-print-function il:d1 (il:l (1 value 0 ps)) l @A (6 il:%setnth) nil () (remprop (quote ps-copier) (quote il:setf-method-expander)) (il:putprops ps-copier il:setf-inverse %%setf-ps-copier) %%setf-ps-copier il:d1 (il:l (1 value 0 ps)) l @A (6 il:%setnth) nil () (remprop (quote ps-named) (quote il:setf-method-expander)) (il:putprops ps-named il:setf-inverse %%setf-ps-named) %%setf-ps-named il:d1 (il:l (1 value 0 ps)) l @A (6 il:%setnth) nil () (remprop (quote ps-initial-offset) (quote il:setf-method-expander)) (il:putprops ps-initial-offset il:setf-inverse %%setf-ps-initial-offset) %%setf-ps-initial-offset il:d1 (il:l (1 value 0 ps)) l @A (6 il:%setnth) nil () (remprop (quote ps-local-slots) (quote il:setf-method-expander)) (il:putprops ps-local-slots il:setf-inverse %%setf-ps-local-slots) %%setf-ps-local-slots il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-all-slots) (quote il:setf-method-expander)) (il:putprops ps-all-slots il:setf-inverse %%setf-ps-all-slots) %%setf-ps-all-slots il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-included-slots) (quote il:setf-method-expander)) (il:putprops ps-included-slots il:setf-inverse %%setf-ps-included-slots) %%setf-ps-included-slots il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-documentation-string) (quote il:setf-method-expander)) (il:putprops ps-documentation-string il:setf-inverse %%setf-ps-documentation-string) %%setf-ps-documentation-string il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-field-specifiers) (quote il:setf-method-expander)) (il:putprops ps-field-specifiers il:setf-inverse %%setf-ps-field-specifiers) %%setf-ps-field-specifiers il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () (remprop (quote ps-pointer-descriptors) (quote il:setf-method-expander)) (il:putprops ps-pointer-descriptors il:setf-inverse %%setf-ps-pointer-descriptors) %%setf-ps-pointer-descriptors il:d1 (il:l (1 value 0 ps)) l@A (6 il:%setnth) nil () make-ps il:d1 (il:l (0 il:|-args-|) il:f 57 name il:f 58 %default-defstruct-type) B9eHkJdItWr.8HkKdJmhHkNdMsh_Hk__OdOqWt_Hk__OdOqh_Hk__OdOrh_ Hk_$_"O$dO"sIgh _&Hk_*_(O*dO(kg_,Hk_0_.O0dO.jh_2Hk_6_4O6dO4kh_8Hk_<_:OHk_B_@OBdO@dh_DHk_H_FOHdOFej_JHk_N_LONdOLfh_PHk_T_ROTdORgh_VHk_Z_XOZdOXhh_\Hk_`_^O`dO^ih_bHk_f_dOfdOdjh_hHk_l_jOldOjkh_nl _pjOpg kOpI lOpL lOpO lOpO lOpO lOpO lOpO& lOpO, l OpO2 l OpO8 l OpO> l OpOD l OpOJ lOpOP lOpOV lOpO\ lOpOb lOpOh lOpOn OpagJkaJlZvagKkaKl[}agNkaNl^wagOkaOl_uagOkaOl_uagOkaOl_tagO$kaO$l_$sagO*kaO*l_*{agO0kaO0l_0|agO6kaO6l_6{agOJo@ @ I lg oo@ @ I lg H@(146 symbol-function 138 pslot-type 134 pslot-type 130 pslot-name 115 symbol-function 107 pslot-type 103 pslot-type 99 pslot-name 78 il:\\mvlist 75 subtypep 72 pslot-type 68 pslot-type 63 error 60 ps-include 56 pslot-name 45 pslot-read-only 38 pslot-read-only 33 error 30 ps-include 26 pslot-name 10 member) (143 cerror 112 error 7 il:insert-included-slota0001 4 :test) ( 126 "Perhaps, Included slot ~S's type ~s is not a subtype of original slot type ~s" 122 "Assume subtypep should return t" 95 "Included slot ~S's type ~s is not a subtype of original slot type ~s" 52 "included slot ~s must be read-only. It is in included structure ~S" 22 "included slot ~S not present in included structure ~S") (let* ((il:a1356 (quote insert-included-slot)) (il:a1357 (quote function)) (il:a1358 "replaces the slot in super-slots that corresponds to new-slot with new-slot")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1356 il:a1357 il:a1358))) il:a1358)) merge-slots il:d1 (il:l (2 ps 1 super-slots 0 included-slots)) @HAAB HX(14 insert-included-slot) nil () (let* ((il:a1360 (quote merge-slots)) (il:a1361 (quote function)) (il:a1362 "takes the included-slots, and the local slots, then merges them with the slots from the super that aren't shadowed." )) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1360 il:a1361 il:a1362 ))) il:a1362)) name-slot il:d1 (il:l (0 ps)) o g@ hoh (26 parse-slot 13 ps-name 6 make-symbol) (9 quote) ( 20 (:read-only t) 3 "name") (let* ((il:a1363 (quote name-slot)) (il:a1364 (quote function)) (il:a1365 "returns a parsed-slot representing the 'name' field of a structure")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1363 il:a1364 il:a1365))) il:a1365)) add-initial-offset-slots il:d1 (il:l (0 ps)) @d goh @ (28 %%setf-ps-local-slots 25 il:\\nconc2 22 ps-local-slots 18 make-list 15 parse-slot 4 ps-initial-offset) (7 :initial-element) ( 11 (nil nil :read-only t)) (let* ((il:a1366 (quote add-initial-offset-slots)) (il:a1367 (quote function)) (il:a1368 "adds parsed-slots to the local-slots to represent the initial offset.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1366 il:a1367 il:a1368))) il:a1368)) pack-datatype-fieldspecs il:d1 (il:l (0 field-specs)) @nil nil () (let* ((il:a1369 (quote pack-datatype-fieldspecs)) (il:a1370 (quote function)) (il:a1371 "dummy")) ( progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1369 il:a1370 il:a1371)) ) il:a1371)) assign-structure-representation il:d1 (il:l (0 ps) il:f 7 *parsed-structures*) @ aHgHdg@ gg @ @ @ W o@ I @ @J KJ \L@N ggKhgJhgNhMg@ ghhh(145 ps-include 113 assign-field-descriptors 102 il:translate.datatype 97 %%setf-ps-field-specifiers 91 ps-name 86 pack-datatype-fieldspecs 83 append 79 ps-field-specifiers 76 error 73 ps-include 59 ps-include 53 ps-include 48 mapcar 45 ps-local-slots 41 symbol-function 24 assign-slot-offset 3 ps-type) (150 structure-object 141 quote 133 quote 126 quote 119 quote 116 si::%structure-declare-datatype 38 defstruct-slot-to-datatype-fieldspec 28 datatype 17 list 10 vector) ( 69 "~s is not a defined structure") (let* ((il:a1373 (quote assign-structure-representation)) (il:a1374 (quote function)) (il:a1375 "Determines the descriptors and returns a form to create the datatype at loadtime.")) (progn (cond (( fboundp (quote il:set-documentation)) (il:set-documentation il:a1373 il:a1374 il:a1375))) il:a1375)) define-structure-type il:d1 (il:l (0 ps)) ,@ g"@ gHhggHhhhh(13 ps-name 3 ps-type) (27 il:datatype 24 quote 19 deftype 6 datatype) () (let* ((il:a1376 (quote define-structure-type)) (il:a1377 (quote function)) (il:a1378 "adds the structure to the common lisp type system with deftype.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1376 il:a1377 il:a1378))) il:a1378)) defstruct-slot-to-datatype-fieldspec il:d1 (il:l (0 slot)) @ (6 %structure-type-to-fieldspec 3 pslot-type) nil () (let* ((il:a1379 (quote defstruct-slot-to-datatype-fieldspec)) (il:a1380 (quote function)) (il:a1381 "given a parsed-slot returns a datatype fieldspec that will contain it.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1379 il:a1380 il:a1381))) il:a1381)) %structure-type-to-fieldspec il:d1 (il:l (0 elementtype)) @g@diggg@dgdgodgg@dggh@ig@gg@h@ig]@dWd3 Pd3 Hd@=!@ZHչHjjgIkhbMoHNJoDg@o 4@ H(@H b(234 il:type-expand 221 il:type-expander 213 equal) (204 il:fixp 169 mod 111 integer 96 floatp 90 floatp 82 datatype 68 il:floatp 63 float 56 single-float 48 il:xpointer 37 bit 28 integer 22 il:signedword 17 fixnum 13 il:pointer 3 string-char) ( 210 (simple-vector * fixnum) 196 2147483647 185 -2147483648 43 (il:bits 1)) assign-field-descriptors il:d1 (il:l (1 field-descriptors 0 ps)) 8@ g@ AI HhJ IH(45 %%setf-pslot-field-descriptor 29 il:assert-fail 17 ps-all-slots 12 values 3 ps-type) (6 datatype) () (let* ((il:a1385 (quote assign-field-descriptors)) (il:a1386 (quote function)) (il:a1387 "assigns the field descriptors for accessing each slot of the structure")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1385 il:a1386 il:a1387))) il:a1387)) il:structure-pointer-slotsa0001 il:d1 (il:l (0 descriptor)) &@HgHgHgHg@hnil (29 il:fullxpointer 23 il:xpointer 17 il:fullpointer 10 il:pointer) () structure-pointer-slots il:d1 (il:l (0 structure-name) il:f 1 *parsed-structures*) 0@Q o@ H Hgg H (45 %%setf-ps-pointer-descriptors 42 mapcan 39 mapcar 36 ps-all-slots 32 symbol-function 20 ps-pointer-descriptors 13 error) (29 pslot-field-descriptor 26 il:structure-pointer-slotsa0001) ( 9 "~s is not a defined structure") il:define-accessorsa0001 il:d1 (il:l (0 slot) il:f 1 arg-name il:f 2 ps il:f 3 structure-type) $@ HRg HQh@QS hh(26 pslot-internal-accessor 16 function-defining-form 3 pslot-accessor) (13 accessors) () define-accessors il:d1 (il:p 1 structure-type il:p 0 arg-name il:i 0 ps) @ @ g@ (20 mapcan 17 ps-all-slots 7 ps-type 3 ps-name) (13 il:define-accessorsa0001) () (let* ((il:a1388 (quote define-accessors)) (il:a1389 (quote function)) (il:a1390 "returns the forms that when evaluated, define the accessors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1388 il:a1389 il:a1390))) il:a1390)) pslot-internal-accessor il:d1 (il:l (3 no-type-check 2 structure-type 1 argument 0 slot)) YBHdgCggg@ hAhgg@ AhHggA@ hgHo (86 il:ecase-fail 70 pslot-field-descriptor 49 pslot-field-descriptor 28 pslot-field-descriptor) (78 structure-type 65 svref 59 vector 45 nth 40 list 24 quote 21 il:fetchfield 17 il:ffetchfield 8 datatype) ( 83 (datatype list vector)) (let* ((il:a1392 (quote pslot-internal-accessor)) (il:a1393 (quote function)) (il:a1394 "returns a form which fetches slot from argument")) (progn (cond ((fboundp (quote il:set-documentation )) (il:set-documentation il:a1392 il:a1393 il:a1394))) il:a1394)) il:define-setfsa0001 il:d1 (il:l (0 slot) il:f 2 arg-name il:f 3 ps il:f 4 structure-type) D@ H @ 1gHIhSg IRog@RT ohhh(49 pslot-internal-accessor 33 function-defining-form 15 pslot-read-only 10 setf-name 3 pslot-accessor) (43 setf 30 setfs 20 defsetf) ( 53 (value) 39 (value)) define-setfs il:d1 (il:p 1 structure-type il:p 0 arg-name il:i 0 ps) @ @ g@ (20 mapcan 17 ps-all-slots 7 ps-type 3 ps-name) (13 il:define-setfsa0001) () (let* ((il:a1395 (quote define-setfs)) (il:a1396 (quote function)) (il:a1397 "returns the forms that when evaluated, define the setf's for the slots.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1395 il:a1396 il:a1397))) il:a1397)) setf-name il:d1 (il:l (0 accessor-name)) g@h (9 xcl:pack) (2 %%setf-) () (let* ((il:a1398 (quote setf-name)) (il:a1399 (quote function)) (il:a1400 "produces the name of the setf function for this accessor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1398 il:a1399 il:a1400))) il:a1400)) il:define-constructorsa0001 il:d1 (il:l (0 constructor) il:f 0 ps) @P (4 define-boa-constructor) nil () define-constructors il:d1 (il:i 0 ps) @ Q@ @ g H gH I I@ 0HOd] M@ 0@M @g MgKgJ@ hhLJh hONh_N&_O(105 il:\\append2 93 raw-constructor 79 function-defining-form 71 %%setf-ps-standard-constructor 64 define-boa-constructor 58 boa-constructor-p 44 build-constructor-slot-setfs 39 build-constructor-arglist 34 mapcar 26 il:%single-every 22 symbol-function 15 ps-name 10 ps-all-slots 3 ps-constructors) (88 let 83 &key 76 constructor 30 il:define-constructorsa0001 19 boa-constructor-p) () (let* ((il:a1401 (quote define-constructors)) (il:a1402 (quote function)) (il:a1403 "returns the forms that when evaluated, define the constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1401 il:a1402 il:a1403))) il:a1403)) define-boa-constructor il:d1 (il:l (1 ps 0 name&arglist)) B@A@YA A [I A Ag HJgKA hhLKh h(56 il:\\append2 44 raw-constructor 34 function-defining-form 26 boa-slot-setfs 22 argument-names 17 ps-name 12 boa-arg-list-with-initial-values) (39 let 31 boa-constructor) () il:argument-namesa0001 il:d1 (il:l (0 arg) il:f 2 lambda-list-keywords) %@dhRYhhH:II@hnil nil () argument-names il:d1 (il:l (0 arg-list)) g@ (6 mapcan) (2 il:argument-namesa0001) () boa-arg-list-with-initial-values il:d1 (il:l (1 ps 0 arg-list) il:f 11 lambda-list-keywords) @ A  HZ h_Hg:JJW[hL:KKO_O_OgOdg𒿰W]hoO@ 6N:MMOdldOdOOOI h_OOOa(161 pslot-initial-value 158 find-slot 110 error 7 ps-all-slots 3 copy-tree) (85 &aux 76 &rest 28 &optional) ( 104 "~S cannot appear in a BOA constructor as it does in ~S.") il:boa-slot-setfsa0001 il:d1 (il:l (0 name) il:f 1 slots il:f 2 result-arg il:f 3 structure-type) @Q gHRSi @h(17 pslot-internal-accessor 4 find-slot) (10 setf) () boa-slot-setfs il:d1 (il:l (2 ps 1 slot-names) il:p 1 structure-type il:p 0 slots il:i 0 result-arg) B B gA (17 mapcar 7 ps-type 3 ps-all-slots) (13 il:boa-slot-setfsa0001) () find-slot il:d1 (il:l (2 dont-error 1 slots 0 name)) $AHB o@ @I IHX(25 pslot-name 17 error) nil ( 13 "slot ~s not found.") raw-constructor il:d1 (il:l (0 ps)) h@ Hdggg@ hhgg@ hHg$gg@ hhgg@ hhoHo (101 il:ecase-fail 80 ps-vector-type 65 ps-number-of-slots 44 ps-number-of-slots 25 ps-name 3 ps-type) (76 quote 73 :element-type 61 quote 58 make-array 52 vector 40 make-list 35 list 21 quote 18 il:ncreate 11 datatype) ( 98 (datatype list vector) 93 (ps-type ps)) (let* ((il:a1406 (quote raw-constructor)) (il:a1407 (quote function)) (il:a1408 "returns a form which will make an instance of this structure w/o initialisation")) (progn (cond (( fboundp (quote il:set-documentation)) (il:set-documentation il:a1406 il:a1407 il:a1408))) il:a1408)) il:build-constructor-arglista0001 il:d1 (il:l (0 slot)) !@ @ @ hHIHhhIh(14 pslot-accessor 7 pslot-name 3 pslot-initial-value) nil () build-constructor-arglist il:d1 (il:l (0 slots)) g@ (6 mapcan) (2 il:build-constructor-arglista0001) () (let* ((il:a1409 (quote build-constructor-arglist)) (il:a1410 (quote function)) (il:a1411 "gathers the keywords and initial-values for (non BOA) constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1409 il:a1410 il:a1411))) il:a1411)) il:build-constructor-slot-setfsa0001 il:d1 (il:l (0 slot) il:f 1 object-name il:f 2 structure-type) 2@d g@QRi @ h g@QRi Hh(42 pslot-internal-accessor 29 pslot-name 21 pslot-initial-value 17 pslot-internal-accessor 4 pslot-accessor) (35 setf 10 setf) () build-constructor-slot-setfs il:d1 (il:l (1 ps 0 slots) il:p 1 object-name il:p 0 structure-type) A A g@ (17 mapcar 7 ps-name 3 ps-type) (13 il:build-constructor-slot-setfsa0001) () (let* ((il:a1412 (quote build-constructor-slot-setfs)) (il:a1413 (quote function)) (il:a1414 "builds the setfs that initialize the slots in a constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1412 il:a1413 il:a1414))) il:a1414)) boa-constructor-p il:d1 (il:l (0 constructor)) @inil nil () (let* ((il:a1415 (quote boa-constructor-p)) (il:a1416 (quote function)) (il:a1417 "returns t if the constructor is a By Order of Arguments constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1415 il:a1416 il:a1417))) il:a1417)) default-constructor-name il:d1 (il:l (0 structure-name)) g@h (9 xcl:pack) (2 make-) () construct-predicate il:d1 (il:l (0 ps)) @ Hy@d gggg@ hB oH@ goggg@ o@ hg@ hhh@g HoIhh(115 function-defining-form 96 ps-name 85 ps-name-slot-position 75 ps-type-specifier 54 error 51 ps-name 41 ps-named 34 ps-name 14 ps-type 3 ps-predicate) (112 predicate 92 quote 71 the 68 elt 65 eq 58 and 30 quote 27 object 24 typep 17 datatype) ( 120 (object) 79 (object) 62 (typep object (quote sequence)) 46 "The predicate ~s may not be specified for ~s because it is not :name'd") (let* ((il:a1418 (quote construct-predicate)) (il:a1419 (quote function)) (il:a1420 "returns a list of the forms (if any) defining the predicate for ps")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1418 il:a1419 il:a1420))) il:a1420)) ps-name-slot-position il:d1 (il:l (0 ps) il:f 2 *parsed-structures*) &@ HdR oH @ I (34 length 30 ps-initial-offset 25 ps-all-slots 22 error 3 ps-include) nil ( 18 "~s is not a defined structure") (let* ((il:a1421 (quote ps-name-slot-position)) (il:a1422 (quote function)) (il:a1423 "returns the offset of the name slot for ps.")) (progn (cond ((fboundp (quote il:set-documentation)) ( il:set-documentation il:a1421 il:a1422 il:a1423))) il:a1423)) default-predicate-name il:d1 (il:l (0 structure-name)) @gh (9 xcl:pack) (3 -p) () function-defining-form il:d1 (il:l (1 context 0 ps)) gnil (2 defun) () (let* ((il:a1424 (quote function-defining-form)) (il:a1425 (quote function)) (il:a1426 "dummy definition for now, for deciding if a function should be inline or not")) (progn (cond (( fboundp (quote il:set-documentation)) (il:set-documentation il:a1424 il:a1425 il:a1426))) il:a1426)) define-copiers il:d1 (il:l (0 ps)) a@ g@ CHP@J [K@ @ JIM @g @ JhLgI@ hhNIh h h(89 il:\\append2 82 il:\\append2 70 raw-constructor 58 ps-copier 54 function-defining-form 46 build-copier-slot-setfs 39 ps-type 35 ps-all-slots 24 il:\\mvlist 21 build-copier-type-check 10 ps-name 3 ps-copier) (65 let 51 copiers 6 new) () (let* ((il:a1427 (quote define-copiers)) (il:a1428 (quote function)) (il:a1429 "returns the form that when evaluated, defines the copier")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1427 il:a1428 il:a1429))) il:a1429)) il:build-copier-slot-setfsa0001 il:d1 (il:l (0 slot) il:f 0 structure-type il:f 1 to-argument il:f 2 from-argument) g@QPi @RPi h(16 pslot-internal-accessor 9 pslot-internal-accessor) (2 setf) () build-copier-slot-setfs il:d1 (il:l (4 type-check-slots? 0 slots) il:i 3 to-argument il:i 2 from-argument il:i 1 structure-type) g@ (6 mapcar) (2 il:build-copier-slot-setfsa0001) () (let* ((il:a1430 (quote build-copier-slot-setfs)) (il:a1431 (quote function)) (il:a1432 "constructs the forms that copy each individual slot.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1430 il:a1431 il:a1432))) il:a1432)) build-copier-type-check il:d1 (il:l (1 from-arg 0 ps)) T@d ggA@ hhh  ,g@ Ahgho@ Ahhhh i (81 values 76 values 61 format 58 ps-name 42 ps-predicate 33 ps-predicate 29 values 19 ps-name 4 ps-type) (49 error 38 or 14 check-type 7 datatype) ( 54 "Arg not ~s: ~~S") (let* ((il:a1433 (quote build-copier-type-check)) (il:a1434 (quote function)) (il:a1435 "constructs the type checking form at the beginning of the copier and decides whether individual slots need to be type-checked." )) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1433 il:a1434 il:a1435 ))) il:a1435)) (proclaim (quote (special %default-print-function))) (or (boundp (quote %default-print-function)) (il:setq %default-print-function (quote default-structure-printer))) (let* ((il:a1436 (quote %default-print-function)) (il:a1437 (quote variable)) (il:a1438 "print function used when none is specified in a defstruct")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1436 il:a1437 il:a1438))) il:a1438)) (remprop (quote il:ffetchfield) (quote il:setf-method-expander)) (il:putprops il:ffetchfield il:setf-inverse il:replacefield) safe-type-expand il:d1 (il:l (0 type-form)) @ H@H @(13 type-expand 3 type-expander) nil () |expand-DEFSTRUCT-ASSERT-SUBTYPEP| il:d1 (il:l (1 si::$$macro-environment 0 si::$$macro-form)) @ HHZJ\LJ_MoNIKh__gogIKhgoggoOOhigoohoO OOo hh(128 il:\\append2 113 format) (95 funcall 77 funcall 74 certain? 67 cond 58 subtypep 51 multiple-value-bind) ( 125 (t) 108 "Perhaps, ~a" 103 "Assume subtypep should return t" 99 (function cerror) 81 (function error) 71 (subtype? t) 55 (subtype? certain?) 34 "~S is not a subtype of ~S") (il:setf-macro-function (quote defstruct-assert-subtypep) (quote |expand-DEFSTRUCT-ASSERT-SUBTYPEP|)) (let* ((il:a1442 (quote defstruct-assert-subtypep)) (il:a1443 (quote function)) (il:a1444 "provides an interface for places where the implementor isn't sure that subtypep can be trusted")) ( progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1442 il:a1443 il:a1444)) ) il:a1444)) (il:putprops il:defstruct il:filetype compile-file) (il:putprops il:defstruct il:makefile-environment (:readtable "XCL" :package "LISP")) (il:putprops il:defstruct il:copyright ("Xerox Corporation" 1986)) nil