(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP") (il:filecreated "22-Oct-86 21:36:19" ("compiled on " il:{eris}zebra>defstruct.\;28) "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 "22-Oct-86 21:35:20" il:{eris}zebra>defstruct.\;28 47356 il:|changes| il:|to:| (il:functions ensure-consistent-ps defstruct-slot-to-datatype-fieldspec %structure-type-to-fieldspec defstruct-assert-subtypep) il:|previous| il:|date:| "22-Oct-86 13:37:54" il:{eris}zebra>defstruct.\;27) (il:rpaqq il:defstructcoms ((il:* il:|;;;| "Implementation of defstruct") (il:* il:|;;;| "public interface ") (il:functions defstruct) (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-print-function %default-slot-type %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) (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 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:functions record-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))) |expand-DEFSTRUCT| il:d1 (il:l (1 il:$$macro-environment 0 il:$$macro-form)) @ Q@HHggJ ]K M LM gM gJhh hgoggggJhogIhhhhgJhh(61 il:\\append2 49 declare-structure 41 resolve-slots 35 ps-name 30 remove-documentation 25 defstruct-parse-options 4 il:remove-comments) (115 quote 95 quote 84 quote 81 il:\\define-type-save-defn 78 il:filepkgflg 75 and 68 eval-when 52 quote 45 progn 21 il:without-filepkg 18 progn) ( 92 (quote il:structures) 72 (eval)) (il:setf-macro-function (quote defstruct) (quote |expand-DEFSTRUCT|)) (il:addtovar il:prettyprintmacros (defstruct . il:pprint-definer)) (il:addtovar il:prettydefmacros (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:addtovar il:prettytypelst (il:changedstructureslst il:structures "Common Lisp structures")) (cond ((not (gethash (quote il:structures) il:*definition-hash-table*)) (let* ((il:a0331 (quote il:structures)) (il:a0332 il:*definition-hash-table*) (il:a0334 (make-hash-table (quote :test) (quote equal) (quote :size) 50 (quote :rehash-size) 50))) (puthash il:a0331 il:a0332 il:a0334)))) (il:addtovar il:filepkgtypes il:structures) (il:putprops il:structures il:getdef il:\\define-type-getdef) (il:putprops il:structures il:filepkgcontents il:nill) (il:putprops il:structures il:proptype il:structures) (il:filesload il:defstruct-run-time) declare-structure il:d1 (il:l (0 ps)) l@ @ @ @ @ @ @ @ @ goggg@ hhg@hhhh (105 il:\\append2 102 il:\\append2 99 il:\\append2 96 il:\\append2 93 il:\\append2 90 il:\\append2 87 il:\\append2 84 il:\\append2 81 il:\\append2 55 ps-name 35 record-print-function 31 define-copiers 27 define-constructors 23 define-setfs 19 define-accessors 15 construct-predicate 11 define-structure-type 7 assign-structure-representation 3 record-documentation) (64 quote 51 quote 48 parsed-structure 45 setf 38 eval-when) ( 42 (eval compile load)) (let* ((il:a0335 (quote declare-structure)) (il:a0336 (quote function)) (il:a0337 "accomplishes all the work of declaring a structure.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0335 il:a0336 il:a0337))) il:a0337)) (let* ((il:a0338 (quote ps)) (il:a0339 (quote structure)) (il:a0340 "contains the parsed information for a SINGLE structure type")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0338 il:a0339 il:a0340))) il:a0340)) 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 () (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 () make-ps il:d1 (il:l (0 il:|-args-|) il:f 54 name il:f 55 %default-defstruct-type il:f 56 %default-print-function)  6eHkJdIUWl.p5HkKdJNhHkNdMTh_Hk__OdORWn_Hk__OdORh_Hk__OdOSh_ Hk_$_"O$dO"TIgh _&Hk_*_(O*dO(Lg_,Hk_0_.O0dO.Kh_2Hk_6_4O6dO4LWp_8Hk_<_:OHk_B_@OBdO@Dh_DHk_H_FOHdOFEj_JHk_N_LONdOLFh_PHk_T_ROTdORGh_VHk_Z_XOZdOXHh_\Hk_`_^O`dO^Ih_bHk_f_dOfdOdJh_hl _jjOjg kOjI lOjL lOjO lOjO lOjO lOjO lOjO& lOjO, l OjO2 l OjO8 l OjO> l OjOD l OjOJ lOjOP lOjOV lOjO\ lOjOb lOjOh OjagJkaJlZagKkaKl[agNkaNl^agOkaOl_agOkaOl_agOkaOl_agO$kaO$l_$agO*kaO*l_*agO0kaO0l_0agO6kaO6l_6agOJo@ @ 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:a0398 (quote insert-included-slot)) (il:a0399 (quote function)) (il:a0400 "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:a0398 il:a0399 il:a0400))) il:a0400)) merge-slots il:d1 (il:l (2 ps 1 super-slots 0 included-slots)) @HAAB HX(14 insert-included-slot) nil () (let* ((il:a0402 (quote merge-slots)) (il:a0403 (quote function)) (il:a0404 "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:a0402 il:a0403 il:a0404 ))) il:a0404)) 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:a0405 (quote name-slot)) (il:a0406 (quote function)) (il:a0407 "returns a parsed-slot representing the 'name' field of a structure")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0405 il:a0406 il:a0407))) il:a0407)) 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:a0408 (quote add-initial-offset-slots)) (il:a0409 (quote function)) (il:a0410 "adds parsed-slots to the local-slots to represent the initial offset.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a0408 il:a0409 il:a0410))) il:a0410)) pack-datatype-fieldspecs il:d1 (il:l (0 field-specs)) @nil nil () (let* ((il:a0411 (quote pack-datatype-fieldspecs)) (il:a0412 (quote function)) (il:a0413 "dummy")) ( progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0411 il:a0412 il:a0413)) ) il:a0413)) assign-structure-representation il:d1 (il:l (0 ps) il:f 7 *parsed-structures*) @ aHgHdg@ g~g @ @ @ W  o@ I @ @J KJ \L@N ggKhgJhgNhMg@ hhh(143 ps-include 111 assign-field-descriptors 100 il:translate.datatype 95 %%setf-ps-field-specifiers 89 ps-name 84 pack-datatype-fieldspecs 81 append 77 ps-field-specifiers 74 error 71 ps-include 60 assoc 55 ps-include 49 ps-include 44 mapcar 41 ps-local-slots 37 symbol-function 24 assign-slot-offset 3 ps-type) (139 quote 131 quote 124 quote 117 quote 114 %structure-declare-datatype 34 defstruct-slot-to-datatype-fieldspec 28 datatype 17 list 10 vector) ( 67 "~s is not a defined structure") (let* ((il:a0415 (quote assign-structure-representation)) (il:a0416 (quote function)) (il:a0417 "Determines the descriptors and returns a form to create the datatype at loadtime.")) (progn (cond (( fboundp (quote il:set-documentation)) (il:set-documentation il:a0415 il:a0416 il:a0417))) il:a0417)) 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:a0418 (quote define-structure-type)) (il:a0419 (quote function)) (il:a0420 "adds the structure to the common lisp type system with deftype.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0418 il:a0419 il:a0420))) il:a0420)) defstruct-slot-to-datatype-fieldspec il:d1 (il:l (0 slot)) @ (6 %structure-type-to-fieldspec 3 pslot-type) nil () (let* ((il:a0421 (quote defstruct-slot-to-datatype-fieldspec)) (il:a0422 (quote function)) (il:a0423 "given a parsed-slot returns a datatype fieldspec that will contain it.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a0421 il:a0422 il:a0423))) il:a0423)) %structure-type-to-fieldspec il:d1 (il:l (0 elementtype)) @g@diggg@dgdgodgg@dggh@ig@gg@h@igc@d]d3 Vd3 Nd@C!@YH HdjjgJ h o JIo >g@o .@ H"@H b (240 il:type-expand 227 il:type-expander 219 equal 203 ileq 191 igeq 183 cmlstruct.cltype.to.iltype 177 add1 161 idifference) (210 il:fixp 173 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) ( 216 (simple-vector * fixnum) 200 2147483647 188 -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:a0427 (quote assign-field-descriptors)) (il:a0428 (quote function)) (il:a0429 "assigns the field descriptors for accessing each slot of the structure")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a0427 il:a0428 il:a0429))) il:a0429)) 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:a0430 (quote define-accessors)) (il:a0431 (quote function)) (il:a0432 "returns the forms that when evaluated, define the accessors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0430 il:a0431 il:a0432))) il:a0432)) 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:a0434 (quote pslot-internal-accessor)) (il:a0435 (quote function)) (il:a0436 "returns a form which fetches slot from argument")) (progn (cond ((fboundp (quote il:set-documentation )) (il:set-documentation il:a0434 il:a0435 il:a0436))) il:a0436)) 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:a0437 (quote define-setfs)) (il:a0438 (quote function)) (il:a0439 "returns the forms that when evaluated, define the setf's for the slots.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a0437 il:a0438 il:a0439))) il:a0439)) setf-name il:d1 (il:l (0 accessor-name)) g@h (9 xcl:pack) (2 %%setf-) () (let* ((il:a0440 (quote setf-name)) (il:a0441 (quote function)) (il:a0442 "produces the name of the setf function for this accessor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0440 il:a0441 il:a0442))) il:a0442)) define-constructors il:d1 (il:l (0 ps)) @ Q@ @ g H g H I I@ 0HJd] M ,@M gMgKgJ@ hhLJh hONh_N&_O(103 il:\\append2 91 raw-constructor 73 %%setf-ps-standard-constructor 66 define-boa-constructor 61 boa-constructor-p 47 build-constructor-slot-setfs 42 build-constructor-arglist 37 mapcar 33 symbol-function 26 il:%single-every 22 symbol-function 15 ps-name 10 ps-all-slots 3 ps-constructors) (86 let 81 &key 77 defun 30 define-boa-constructor 19 boa-constructor-p) () (let* ((il:a0443 (quote define-constructors)) (il:a0444 (quote function)) (il:a0445 "returns the forms that when evaluated, define the constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0443 il:a0444 il:a0445))) il:a0445)) 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:a0447 (quote raw-constructor)) (il:a0448 (quote function)) (il:a0449 "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:a0447 il:a0448 il:a0449))) il:a0449)) 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:a0450 (quote build-constructor-arglist)) (il:a0451 (quote function)) (il:a0452 "gathers the keywords and initial-values for (non BOA) constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0450 il:a0451 il:a0452))) il:a0452)) 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:a0453 (quote build-constructor-slot-setfs)) (il:a0454 (quote function)) (il:a0455 "builds the setfs that initialize the slots in a constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0453 il:a0454 il:a0455))) il:a0455)) boa-constructor-p il:d1 (il:l (0 constructor)) @inil nil () (let* ((il:a0456 (quote boa-constructor-p)) (il:a0457 (quote function)) (il:a0458 "returns t if the constructor is a By Order of Arguments constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0456 il:a0457 il:a0458))) il:a0458)) 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:a0459 (quote construct-predicate)) (il:a0460 (quote function)) (il:a0461 "returns a list of the forms (if any) defining the predicate for ps")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0459 il:a0460 il:a0461))) il:a0461)) ps-name-slot-position il:d1 (il:l (0 ps) il:f 2 *parsed-structures*) )@ HdR  oH @ I (37 length 33 ps-initial-offset 28 ps-all-slots 25 error 14 assoc 3 ps-include) nil ( 21 "~s is not a defined structure") (let* ((il:a0462 (quote ps-name-slot-position)) (il:a0463 (quote function)) (il:a0464 "returns the offset of the name slot for ps.")) (progn (cond ((fboundp (quote il:set-documentation)) ( il:set-documentation il:a0462 il:a0463 il:a0464))) il:a0464)) 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:a0465 (quote function-defining-form)) (il:a0466 (quote function)) (il:a0467 "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:a0465 il:a0466 il:a0467))) il:a0467)) 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:a0468 (quote define-copiers)) (il:a0469 (quote function)) (il:a0470 "returns the form that when evaluated, defines the copier")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0468 il:a0469 il:a0470))) il:a0470)) 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:a0471 (quote build-copier-slot-setfs)) (il:a0472 (quote function)) (il:a0473 "constructs the forms that copy each individual slot.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0471 il:a0472 il:a0473))) il:a0473)) build-copier-type-check il:d1 (il:l (1 from-arg 0 ps) il:f 0 type-check-form) V@d ggA@ hhh  .g@ Ahgho@ Ahhhh ci (83 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:a0474 (quote build-copier-type-check)) (il:a0475 (quote function)) (il:a0476 "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:a0474 il:a0475 il:a0476 ))) il:a0476)) record-print-function il:d1 (il:l (0 ps)) &@ Hgg@ hgHhhh(19 ps-name 3 ps-print-function) (25 quote 15 quote 12 il:defprint) () (let* ((il:a0477 (quote record-print-function)) (il:a0478 (quote function)) (il:a0479 "returns a list of the forms (if any) recording the print-function.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a0477 il:a0478 il:a0479))) il:a0479)) (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 il:$$macro-environment 0 il:$$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:a0483 (quote defstruct-assert-subtypep)) (il:a0484 (quote function)) (il:a0485 "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:a0483 il:a0484 il:a0485)) ) il:a0485)) (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